21f722d55e61064da86562204fffa08240be3652
[riece] / lisp / riece-toolbar.el
1 ;;; riece-toolbar.el --- display toolbar icons
2 ;; Copyright (C) 1998-2004 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Created: 1998-09-28
6 ;; Keywords: IRC, riece
7
8 ;; This file is part of Riece.
9
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;; NOTE: This is an add-on module for Riece.
28
29 ;;; Code:
30
31 (require 'riece-menu)
32
33 (defconst riece-toolbar-description
34   "Display toolbar icons.")
35
36 (defvar riece-toolbar-items
37   '(riece-command-quit
38     riece-command-join
39     riece-command-part
40     riece-command-previous-channel
41     riece-command-next-channel
42     riece-command-change-layout
43     riece-submit-bug-report))
44
45 (defun riece-toolbar-find-menu-item (command)
46   (let ((pointer riece-menu-items)
47         item)
48     (while pointer
49       (if (and (not (stringp (car pointer)))
50                (vectorp (car pointer))
51                (eq (aref (car pointer) 1) command))
52           (setq item (car pointer)
53                 pointer nil)
54         (setq pointer (cdr pointer))))
55     item))
56
57 (if (featurep 'xemacs)
58     (if (featurep 'toolbar)
59         (progn
60           (defun riece-make-toolbar-from-menu (items menu-items map)
61             (let ((pointer items)
62                   toolbar
63                   file
64                   menu-item)
65               (while pointer
66                 (setq file (locate-file (symbol-name (car pointer))
67                                         (cons riece-data-directory load-path)
68                                         '(".xpm" ".pbm" ".xbm"))
69                       menu-item (riece-toolbar-find-menu-item (car pointer)))
70                 (if (and file (file-exists-p file))
71                     (setq toolbar
72                           (toolbar-add-item
73                            toolbar
74                            (toolbar-new-button
75                             file
76                             (car pointer)
77                             (if menu-item
78                                 (aref menu-item 0)
79                               (symbol-name (car pointer)))))))
80                 (setq pointer (cdr pointer)))
81               toolbar))
82           (defvar riece-toolbar-original-toolbar nil)
83           (defun riece-set-toolbar (toolbar)
84             (make-local-variable 'riece-toolbar-original-toolbar)
85             (setq riece-toolbar-original-toolbar
86                   (specifier-specs default-toolbar (current-buffer)))
87             (set-specifier default-toolbar toolbar (current-buffer)))
88           (defun riece-unset-toolbar ()
89             (if riece-toolbar-original-toolbar
90                 (set-specifier default-toolbar riece-toolbar-original-toolbar
91                                (current-buffer))
92               (remove-specifier default-toolbar (current-buffer)))
93             (kill-local-variable 'riece-toolbar-original-toolbar)))
94       (defalias 'riece-make-toolbar-from-menu 'ignore)
95       (defalias 'riece-set-toolbar 'ignore)
96       (defalias 'riece-unset-toolbar 'ignore))
97   (defun riece-make-toolbar-from-menu (items menu-items map)
98     (let ((pointer items)
99           (tool-bar-map (make-sparse-keymap)))
100       (while pointer
101         (tool-bar-add-item-from-menu (car pointer)
102                                      (symbol-name (car pointer))
103                                      map)
104         (setq pointer (cdr pointer)))
105       tool-bar-map))
106   (defun riece-set-toolbar (toolbar)
107     (make-local-variable 'tool-bar-map)
108     (setq tool-bar-map toolbar))
109   (defun riece-unset-toolbar ()
110     (kill-local-variable 'tool-bar-map)))
111
112 (defvar riece-command-mode-map)
113 (defun riece-toolbar-command-mode-hook ()
114   (riece-set-toolbar
115    (riece-make-toolbar-from-menu
116     riece-toolbar-items
117     riece-menu-items
118     riece-command-mode-map)))
119
120 (defun riece-toolbar-requires ()
121   '(riece-menu))
122
123 (defun riece-toolbar-insinuate ()
124   (if riece-command-buffer
125       (with-current-buffer riece-command-buffer
126         (riece-toolbar-command-mode-hook)))
127   (add-hook 'riece-command-mode-hook
128             'riece-toolbar-command-mode-hook))
129
130 (defun riece-toolbar-uninstall ()
131   (if riece-command-buffer
132       (with-current-buffer riece-command-buffer
133         (riece-unset-toolbar))
134   (remove-hook 'riece-command-mode-hook
135                'riece-toolbar-command-mode-hook))
136
137 (provide 'riece-toolbar)
138
139 ;;; riece-toolbar.el ends here