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