diff lisp/vm/vm-toolbar.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 05472e90ae02
children c0c698873ce1
line wrap: on
line diff
--- a/lisp/vm/vm-toolbar.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/vm/vm-toolbar.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,5 +1,5 @@
 ;;; Toolbar related functions and commands
-;;; Copyright (C) 1995-1997 Kyle E. Jones
+;;; Copyright (C) 1995 Kyle E. Jones
 ;;;
 ;;; 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
@@ -18,6 +18,7 @@
 (provide 'vm-toolbar)
 
 (defvar vm-toolbar-specifier nil)
+(defvar vm-toolbar nil)
 
 (defvar vm-toolbar-next-button
   [vm-toolbar-next-icon
@@ -25,7 +26,7 @@
    (vm-toolbar-any-messages-p)
    "Go to the next message.\n
 The command `vm-toolbar-next-command' is run, which is normally
-fbound to `vm-next-message'.
+bound to `vm-next-message'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-next-command 'some-other-command)"])
@@ -39,7 +40,7 @@
    (vm-toolbar-any-messages-p)
    "Go to the previous message.\n
 The command `vm-toolbar-previous-command' is run, which is normally
-fbound to `vm-previous-message'.
+bound to `vm-previous-message'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-previous-command 'some-other-command)"])
@@ -58,7 +59,7 @@
   [vm-toolbar-file-icon vm-toolbar-file-command (vm-toolbar-any-messages-p)
    "Save the current message to a folder.\n
 The command `vm-toolbar-file-command' is run, which is normally
-fbound to `vm-save-message'.
+bound to `vm-save-message'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-file-command 'some-other-command)"])
@@ -66,26 +67,13 @@
 (or (fboundp 'vm-toolbar-file-command)
     (fset 'vm-toolbar-file-command 'vm-save-message))
 
-(defvar vm-toolbar-getmail-button
-  [vm-toolbar-getmail-icon vm-toolbar-getmail-command
-   (vm-toolbar-mail-waiting-p)
-   "Retrieve spooled mail for the current folder.\n
-The command `vm-toolbar-getmail-command' is run, which is normally
-fbound to `vm-get-new-mail'.
-You can make this button run some other command by using a Lisp
-s-expression like this one in your .vm file:
-   (fset 'vm-toolbar-getmail-command 'some-other-command)"])
-(defvar vm-toolbar-getmail-icon nil)
-(or (fboundp 'vm-toolbar-getmail-command)
-    (fset 'vm-toolbar-getmail-command 'vm-get-new-mail))
-
 (defvar vm-toolbar-print-button
   [vm-toolbar-print-icon
    vm-toolbar-print-command
    (vm-toolbar-any-messages-p)
    "Print the current message.\n
 The command `vm-toolbar-print-command' is run, which is normally
-fbound to `vm-print-message'.
+bound to `vm-print-message'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-print-command 'some-other-command)"])
@@ -97,7 +85,7 @@
   [vm-toolbar-visit-icon vm-toolbar-visit-command t
    "Visit a different folder.\n
 The command `vm-toolbar-visit-command' is run, which is normally
-fbound to `vm-visit-folder'.
+bound to `vm-visit-folder'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-visit-command 'some-other-command)"])
@@ -111,7 +99,7 @@
    (vm-toolbar-any-messages-p)
    "Reply to the current message.\n
 The command `vm-toolbar-reply-command' is run, which is normally
-fbound to `vm-followup-include-text'.
+bound to `vm-followup-include-text'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-reply-command 'some-other-command)"])
@@ -123,7 +111,7 @@
   [vm-toolbar-compose-icon vm-toolbar-compose-command t
    "Compose a new message.\n
 The command `vm-toolbar-compose-command' is run, which is normally
-fbound to `vm-mail'.
+bound to `vm-mail'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-compose-command 'some-other-command)"])
@@ -131,24 +119,6 @@
 (or (fboundp 'vm-toolbar-compose-command)
     (fset 'vm-toolbar-compose-command 'vm-mail))
 
-(defvar vm-toolbar-decode-mime-button
-  [vm-toolbar-decode-mime-icon vm-toolbar-decode-mime-command
-   (vm-toolbar-can-decode-mime-p)
-   "Decode the MIME objects in the current message.\n
-The objects might be displayed immediately, or buttons might be
-displayed that you need to click on to view the object.  See the
-documentation for the variables vm-mime-internal-content-types
-and vm-mime-external-content-types-alist to see how to control
-whether you see buttons or objects.\n
-The command `vm-toolbar-decode-mime-command' is run, which is normally
-fbound to `vm-decode-mime-messages'.
-You can make this button run some other command by using a Lisp
-s-expression like this one in your .vm file:
-   (fset 'vm-toolbar-decode-mime-command 'some-other-command)"])
-(defvar vm-toolbar-decode-mime-icon nil)
-(or (fboundp 'vm-toolbar-decode-mime-command)
-    (fset 'vm-toolbar-decode-mime-command 'vm-decode-mime-message))
-
 (defvar vm-toolbar-delete-icon nil)
 
 (defvar vm-toolbar-undelete-icon nil)
@@ -169,8 +139,7 @@
 (make-variable-buffer-local 'vm-toolbar-helper-icon)
 
 (defvar vm-toolbar-help-button
-  [vm-toolbar-helper-icon vm-toolbar-helper-command
-   (vm-toolbar-can-help-p)
+  [vm-toolbar-helper-icon vm-toolbar-helper-command t
    "Don't Panic.\n
 VM uses this button to offer help if you're in trouble.
 Under normal circumstances, this button runs `vm-help'.\n
@@ -186,11 +155,10 @@
   (call-interactively vm-toolbar-helper-command))
 
 (defvar vm-toolbar-quit-button
-  [vm-toolbar-quit-icon vm-toolbar-quit-command
-   (vm-toolbar-can-quit-p)
-   "Quit visiting this folder.\n
+  [vm-toolbar-quit-icon vm-toolbar-quit-command t
+   "Quit VM.\n
 The command `vm-toolbar-quit-command' is run, which is normally
-fbound to `vm-quit'.
+bound to `vm-quit'.
 You can make this button run some other command by using a Lisp
 s-expression like this one in your .vm file:
    (fset 'vm-toolbar-quit-command 'some-other-command)"])
@@ -199,12 +167,10 @@
     (fset 'vm-toolbar-quit-command 'vm-quit))
 
 (defun vm-toolbar-any-messages-p ()
-  (condition-case nil
-      (save-excursion
-	(vm-check-for-killed-folder)
-	(vm-select-folder-buffer)
-	vm-message-list)
-    (error nil)))
+  (save-excursion
+    (vm-check-for-killed-folder)
+    (vm-select-folder-buffer)
+    vm-message-list))
 
 (defun vm-toolbar-delete/undelete-message (&optional prefix-arg)
   (interactive "P")
@@ -220,13 +186,11 @@
 
 (defun vm-toolbar-can-autofile-p ()
   (interactive)
-  (condition-case nil
-      (save-excursion
-	(vm-check-for-killed-folder)
-	(vm-select-folder-buffer)
-	(and vm-message-pointer
-	     (vm-auto-select-folder vm-message-pointer vm-auto-folder-alist)))
-    (error nil)))
+  (save-excursion
+    (vm-check-for-killed-folder)
+    (vm-select-folder-buffer)
+    (and vm-message-pointer
+	 (vm-auto-select-folder vm-message-pointer vm-auto-folder-alist))))
 
 (defun vm-toolbar-autofile-message ()
   (interactive)
@@ -243,45 +207,16 @@
       (error "No match for message in vm-auto-folder-alist."))))
 
 (defun vm-toolbar-can-recover-p ()
-  (condition-case nil
-      (save-excursion
-	(vm-select-folder-buffer)
-	(and vm-folder-read-only
-	     buffer-file-name
-	     buffer-auto-save-file-name
-	     (null (buffer-modified-p))
-	     (file-newer-than-file-p
-	      buffer-auto-save-file-name
-	      buffer-file-name)))
-    (error nil)))
-
-(defun vm-toolbar-can-decode-mime-p ()
-  (condition-case nil
-      (save-excursion
-	(vm-select-folder-buffer)
-	(and
-	 vm-display-using-mime
-	 vm-message-pointer
-	 vm-presentation-buffer
-	 (not vm-mime-decoded)
-	 (not (vm-mime-plain-message-p (car vm-message-pointer)))))
-    (error nil)))
-
-(defun vm-toolbar-can-quit-p ()
-  (condition-case nil
-      (save-excursion
-	(vm-select-folder-buffer)
-	(memq major-mode '(vm-mode vm-virtual-mode)))
-    (error nil)))
-
-(defun vm-toolbar-mail-waiting-p ()
-  (condition-case nil
-      (save-excursion
-	(vm-select-folder-buffer)
-	vm-spooled-mail-waiting)
-    (error nil)))
-
-(fset 'vm-toolbar-can-help-p 'vm-toolbar-can-quit-p)
+  (save-excursion
+    (vm-check-for-killed-folder)
+    (vm-select-folder-buffer)
+    (and vm-folder-read-only
+	 buffer-file-name
+	 buffer-auto-save-file-name
+	 (null (buffer-modified-p))
+	 (file-newer-than-file-p
+	  buffer-auto-save-file-name
+	  buffer-file-name))))
 
 (defun vm-toolbar-update-toolbar ()
   (if (and vm-message-pointer (vm-deleted-flag (car vm-message-pointer)))
@@ -290,12 +225,6 @@
   (cond ((vm-toolbar-can-recover-p)
 	 (setq vm-toolbar-helper-command 'recover-file
 	       vm-toolbar-helper-icon vm-toolbar-recover-icon))
-	((vm-toolbar-mail-waiting-p)
-	 (setq vm-toolbar-helper-command 'vm-get-new-mail
-	       vm-toolbar-helper-icon vm-toolbar-getmail-icon))
-	((vm-toolbar-can-decode-mime-p)
-	 (setq vm-toolbar-helper-command 'vm-decode-mime-message
-	       vm-toolbar-helper-icon vm-toolbar-decode-mime-icon))
 	(t
 	 (setq vm-toolbar-helper-command 'vm-help
 	       vm-toolbar-helper-icon vm-toolbar-help-icon)))
@@ -304,62 +233,41 @@
 			       'vm-toolbar-delete/undelete-icon
 			       'vm-toolbar-helper-command
 			       'vm-toolbar-helper-icon))
-  (if vm-presentation-buffer
-      (vm-copy-local-variables vm-presentation-buffer
-			       'vm-toolbar-delete/undelete-icon
-			       'vm-toolbar-helper-command
-			       'vm-toolbar-helper-icon))
   (and vm-toolbar-specifier
        (progn
-	 (set-specifier vm-toolbar-specifier (cons (current-buffer) nil))
-	 (set-specifier vm-toolbar-specifier (cons (current-buffer)
-						   vm-toolbar)))))
+	 (let ((locale (if (memq 'vm-delete-buffer-frame kill-buffer-hook)
+			   (selected-frame)
+			 (current-buffer))))
+	   (set-specifier vm-toolbar-specifier (cons locale nil))
+	   (set-specifier vm-toolbar-specifier (cons locale vm-toolbar))))))
 
 (defun vm-toolbar-install-toolbar ()
   (vm-toolbar-initialize)
-  (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon))))
+  (let ((toolbar (vm-toolbar-make-toolbar-spec))
+	(height (+ 4 (glyph-height (car vm-toolbar-help-icon))))
 	(width (+ 4 (glyph-width (car vm-toolbar-help-icon))))
-	(frame (selected-frame))
-	(buffer (current-buffer))
-	(tag-set '(win))
-	(myframe (vm-created-this-frame-p))
-	toolbar )
-    ;; glyph-width and glyph-height return 0 at startup sometimes
-    ;; use reasonable values if they fail.
-    (if (= width 4)
-	(setq width 68))
-    (if (= height 4)
-	(setq height 46))
-    ;; honor user setting of vm-toolbar if they are daring enough
-    ;; to set it.
-    (if vm-toolbar
-	(setq toolbar vm-toolbar)
-      (setq toolbar (vm-toolbar-make-toolbar-spec)
-	    vm-toolbar toolbar))
+	(locale (if (memq 'vm-delete-buffer-frame kill-buffer-hook)
+		    (selected-frame)
+		  (current-buffer))))
+    (setq vm-toolbar toolbar)
     (cond ((eq vm-toolbar-orientation 'right)
 	   (setq vm-toolbar-specifier right-toolbar)
-	   (if myframe
-	       (set-specifier right-toolbar toolbar frame tag-set))
-	   (set-specifier right-toolbar toolbar buffer)
-	   (set-specifier right-toolbar-width width frame tag-set))
+	   (set-specifier right-toolbar (cons locale toolbar))
+	   (set-specifier right-toolbar-width (cons (selected-frame) width)))
 	  ((eq vm-toolbar-orientation 'left)
 	   (setq vm-toolbar-specifier left-toolbar)
-	   (if myframe
-	       (set-specifier left-toolbar toolbar frame tag-set))
-	   (set-specifier left-toolbar toolbar buffer)
-	   (set-specifier left-toolbar-width width frame tag-set))
+	   (set-specifier left-toolbar (cons locale toolbar))
+	   (set-specifier left-toolbar-width (cons (selected-frame) width)))
 	  ((eq vm-toolbar-orientation 'bottom)
 	   (setq vm-toolbar-specifier bottom-toolbar)
-	   (if myframe
-	       (set-specifier bottom-toolbar toolbar frame tag-set))
-	   (set-specifier bottom-toolbar toolbar buffer)
-	   (set-specifier bottom-toolbar-height height frame tag-set))
+	   (set-specifier bottom-toolbar (cons locale toolbar))
+	   (set-specifier bottom-toolbar-height (cons (selected-frame)
+						      height)))
 	  (t
 	   (setq vm-toolbar-specifier top-toolbar)
-	   (if myframe
-	       (set-specifier top-toolbar toolbar frame tag-set))
-	   (set-specifier top-toolbar toolbar buffer)
-	   (set-specifier top-toolbar-height height frame tag-set)))))
+	   (set-specifier top-toolbar (cons locale toolbar))
+	   (set-specifier top-toolbar-height (cons (selected-frame)
+						   height))))))
 
 (defun vm-toolbar-make-toolbar-spec ()
   (let ((button-alist '(
@@ -367,9 +275,7 @@
 			(compose . vm-toolbar-compose-button)
 			(delete/undelete . vm-toolbar-delete/undelete-button)
 			(file . vm-toolbar-file-button)
-			(getmail . vm-toolbar-getmail-button)
 			(help . vm-toolbar-help-button)
-			(mime . vm-toolbar-decode-mime-button)
 			(next . vm-toolbar-next-button)
 			(previous . vm-toolbar-previous-button)
 			(print . vm-toolbar-print-button)
@@ -400,35 +306,25 @@
    ((null vm-toolbar-help-icon)
     (let ((tuples
 	   (if (featurep 'xpm)
-	       (list
-		(if (and (device-on-window-system-p)
-			 (>= (device-bitplanes) 16))
-      '(vm-toolbar-decode-mime-icon "mime-colorful-up.xpm"
-				    "mime-colorful-dn.xpm"
-				    "mime-colorful-xx.xpm")
-   '(vm-toolbar-decode-mime-icon "mime-simple-up.xpm"
-				 "mime-simple-dn.xpm"
-				 "mime-simple-xx.xpm"))
- '(vm-toolbar-next-icon "next-up.xpm" "next-dn.xpm" "next-dn.xpm")
- '(vm-toolbar-previous-icon "previous-up.xpm" "previous-dn.xpm"
+	       '(
+ (vm-toolbar-next-icon "next-up.xpm" "next-dn.xpm" "next-dn.xpm")
+ (vm-toolbar-previous-icon "previous-up.xpm" "previous-dn.xpm"
 			   "previous-dn.xpm")
- '(vm-toolbar-delete-icon "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm")
- '(vm-toolbar-undelete-icon "undelete-up.xpm" "undelete-dn.xpm"
+ (vm-toolbar-delete-icon "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm")
+ (vm-toolbar-undelete-icon "undelete-up.xpm" "undelete-dn.xpm"
 			   "undelete-dn.xpm")
- '(vm-toolbar-autofile-icon "autofile-up.xpm" "autofile-dn.xpm"
+ (vm-toolbar-autofile-icon "autofile-up.xpm" "autofile-dn.xpm"
 			   "autofile-dn.xpm")
- '(vm-toolbar-getmail-icon "getmail-up.xpm" "getmail-dn.xpm" "getmail-dn.xpm")
- '(vm-toolbar-file-icon "file-up.xpm" "file-dn.xpm" "file-dn.xpm")
- '(vm-toolbar-reply-icon "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm")
- '(vm-toolbar-compose-icon "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm")
- '(vm-toolbar-print-icon "print-up.xpm" "print-dn.xpm" "print-dn.xpm")
- '(vm-toolbar-visit-icon "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm")
- '(vm-toolbar-quit-icon "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm")
- '(vm-toolbar-help-icon "help-up.xpm" "help-dn.xpm" "help-dn.xpm")
- '(vm-toolbar-recover-icon "recover-up.xpm" "recover-dn.xpm" "recover-dn.xpm")
+ (vm-toolbar-file-icon "file-up.xpm" "file-dn.xpm" "file-dn.xpm")
+ (vm-toolbar-reply-icon "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm")
+ (vm-toolbar-compose-icon "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm")
+ (vm-toolbar-print-icon "print-up.xpm" "print-dn.xpm" "print-dn.xpm")
+ (vm-toolbar-visit-icon "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm")
+ (vm-toolbar-quit-icon "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm")
+ (vm-toolbar-help-icon "help-up.xpm" "help-dn.xpm" "help-dn.xpm")
+ (vm-toolbar-recover-icon "recover-up.xpm" "recover-dn.xpm" "recover-dn.xpm")
 	   )
 	       '(
- (vm-toolbar-decode-mime-icon "mime-up.xbm" "mime-dn.xbm" "mime-xx.xbm")
  (vm-toolbar-next-icon "next-up.xbm" "next-dn.xbm" "next-xx.xbm")
  (vm-toolbar-previous-icon "previous-up.xbm" "previous-dn.xbm"
 			   "previous-xx.xbm")
@@ -437,7 +333,6 @@
 			   "undelete-xx.xbm")
  (vm-toolbar-autofile-icon "autofile-up.xbm" "autofile-dn.xbm"
 			   "autofile-xx.xbm")
- (vm-toolbar-getmail-icon "getmail-up.xbm" "getmail-dn.xbm" "getmail-xx.xbm")
  (vm-toolbar-file-icon "file-up.xbm" "file-dn.xbm" "file-xx.xbm")
  (vm-toolbar-reply-icon "reply-up.xbm" "reply-dn.xbm" "reply-xx.xbm")
  (vm-toolbar-compose-icon "compose-up.xbm" "compose-dn.xbm" "compose-xx.xbm")
@@ -463,7 +358,5 @@
 		    files))
 	  (setq tuples (cdr tuples)))))))
   (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon)
-  (setq-default vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon)
   (setq vm-toolbar-helper-command 'vm-help)
-  (setq vm-toolbar-helper-icon vm-toolbar-help-icon)
-  (setq-default vm-toolbar-helper-icon vm-toolbar-help-icon))
+  (setq vm-toolbar-helper-icon vm-toolbar-help-icon))