Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-toolbar.el @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 49a24b4fd526
children 4103f0995bd7
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
1 ;;; Toolbar related functions and commands 1 ;;; Toolbar related functions and commands
2 ;;; Copyright (C) 1995 Kyle E. Jones 2 ;;; Copyright (C) 1995-1997 Kyle E. Jones
3 ;;; 3 ;;;
4 ;;; This program is free software; you can redistribute it and/or modify 4 ;;; This program is free software; you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by 5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation; either version 1, or (at your option) 6 ;;; the Free Software Foundation; either version 1, or (at your option)
7 ;;; any later version. 7 ;;; any later version.
116 (fset 'vm-toolbar-compose-command 'some-other-command)"]) 116 (fset 'vm-toolbar-compose-command 'some-other-command)"])
117 (defvar vm-toolbar-compose-icon nil) 117 (defvar vm-toolbar-compose-icon nil)
118 (or (fboundp 'vm-toolbar-compose-command) 118 (or (fboundp 'vm-toolbar-compose-command)
119 (fset 'vm-toolbar-compose-command 'vm-mail)) 119 (fset 'vm-toolbar-compose-command 'vm-mail))
120 120
121 (defvar vm-toolbar-decode-mime-button
122 [vm-toolbar-decode-mime-icon vm-toolbar-decode-mime-command
123 (vm-toolbar-can-decode-mime-p)
124 "Decode the MIME objects in the current message.\n
125 The objects might be displayed immediately, or buttons might be
126 displayed that you need to click on to view the object. See the
127 documentation for the variables vm-mime-internal-content-types
128 and vm-mime-external-content-types-alist to see how to control
129 whether you see buttons or objects.\n
130 The command `vm-toolbar-decode-mime-command' is run, which is normally
131 bound to `vm-decode-mime-messages'.
132 You can make this button run some other command by using a Lisp
133 s-expression like this one in your .vm file:
134 (fset 'vm-toolbar-decode-mime-command 'some-other-command)"])
135 (defvar vm-toolbar-decode-mime-icon nil)
136 (or (fboundp 'vm-toolbar-decode-mime-command)
137 (fset 'vm-toolbar-decode-mime-command 'vm-decode-mime-message))
138
121 (defvar vm-toolbar-delete-icon nil) 139 (defvar vm-toolbar-delete-icon nil)
122 140
123 (defvar vm-toolbar-undelete-icon nil) 141 (defvar vm-toolbar-undelete-icon nil)
124 142
125 (defvar vm-toolbar-delete/undelete-button 143 (defvar vm-toolbar-delete/undelete-button
136 154
137 (defvar vm-toolbar-helper-icon nil) 155 (defvar vm-toolbar-helper-icon nil)
138 (make-variable-buffer-local 'vm-toolbar-helper-icon) 156 (make-variable-buffer-local 'vm-toolbar-helper-icon)
139 157
140 (defvar vm-toolbar-help-button 158 (defvar vm-toolbar-help-button
141 [vm-toolbar-helper-icon vm-toolbar-helper-command t 159 [vm-toolbar-helper-icon vm-toolbar-helper-command
160 (vm-toolbar-can-help-p)
142 "Don't Panic.\n 161 "Don't Panic.\n
143 VM uses this button to offer help if you're in trouble. 162 VM uses this button to offer help if you're in trouble.
144 Under normal circumstances, this button runs `vm-help'.\n 163 Under normal circumstances, this button runs `vm-help'.\n
145 If the current folder looks out-of-date relative to its auto-save 164 If the current folder looks out-of-date relative to its auto-save
146 file then this button will run `recover-file'."]) 165 file then this button will run `recover-file'."])
152 (interactive) 171 (interactive)
153 (setq this-command vm-toolbar-helper-command) 172 (setq this-command vm-toolbar-helper-command)
154 (call-interactively vm-toolbar-helper-command)) 173 (call-interactively vm-toolbar-helper-command))
155 174
156 (defvar vm-toolbar-quit-button 175 (defvar vm-toolbar-quit-button
157 [vm-toolbar-quit-icon vm-toolbar-quit-command t 176 [vm-toolbar-quit-icon vm-toolbar-quit-command
177 (vm-toolbar-can-quit-p)
158 "Quit visiting this folder.\n 178 "Quit visiting this folder.\n
159 The command `vm-toolbar-quit-command' is run, which is normally 179 The command `vm-toolbar-quit-command' is run, which is normally
160 bound to `vm-quit'. 180 bound to `vm-quit'.
161 You can make this button run some other command by using a Lisp 181 You can make this button run some other command by using a Lisp
162 s-expression like this one in your .vm file: 182 s-expression like this one in your .vm file:
215 (null (buffer-modified-p)) 235 (null (buffer-modified-p))
216 (file-newer-than-file-p 236 (file-newer-than-file-p
217 buffer-auto-save-file-name 237 buffer-auto-save-file-name
218 buffer-file-name)))) 238 buffer-file-name))))
219 239
240 (defun vm-toolbar-can-decode-mime-p ()
241 (save-excursion
242 (vm-check-for-killed-folder)
243 (vm-select-folder-buffer)
244 (and
245 vm-display-using-mime
246 vm-message-pointer
247 vm-presentation-buffer
248 (not vm-mime-decoded)
249 (not (vm-mime-plain-message-p (car vm-message-pointer))))))
250
251 (defun vm-toolbar-can-quit-p ()
252 (save-excursion
253 (vm-check-for-killed-folder)
254 (vm-select-folder-buffer)
255 (memq major-mode '(vm-mode vm-virtual-mode))))
256
257 (fset 'vm-toolbar-can-help-p 'vm-toolbar-can-quit-p)
258
220 (defun vm-toolbar-update-toolbar () 259 (defun vm-toolbar-update-toolbar ()
221 (if (and vm-message-pointer (vm-deleted-flag (car vm-message-pointer))) 260 (if (and vm-message-pointer (vm-deleted-flag (car vm-message-pointer)))
222 (setq vm-toolbar-delete/undelete-icon vm-toolbar-undelete-icon) 261 (setq vm-toolbar-delete/undelete-icon vm-toolbar-undelete-icon)
223 (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon)) 262 (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon))
224 (cond ((vm-toolbar-can-recover-p) 263 (cond ((vm-toolbar-can-recover-p)
225 (setq vm-toolbar-helper-command 'recover-file 264 (setq vm-toolbar-helper-command 'recover-file
226 vm-toolbar-helper-icon vm-toolbar-recover-icon)) 265 vm-toolbar-helper-icon vm-toolbar-recover-icon))
266 ((vm-toolbar-can-decode-mime-p)
267 (setq vm-toolbar-helper-command 'vm-decode-mime-message
268 vm-toolbar-helper-icon vm-toolbar-decode-mime-icon))
227 (t 269 (t
228 (setq vm-toolbar-helper-command 'vm-help 270 (setq vm-toolbar-helper-command 'vm-help
229 vm-toolbar-helper-icon vm-toolbar-help-icon))) 271 vm-toolbar-helper-icon vm-toolbar-help-icon)))
230 (if vm-summary-buffer 272 (if vm-summary-buffer
231 (vm-copy-local-variables vm-summary-buffer 273 (vm-copy-local-variables vm-summary-buffer
232 'vm-toolbar-delete/undelete-icon 274 'vm-toolbar-delete/undelete-icon
233 'vm-toolbar-helper-command 275 'vm-toolbar-helper-command
234 'vm-toolbar-helper-icon)) 276 'vm-toolbar-helper-icon))
277 (if vm-presentation-buffer
278 (vm-copy-local-variables vm-presentation-buffer
279 'vm-toolbar-delete/undelete-icon
280 'vm-toolbar-helper-command
281 'vm-toolbar-helper-icon))
235 (and vm-toolbar-specifier 282 (and vm-toolbar-specifier
236 (progn 283 (progn
237 (set-specifier vm-toolbar-specifier (cons (current-buffer) nil)) 284 (set-specifier vm-toolbar-specifier (cons (current-buffer) nil))
238 (set-specifier vm-toolbar-specifier (cons (current-buffer) 285 (set-specifier vm-toolbar-specifier (cons (current-buffer)
239 vm-toolbar))))) 286 vm-toolbar)))))
240 287
241 (defun vm-toolbar-install-toolbar () 288 (defun vm-toolbar-install-toolbar ()
242 (vm-toolbar-initialize) 289 (vm-toolbar-initialize)
243 (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon)))) 290 (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon))))
244 (width (+ 4 (glyph-width (car vm-toolbar-help-icon)))) 291 (width (+ 4 (glyph-width (car vm-toolbar-help-icon))))
292 (myframe (vm-created-this-frame-p))
245 toolbar ) 293 toolbar )
294 ;; glyph-width and glyph-height return 0 at startup sometimes
295 ;; use reasonable values if they fail.
296 (if (= width 4)
297 (setq width 68))
298 (if (= height 4)
299 (setq height 46))
246 ;; honor user setting of vm-toolbar if they are daring enough 300 ;; honor user setting of vm-toolbar if they are daring enough
247 ;; to set it. 301 ;; to set it.
248 (if vm-toolbar 302 (if vm-toolbar
249 (setq toolbar vm-toolbar) 303 (setq toolbar vm-toolbar)
250 (setq toolbar (vm-toolbar-make-toolbar-spec) 304 (setq toolbar (vm-toolbar-make-toolbar-spec)
251 vm-toolbar toolbar)) 305 vm-toolbar toolbar))
252 (cond ((eq vm-toolbar-orientation 'right) 306 (cond ((eq vm-toolbar-orientation 'right)
253 (setq vm-toolbar-specifier right-toolbar) 307 (setq vm-toolbar-specifier right-toolbar)
308 (if myframe
309 (set-specifier right-toolbar (cons (selected-frame) toolbar)))
254 (set-specifier right-toolbar (cons (current-buffer) toolbar)) 310 (set-specifier right-toolbar (cons (current-buffer) toolbar))
255 (set-specifier right-toolbar-width 311 (set-specifier right-toolbar-width
256 (cons (selected-frame) width))) 312 (cons (selected-frame) width)))
257 ((eq vm-toolbar-orientation 'left) 313 ((eq vm-toolbar-orientation 'left)
258 (setq vm-toolbar-specifier left-toolbar) 314 (setq vm-toolbar-specifier left-toolbar)
315 (if myframe
316 (set-specifier left-toolbar (cons (selected-frame) toolbar)))
259 (set-specifier left-toolbar (cons (current-buffer) toolbar)) 317 (set-specifier left-toolbar (cons (current-buffer) toolbar))
260 (set-specifier left-toolbar-width 318 (set-specifier left-toolbar-width
261 (cons (selected-frame) width))) 319 (cons (selected-frame) width)))
262 ((eq vm-toolbar-orientation 'bottom) 320 ((eq vm-toolbar-orientation 'bottom)
263 (setq vm-toolbar-specifier bottom-toolbar) 321 (setq vm-toolbar-specifier bottom-toolbar)
322 (if myframe
323 (set-specifier bottom-toolbar (cons (selected-frame) toolbar)))
264 (set-specifier bottom-toolbar (cons (current-buffer) toolbar)) 324 (set-specifier bottom-toolbar (cons (current-buffer) toolbar))
265 (set-specifier bottom-toolbar-height 325 (set-specifier bottom-toolbar-height
266 (cons (selected-frame) height))) 326 (cons (selected-frame) height)))
267 (t 327 (t
268 (setq vm-toolbar-specifier top-toolbar) 328 (setq vm-toolbar-specifier top-toolbar)
329 (if myframe
330 (set-specifier top-toolbar (cons (selected-frame) toolbar)))
269 (set-specifier top-toolbar (cons (current-buffer) toolbar)) 331 (set-specifier top-toolbar (cons (current-buffer) toolbar))
270 (set-specifier top-toolbar-height 332 (set-specifier top-toolbar-height
271 (cons (selected-frame) height)))))) 333 (cons (selected-frame) height))))))
272 334
273 (defun vm-toolbar-make-toolbar-spec () 335 (defun vm-toolbar-make-toolbar-spec ()
275 (autofile . vm-toolbar-autofile-button) 337 (autofile . vm-toolbar-autofile-button)
276 (compose . vm-toolbar-compose-button) 338 (compose . vm-toolbar-compose-button)
277 (delete/undelete . vm-toolbar-delete/undelete-button) 339 (delete/undelete . vm-toolbar-delete/undelete-button)
278 (file . vm-toolbar-file-button) 340 (file . vm-toolbar-file-button)
279 (help . vm-toolbar-help-button) 341 (help . vm-toolbar-help-button)
342 (mime . vm-toolbar-decode-mime-button)
280 (next . vm-toolbar-next-button) 343 (next . vm-toolbar-next-button)
281 (previous . vm-toolbar-previous-button) 344 (previous . vm-toolbar-previous-button)
282 (print . vm-toolbar-print-button) 345 (print . vm-toolbar-print-button)
283 (quit . vm-toolbar-quit-button) 346 (quit . vm-toolbar-quit-button)
284 (reply . vm-toolbar-reply-button) 347 (reply . vm-toolbar-reply-button)
305 (require 'vm-summary) 368 (require 'vm-summary)
306 (cond 369 (cond
307 ((null vm-toolbar-help-icon) 370 ((null vm-toolbar-help-icon)
308 (let ((tuples 371 (let ((tuples
309 (if (featurep 'xpm) 372 (if (featurep 'xpm)
310 '( 373 (list
311 (vm-toolbar-next-icon "next-up.xpm" "next-dn.xpm" "next-dn.xpm") 374 (if (>= (device-bitplanes) 16)
312 (vm-toolbar-previous-icon "previous-up.xpm" "previous-dn.xpm" 375 '(vm-toolbar-decode-mime-icon "mime-colorful-up.xpm"
376 "mime-colorful-dn.xpm"
377 "mime-colorful-xx.xpm")
378 '(vm-toolbar-decode-mime-icon "mime-simple-up.xpm"
379 "mime-simple-dn.xpm"
380 "mime-simple-xx.xpm"))
381 '(vm-toolbar-next-icon "next-up.xpm" "next-dn.xpm" "next-dn.xpm")
382 '(vm-toolbar-previous-icon "previous-up.xpm" "previous-dn.xpm"
313 "previous-dn.xpm") 383 "previous-dn.xpm")
314 (vm-toolbar-delete-icon "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm") 384 '(vm-toolbar-delete-icon "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm")
315 (vm-toolbar-undelete-icon "undelete-up.xpm" "undelete-dn.xpm" 385 '(vm-toolbar-undelete-icon "undelete-up.xpm" "undelete-dn.xpm"
316 "undelete-dn.xpm") 386 "undelete-dn.xpm")
317 (vm-toolbar-autofile-icon "autofile-up.xpm" "autofile-dn.xpm" 387 '(vm-toolbar-autofile-icon "autofile-up.xpm" "autofile-dn.xpm"
318 "autofile-dn.xpm") 388 "autofile-dn.xpm")
319 (vm-toolbar-file-icon "file-up.xpm" "file-dn.xpm" "file-dn.xpm") 389 '(vm-toolbar-file-icon "file-up.xpm" "file-dn.xpm" "file-dn.xpm")
320 (vm-toolbar-reply-icon "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm") 390 '(vm-toolbar-reply-icon "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm")
321 (vm-toolbar-compose-icon "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm") 391 '(vm-toolbar-compose-icon "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm")
322 (vm-toolbar-print-icon "print-up.xpm" "print-dn.xpm" "print-dn.xpm") 392 '(vm-toolbar-print-icon "print-up.xpm" "print-dn.xpm" "print-dn.xpm")
323 (vm-toolbar-visit-icon "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm") 393 '(vm-toolbar-visit-icon "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm")
324 (vm-toolbar-quit-icon "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm") 394 '(vm-toolbar-quit-icon "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm")
325 (vm-toolbar-help-icon "help-up.xpm" "help-dn.xpm" "help-dn.xpm") 395 '(vm-toolbar-help-icon "help-up.xpm" "help-dn.xpm" "help-dn.xpm")
326 (vm-toolbar-recover-icon "recover-up.xpm" "recover-dn.xpm" "recover-dn.xpm") 396 '(vm-toolbar-recover-icon "recover-up.xpm" "recover-dn.xpm" "recover-dn.xpm")
327 ) 397 )
328 '( 398 '(
399 (vm-toolbar-decode-mime-icon "mime-up.xbm" "mime-dn.xbm" "mime-xx.xbm")
329 (vm-toolbar-next-icon "next-up.xbm" "next-dn.xbm" "next-xx.xbm") 400 (vm-toolbar-next-icon "next-up.xbm" "next-dn.xbm" "next-xx.xbm")
330 (vm-toolbar-previous-icon "previous-up.xbm" "previous-dn.xbm" 401 (vm-toolbar-previous-icon "previous-up.xbm" "previous-dn.xbm"
331 "previous-xx.xbm") 402 "previous-xx.xbm")
332 (vm-toolbar-delete-icon "delete-up.xbm" "delete-dn.xbm" "delete-xx.xbm") 403 (vm-toolbar-delete-icon "delete-up.xbm" "delete-dn.xbm" "delete-xx.xbm")
333 (vm-toolbar-undelete-icon "undelete-up.xbm" "undelete-dn.xbm" 404 (vm-toolbar-undelete-icon "undelete-up.xbm" "undelete-dn.xbm"
357 (make-glyph 428 (make-glyph
358 (expand-file-name f vm-toolbar-pixmap-directory)))) 429 (expand-file-name f vm-toolbar-pixmap-directory))))
359 files)) 430 files))
360 (setq tuples (cdr tuples))))))) 431 (setq tuples (cdr tuples)))))))
361 (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon) 432 (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon)
433 (setq-default vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon)
362 (setq vm-toolbar-helper-command 'vm-help) 434 (setq vm-toolbar-helper-command 'vm-help)
363 (setq vm-toolbar-helper-icon vm-toolbar-help-icon)) 435 (setq vm-toolbar-helper-icon vm-toolbar-help-icon)
436 (setq-default vm-toolbar-helper-icon vm-toolbar-help-icon))