Mercurial > hg > xemacs-beta

comparison lisp/x11/x-toolbar.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8fc7fe29b841
children c0c698873ce1
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; General Public License for more details. 16 ;; General Public License for more details.
17 17
18 ;; You should have received a copy of the GNU General Public License 18 ;; You should have received a copy of the GNU General Public License
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free 19 ;; along with XEmacs; see the file COPYING. If not, write to the
20 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 21 ;; Boston, MA 02111-1307, USA.
22 ;;
23 ;; Miscellaneous toolbar functions, useful for users to redefine, in
24 ;; order to get different behaviour.
25 ;;
26
27 (defvar toolbar-open-function 'find-file
28 "*Function to call when the open icon is selected.")
29
30 (defun toolbar-open ()
31 (interactive)
32 (call-interactively toolbar-open-function))
33
34 (defvar toolbar-dired-function 'dired
35 "*Function to call when the dired icon is selected.")
36
37 (defun toolbar-dired ()
38 (interactive)
39 (call-interactively toolbar-dired-function))
40
41 (defvar toolbar-save-function 'save-buffer
42 "*Function to call when the save icon is selected.")
43
44 (defun toolbar-save ()
45 (interactive)
46 (call-interactively toolbar-save-function))
47
48 (defvar toolbar-print-function 'lpr-buffer
49 "*Function to call when the print icon is selected.")
50
51 (defun toolbar-print ()
52 (interactive)
53 (call-interactively toolbar-print-function))
54
55 (defvar toolbar-cut-function 'x-kill-primary-selection
56 "*Function to call when the cut icon is selected.")
57
58 (defun toolbar-cut ()
59 (interactive)
60 (call-interactively toolbar-cut-function))
61
62 (defvar toolbar-copy-function 'x-copy-primary-selection
63 "*Function to call when the copy icon is selected.")
64
65 (defun toolbar-copy ()
66 (interactive)
67 (call-interactively toolbar-copy-function))
68
69 (defvar toolbar-paste-function 'x-yank-clipboard-selection
70 "*Function to call when the paste icon is selected.")
71
72 (defun toolbar-paste ()
73 (interactive)
74 (call-interactively toolbar-paste-function))
75
76 (defvar toolbar-undo-function 'undo
77 "*Function to call when the undo icon is selected.")
78
79 (defun toolbar-undo ()
80 (interactive)
81 (call-interactively toolbar-undo-function))
82
83 (defvar toolbar-replace-function 'query-replace
84 "*Function to call when the replace icon is selected.")
85
86 (defun toolbar-replace ()
87 (interactive)
88 (call-interactively toolbar-replace-function))
89 22
90 ;; 23 ;;
91 ;; toolbar ispell variables and defuns 24 ;; toolbar ispell variables and defuns
92 ;; 25 ;;
93
94 (defvar toolbar-ispell-function
95 (lambda ()
96 (interactive)
97 (if (region-active-p)
98 (ispell-region (region-beginning) (region-end))
99 (ispell-buffer)))
100 "*Function to call when the ispell icon is selected.")
101 26
102 (defun toolbar-ispell () 27 (defun toolbar-ispell ()
103 "Intelligently spell the region or buffer." 28 "Intelligently spell the region or buffer."
104 (interactive) 29 (interactive)
105 (call-interactively toolbar-ispell-function)) 30 (if (region-active-p)
31 (ispell-region (region-beginning) (region-end))
32 (ispell-buffer)))
106 33
107 ;; 34 ;;
108 ;; toolbar mail variables and defuns 35 ;; toolbar mail variables and defuns
109 ;; 36 ;;
110 37
111 (defmacro toolbar-external (process &rest args) 38 (defvar toolbar-use-separate-mail-frame nil
112 `(lambda () (interactive) (call-process ,process nil 0 nil ,@args))) 39 "If non-nil run mail in a separate frame.")
113 40
114 (defvar toolbar-mail-commands-alist 41 (defvar toolbar-mail-frame nil
115 `((vm . vm) 42 "The frame in which mail is displayed.")
116 (gnus . gnus-no-server) 43
117 (rmail . rmail) 44 (defvar toolbar-mail-command 'vm
118 (mh . mh-rmail) 45 "The mail reader to run.")
119 (pine . ,(toolbar-external "xterm" "-e" "pine")) ; *gag*
120 (elm . ,(toolbar-external "xterm" "-e" "elm"))
121 (mutt . ,(toolbar-external "xterm" "-e" "mutt"))
122 (exmh . ,(toolbar-external "exmh"))
123 ;; How to turn on netscape mail, command-line??
124 (netscape . ,(toolbar-external "netscape")))
125 "Alist of mail readers and their commands.
126 The car of the alist is the mail reader, and the cdr is the form
127 used to start it.")
128
129 (defvar toolbar-mail-reader 'vm
130 "*Mail reader toolbar will invoke.
131 The legal values are `vm' and `gnus', but you can add your own values
132 by customizing `toolbar-mail-commands-alist'.")
133
134 46
135 (defun toolbar-mail () 47 (defun toolbar-mail ()
136 "Run mail in a separate frame." 48 "Run mail in a separate frame."
137 (interactive) 49 (interactive)
138 (let ((command (assq toolbar-mail-reader toolbar-mail-commands-alist))) 50 (if (not toolbar-use-separate-mail-frame)
139 (if (not command) 51 (funcall toolbar-mail-command)
140 (error "Uknown mail reader %s" toolbar-mail-reader)) 52 (if (or (not toolbar-mail-frame)
141 (funcall (cdr command)))) 53 (not (frame-live-p toolbar-mail-frame)))
54 (progn
55 (setq toolbar-mail-frame (make-frame))
56 (add-hook 'vm-quit-hook
57 '(lambda ()
58 (save-excursion
59 (if (frame-live-p toolbar-mail-frame)
60 (delete-frame toolbar-mail-frame)))))
61 (select-frame toolbar-mail-frame)
62 (raise-frame toolbar-mail-frame)
63 (funcall toolbar-mail-command)))
64 (if (frame-iconified-p toolbar-mail-frame)
65 (deiconify-frame toolbar-mail-frame))
66 (select-frame toolbar-mail-frame)
67 (raise-frame toolbar-mail-frame)))
142 68
143 ;; 69 ;;
144 ;; toolbar info variables and defuns 70 ;; toolbar info variables and defuns
145 ;; 71 ;;
146 72
173 (require 'gdbsrc) 99 (require 'gdbsrc)
174 (call-interactively 'gdbsrc)) 100 (call-interactively 'gdbsrc))
175 ) 101 )
176 102
177 (defvar compile-command) 103 (defvar compile-command)
178 (defvar toolbar-compile-already-run nil)
179 104
180 (defun toolbar-compile () 105 (defun toolbar-compile ()
181 "Run compile without having to touch the keyboard." 106 "Run compile without having to touch the keyboard."
182 (interactive) 107 (interactive)
183 (require 'compile) 108 (require 'compile)
184 (if toolbar-compile-already-run 109 (popup-dialog-box
185 (compile compile-command) 110 `(,(concat "Compile:\n " compile-command)
186 (setq toolbar-compile-already-run t) 111 ["Compile" (compile compile-command) t]
187 (popup-dialog-box 112 ["Edit command" compile t]
188 `(,(concat "Compile:\n " compile-command) 113 nil
189 ["Compile" (compile compile-command) t] 114 ["Cancel" (message "Quit") t])))
190 ["Edit command" compile t]
191 nil
192 ["Cancel" (message "Quit") t]))))
193 115
194 ;; 116 ;;
195 ;; toolbar news variables and defuns 117 ;; toolbar news variables and defuns
196 ;; 118 ;;
197
198 (defvar toolbar-news-commands-alist
199 `((gnus . gnus) ; M-x all-hail-gnus
200 (rn . ,(toolbar-external "xterm" "-e" "rn"))
201 (nn . ,(toolbar-external "xterm" "-e" "nn"))
202 (trn . ,(toolbar-external "xterm" "-e" "trn"))
203 (xrn . ,(toolbar-external "xrn"))
204 (slrn . ,(toolbar-external "xterm" "-e" "slrn"))
205 (pine . ,(toolbar-external "xterm" "-e" "pine")) ; *gag*
206 (tin . ,(toolbar-external "xterm" "-e" "tin")) ; *gag*
207 (netscape . ,(toolbar-external "netscape" "news:")))
208 "Alist of news readers and their commands.
209 Each list element is a pair. The car of the pair is the mail
210 reader, and the cdr is the form used to start it.")
211
212 (defvar toolbar-news-reader 'gnus
213 "*News reader toolbar will invoke.
214 The legal values are gnus, rn, nn, trn, xrn, slrn, pine and netscape.
215 You can add your own values by customizing `toolbar-news-commands-alist'.")
216
217 (defvar toolbar-news-use-separate-frame t
218 "*Whether Gnus is invoked in a separate frame.")
219 119
220 (defvar toolbar-news-frame nil 120 (defvar toolbar-news-frame nil
221 "The frame in which news is displayed.") 121 "The frame in which news is displayed.")
222 122
223 (defvar toolbar-news-frame-properties nil
224 "The properties of the frame in which news is displayed.")
225
226 (defun toolbar-news () 123 (defun toolbar-news ()
227 "Run Gnus in a separate frame." 124 "Run GNUS in a separate frame."
228 (interactive) 125 (interactive)
229 (when (or (not toolbar-news-frame) 126 (if (or (not toolbar-news-frame)
230 (not (frame-live-p toolbar-news-frame))) 127 (not (frame-live-p toolbar-news-frame)))
231 (setq toolbar-news-frame (make-frame toolbar-news-frame-properties)) 128 (progn
232 (add-hook 'gnus-exit-gnus-hook 129 (setq toolbar-news-frame (make-frame))
233 (lambda () 130 (add-hook 'gnus-exit-gnus-hook
234 (when (frame-live-p toolbar-news-frame) 131 '(lambda ()
235 (if (cdr (frame-list)) 132 (if (frame-live-p toolbar-news-frame)
236 (delete-frame toolbar-news-frame)) 133 (delete-frame toolbar-news-frame))))
237 (setq toolbar-news-frame nil)))) 134 (select-frame toolbar-news-frame)
238 (select-frame toolbar-news-frame) 135 (raise-frame toolbar-news-frame)
239 (raise-frame toolbar-news-frame) 136 (gnus)))
240 (gnus))
241 (if (frame-iconified-p toolbar-news-frame) 137 (if (frame-iconified-p toolbar-news-frame)
242 (deiconify-frame toolbar-news-frame)) 138 (deiconify-frame toolbar-news-frame))
243 (select-frame toolbar-news-frame) 139 (select-frame toolbar-news-frame)
244 (raise-frame toolbar-news-frame)) 140 (raise-frame toolbar-news-frame))
245 141
304 ;; do this now because errors will occur if the icon symbols 200 ;; do this now because errors will occur if the icon symbols
305 ;; are not initted 201 ;; are not initted
306 (set-specifier default-toolbar initial-toolbar-spec)) 202 (set-specifier default-toolbar initial-toolbar-spec))
307 203
308 (defvar initial-toolbar-spec 204 (defvar initial-toolbar-spec
309 '(;[toolbar-last-win-icon pop-window-configuration 205 '(;;[toolbar-last-win-icon pop-window-configuration
310 ;;; #### illicit knowledge? 206 ;;(frame-property (selected-frame)
311 ;;; #### these don't work right! 207 ;; 'window-config-stack) t "Most recent window config"]
312 ;;; #### not consistent. 208 ;; #### Illicit knowledge?
313 ;;; I don't know what's wrong; 209 ;; #### These don't work right - not consistent!
314 ;;; perhaps `selected-frame' is 210 ;; I don't know what's wrong; perhaps `selected-frame' is wrong
315 ;;; wrong sometimes when this 211 ;; sometimes when this is evaluated. Note that I even tried to
316 ;;; is evaluated. Note that I 212 ;; kludge-fix this by calls to `set-specifier-dirty-flag' in
317 ;;; even tried to kludge-fix this 213 ;; pop-window-configuration and such.
318 ;;; by calls to `set-specifier-dirty-flag' 214
319 ;;; in pop-window-configuration 215 ;;[toolbar-next-win-icon unpop-window-configuration
320 ;;; and such. 216 ;;(frame-property (selected-frame)
321 ;(frame-property (selected-frame) 217 ;; 'window-config-unpop-stack) t "Undo \"Most recent window config\""]
322 ; 'window-config-stack) 218 ;; #### Illicit knowledge?
323 ; t 219
324 ; "Most recent window config"] 220 [toolbar-file-icon find-file t "Open a file" ]
325 ;[toolbar-next-win-icon unpop-window-configuration 221 [toolbar-folder-icon dired t "View directory"]
326 ;;; #### illicit knowledge? 222 [toolbar-disk-icon save-buffer t "Save buffer" ]
327 ;(frame-property (selected-frame) 223 [toolbar-printer-icon lpr-buffer t "Print buffer" ]
328 ; 'window-config-unpop-stack) 224 [toolbar-cut-icon x-kill-primary-selection t "Kill region"]
329 ; t 225 [toolbar-copy-icon x-copy-primary-selection t "Copy region"]
330 ; "Undo \"Most recent window config\""] 226 [toolbar-paste-icon x-yank-clipboard-selection t
331 [toolbar-file-icon toolbar-open t "Open a file" ] 227 "Paste from clipboard"]
332 [toolbar-folder-icon toolbar-dired t "View directory"] 228 [toolbar-undo-icon undo t "Undo edit" ]
333 [toolbar-disk-icon toolbar-save t "Save buffer" ]
334 [toolbar-printer-icon toolbar-print t "Print buffer" ]
335 [toolbar-cut-icon toolbar-cut t "Kill region"]
336 [toolbar-copy-icon toolbar-copy t "Copy region"]
337 [toolbar-paste-icon toolbar-paste t "Paste from clipboard"]
338 [toolbar-undo-icon toolbar-undo t "Undo edit" ]
339 [toolbar-spell-icon toolbar-ispell t "Spellcheck" ] 229 [toolbar-spell-icon toolbar-ispell t "Spellcheck" ]
340 [toolbar-replace-icon toolbar-replace t "Replace text" ] 230 [toolbar-replace-icon query-replace t "Replace text" ]
341 [toolbar-mail-icon toolbar-mail t "Mail" ] 231 [toolbar-mail-icon toolbar-mail t "Mail" ]
342 [toolbar-info-icon toolbar-info t "Information" ] 232 [toolbar-info-icon toolbar-info t "Information" ]
343 [toolbar-compile-icon toolbar-compile t "Compile" ] 233 [toolbar-compile-icon toolbar-compile t "Compile" ]
344 [toolbar-debug-icon toolbar-debug t "Debug" ] 234 [toolbar-debug-icon toolbar-debug t "Debug" ]
345 [toolbar-news-icon toolbar-news t "News" ]) 235 [toolbar-news-icon toolbar-news t "News" ])
346 "The initial toolbar for a buffer.") 236 "The initial toolbar for a buffer.")
347 237
348
349 (defun x-init-toolbar-from-resources (locale) 238 (defun x-init-toolbar-from-resources (locale)
350 (x-init-specifier-from-resources 239 (x-init-specifier-from-resources
351 top-toolbar-height 'natnum locale 240 top-toolbar-height 'natnum locale
352 '("topToolBarHeight" . "TopToolBarHeight")) 241 '("topToolBarHeight" . "TopToolBarHeight"))
353 (x-init-specifier-from-resources 242 (x-init-specifier-from-resources
357 left-toolbar-width 'natnum locale 246 left-toolbar-width 'natnum locale
358 '("leftToolBarWidth" . "LeftToolBarWidth")) 247 '("leftToolBarWidth" . "LeftToolBarWidth"))
359 (x-init-specifier-from-resources 248 (x-init-specifier-from-resources
360 right-toolbar-width 'natnum locale 249 right-toolbar-width 'natnum locale
361 '("rightToolBarWidth" . "RightToolBarWidth"))) 250 '("rightToolBarWidth" . "RightToolBarWidth")))
362
363 ;;; x-toolbar.el ends here