1. xemacs
  2. vm

Commits

youngs  committed 2c34acb

2002-03-19 Steve Youngs <youngs@xemacs.org>

* Sync with VM-7.03.

  • Participants
  • Parent commits 64787a7
  • Branches default

Comments (0)

Files changed (17)

File ChangeLog

View file
  • Ignore whitespace
+2002-03-19  Steve Youngs  <youngs@xemacs.org>
+
+	* Sync with VM-7.03.
+
 2002-01-07  Adrian Aichner  <adrian@xemacs.org>
 
 	* Makefile (HTML_FILES): New.

File vm-crypto.el

View file
  • Ignore whitespace
 ;;; along with this program; if not, write to the Free Software
 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
+(provide 'vm-crypto)
+
 ;; compatibility
 (fset 'vm-pop-md5 'vm-md5-string)
 
 			  (nconc
 			   (list "-L"
 				 (format "%d:%s:%s" local-port host port))
-			   vm-ssh-program-switches
+			   (copy-sequence vm-ssh-program-switches)
 			   (list host vm-ssh-remote-command)))
 		   done t)
 	     (process-kill-without-query process)

File vm-folder.el

View file
  • Ignore whitespace
 	(vm-expunge-folder t)))
   (vm-save-folder prefix))
 
+(defun vm-revert-buffer (&rest args)
+  (interactive)
+  (vm-select-folder-buffer-if-possible)
+  (apply 'revert-buffer args))
+
+(defun vm-recover-file (&rest args)
+  (interactive)
+  (vm-select-folder-buffer-if-possible)
+  (apply 'recover-file args))
+
 (defun vm-handle-file-recovery-or-reversion (recovery)
   (if (and vm-summary-buffer (buffer-name vm-summary-buffer))
       (kill-buffer vm-summary-buffer))

File vm-macro.el

View file
  • Ignore whitespace
 
 (provide 'vm-macro)
 
-(defmacro vm-assert (expression)
-  (list 'or expression
-	(list 'let
-	      (list (list 'debug-on-error t))
-	      (list 'error "assertion failed: %S"
-		    (list 'quote expression)))))
+(defsubst vm-marker (pos &optional buffer)
+  (set-marker (make-marker) pos buffer))
 
-(defmacro vm-marker (pos &optional buffer)
-  (list 'set-marker '(make-marker) pos buffer))
+(defsubst vm-select-folder-buffer ()
+  (cond (vm-mail-buffer
+	 (or (buffer-name vm-mail-buffer)
+	     (error "Folder buffer has been killed."))
+	 (set-buffer vm-mail-buffer))
+	((not (memq major-mode '(vm-mode vm-virtual-mode)))
+	 (error "No VM folder buffer associated with this buffer"))))
 
-(defmacro vm-increment (variable)
-  (list 'setq variable (list '1+ variable)))
+(defsubst vm-select-folder-buffer-if-possible ()
+  (cond ((and (bufferp vm-mail-buffer)
+	      (buffer-name vm-mail-buffer))
+	 (set-buffer vm-mail-buffer))))
 
-(defmacro vm-decrement (variable)
-  (list 'setq variable (list '1- variable)))
+(defsubst vm-error-if-folder-read-only ()
+  (while vm-folder-read-only
+    (signal 'folder-read-only (list (current-buffer)))))
 
-(defmacro vm-select-folder-buffer ()
-  '(cond (vm-mail-buffer
-	  (or (buffer-name vm-mail-buffer)
-	      (error "Folder buffer has been killed."))
-	  (set-buffer vm-mail-buffer))
-	 ((not (memq major-mode '(vm-mode vm-virtual-mode)))
-	  (error "No VM folder buffer associated with this buffer"))))
+(defsubst vm-error-if-virtual-folder ()
+  (and (eq major-mode 'vm-virtual-mode)
+       (error "%s cannot be applied to virtual folders." this-command)))
 
-(defmacro vm-select-folder-buffer-if-possible ()
-  '(cond (vm-mail-buffer
-	  (set-buffer vm-mail-buffer))))
-
-(defmacro vm-error-if-folder-read-only ()
-  '(while vm-folder-read-only
-     (signal 'folder-read-only (list (current-buffer)))))
-
-(defmacro vm-error-if-virtual-folder ()
-  '(and (eq major-mode 'vm-virtual-mode)
-	(error "%s cannot be applied to virtual folders." this-command)))
-
-(defmacro vm-build-threads-if-unbuilt ()
-  '(if (null vm-thread-obarray)
-       (vm-build-threads nil)))
-
-;; save-restriction flubs restoring the clipping region if you
-;; (widen) and modify text outside the old region.
-;; This should do it right.
-(defmacro vm-save-restriction (&rest forms)
-  (let ((vm-sr-clip (make-symbol "vm-sr-clip"))
-	(vm-sr-min (make-symbol "vm-sr-min"))
-	(vm-sr-max (make-symbol "vm-sr-max")))
-    (list 'let (list (list vm-sr-clip '(> (buffer-size)
-					  (- (point-max) (point-min))))
-		     ;; this shouldn't be necessary but the
-		     ;; byte-compiler turns these into interned symbols
-		     ;; which utterly defeats the purpose of the
-		     ;; make-symbol calls above.  Soooo, until the compiler
-		     ;; is fixed, these must be made into (let ...)
-		     ;; temporaries so that nested calls to this macros
-		     ;; won't misbehave.
-		     vm-sr-min vm-sr-max)
-	  (list 'and vm-sr-clip
-		(list 'setq vm-sr-min '(set-marker (make-marker) (point-min)))
-		(list 'setq vm-sr-max '(set-marker (make-marker) (point-max))))
-	  (list 'unwind-protect (cons 'progn forms)
-		'(widen)
-		(list 'and vm-sr-clip
-		      (list 'progn
-			    (list 'narrow-to-region vm-sr-min vm-sr-max)
-			    (list 'set-marker vm-sr-min nil)
-			    (list 'set-marker vm-sr-max nil)))))))
-
-(defmacro vm-save-buffer-excursion (&rest forms)
-  (list 'let '((vm-sbe-buffer (current-buffer)))
-	(list 'unwind-protect
-	      (cons 'progn forms)
-	      '(and (not (eq vm-sbe-buffer (current-buffer)))
-		    (buffer-name vm-sbe-buffer)
-		    (set-buffer vm-sbe-buffer)))))
-
-(defmacro vm-with-unibyte-buffer (&rest body)
-  (nconc
-   (list 'if 'vm-fsfemacs-mule-p
-	 (list 'let '((xzx enable-multibyte-characters))
-	       (list 'unwind-protect
-		     (nconc (list 'let nil '(set-buffer-multibyte nil))
-			    body)
-		     '(set-buffer-multibyte xzx))))
-   body))
-
-(defmacro vm-with-multibyte-buffer (&rest body)
-  (nconc
-   (list 'if 'vm-fsfemacs-mule-p
-	 (list 'let '((xzx enable-multibyte-characters))
-	       (list 'unwind-protect
-		     (nconc (list 'let nil '(set-buffer-multibyte t))
-			    body)
-		     '(set-buffer-multibyte xzx))))
-   body))
+(defsubst vm-build-threads-if-unbuilt ()
+  (if (null vm-thread-obarray)
+      (vm-build-threads nil)))
 
 (defsubst vm-binary-coding-system ()
   (cond (vm-xemacs-mule-p 'binary)
   (cond (vm-xemacs-mule-p 'no-conversion)
 	(vm-xemacs-file-coding-p 'no-conversion)
 	(t 'raw-text)))
+
+;;; can't use defsubst where quoting is needed in some places but
+;;; not others.
+
+;; save-restriction flubs restoring the clipping region if you
+;; (widen) and modify text outside the old region.
+;; This should do it right.
+(defmacro vm-save-restriction (&rest forms)
+  (let ((vm-sr-clip (make-symbol "vm-sr-clip"))
+	(vm-sr-min (make-symbol "vm-sr-min"))
+	(vm-sr-max (make-symbol "vm-sr-max")))
+    `(let ((,vm-sr-clip (> (buffer-size) (- (point-max) (point-min))))
+	   ;; this shouldn't be necessary but the
+	   ;; byte-compiler turns these into interned symbols
+	   ;; which utterly defeats the purpose of the
+	   ;; make-symbol calls above.  Soooo, until the compiler
+	   ;; is fixed, these must be made into (let ...)
+	   ;; temporaries so that nested calls to this macros
+	   ;; won't misbehave.
+	   ,vm-sr-min ,vm-sr-max)
+	  (and ,vm-sr-clip
+	       (setq ,vm-sr-min (set-marker (make-marker) (point-min)))
+	       (setq ,vm-sr-max (set-marker (make-marker) (point-max))))
+	  (unwind-protect
+	      (progn ,@forms)
+	    (widen)
+	    (and ,vm-sr-clip
+		 (progn
+		   (narrow-to-region ,vm-sr-min ,vm-sr-max)
+		   (set-marker ,vm-sr-min nil)
+		   (set-marker ,vm-sr-max nil)))))))
+
+(defmacro vm-save-buffer-excursion (&rest forms)
+  `(let ((vm-sbe-buffer (current-buffer)))
+    (unwind-protect
+	(progn ,@forms)
+      (and (not (eq vm-sbe-buffer (current-buffer)))
+	   (buffer-name vm-sbe-buffer)
+	   (set-buffer vm-sbe-buffer)))))
+
+(defmacro vm-assert (expression)
+  (list 'or expression
+	(list 'let
+	      (list (list 'debug-on-error t))
+	      (list 'error "assertion failed: %S"
+		    (list 'quote expression)))))
+
+(defmacro vm-increment (variable)
+  (list 'setq variable (list '1+ variable)))
+
+(defmacro vm-decrement (variable)
+  (list 'setq variable (list '1- variable)))

File vm-menu.el

View file
  • Ignore whitespace
     ["Make Folders Menu" vm-menu-hm-make-folder-menu vm-folder-directory])
   "VM folder menu list.")
 
-(defconst vm-menu-folder-menu
-  (list
-   "Folder"
-   (if vm-fsfemacs-p
-       ["Manipulate Folders" ignore (ignore)]
-     vm-menu-folders-menu)
-   "---"
-   ["Display Summary" vm-summarize t]
-   ["Toggle Threading" vm-toggle-threads-display t]
-   "---"
-   ["Get New Mail" vm-get-new-mail (vm-menu-can-get-new-mail-p)]
-   "---"
-   ["Search" vm-isearch-forward vm-message-list]
-   "---"
-   ["Auto-Archive" vm-auto-archive-messages vm-message-list]
-   ["Expunge" vm-expunge-folder vm-message-list]
-   ["Expunge POP Messages" vm-expunge-pop-messages t]
-   "---"
-   ["Visit Folder" vm-visit-folder t]
-   ["Visit POP Folder" vm-visit-pop-folder t]
-   ["Revert Folder (back to disk version)" revert-buffer (vm-menu-can-revert-p)]
-   ["Recover Folder (from auto-save file)" recover-file (vm-menu-can-recover-p)]
-   ["Save" vm-save-folder (vm-menu-can-save-p)]
-   ["Save As..." vm-write-file t]
-   ["Quit" vm-quit-no-change t]
-   ["Save & Quit" vm-quit t]
-   "---"
-   "---"
-   ;; special string that marks the tail of this menu for
-   ;; vm-menu-install-visited-folders-menu.
-   "-------"
-   ))
+(defvar vm-menu-folder-menu
+  `("Folder"
+    ,(if vm-fsfemacs-p
+	["Manipulate Folders" ignore (ignore)]
+      vm-menu-folders-menu)
+    "---"
+    ["Display Summary" vm-summarize t]
+    ["Toggle Threading" vm-toggle-threads-display t]
+    "---"
+    ["Get New Mail" vm-get-new-mail (vm-menu-can-get-new-mail-p)]
+    "---"
+    ["Search" vm-isearch-forward vm-message-list]
+    "---"
+    ["Auto-Archive" vm-auto-archive-messages vm-message-list]
+    ["Expunge" vm-expunge-folder vm-message-list]
+    ["Expunge POP Messages" vm-expunge-pop-messages
+     (vm-menu-can-expunge-pop-messages-p)]
+    "---"
+    ["Visit Folder" vm-visit-folder t]
+    ["Visit POP Folder" vm-visit-pop-folder t]
+    ["Revert Folder (back to disk version)" vm-revert-buffer
+     (vm-menu-can-revert-p)]
+    ["Recover Folder (from auto-save file)" vm-recover-file
+     (vm-menu-can-recover-p)]
+    ["Save" vm-save-folder (vm-menu-can-save-p)]
+    ["Save As..." vm-write-file t]
+    ["Quit" vm-quit-no-change t]
+    ["Save & Quit" vm-quit t]
+    "---"
+    "---"
+    ;; special string that marks the tail of this menu for
+    ;; vm-menu-install-visited-folders-menu.
+    "-------"
+    ))
 
-(defconst vm-menu-dispose-menu
+(defvar vm-menu-dispose-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Dispose"
 			 "Dispose"
 			 "---"
 			 "---")
 		 (list "Dispose"))))
-    (append
-     title
-     (list
+    `(,@title
       ["Reply to Author" vm-reply vm-message-list]
       ["Reply to All" vm-followup vm-message-list]
-      ["Reply to Author (citing original)" vm-reply-include-text vm-message-list]
-      ["Reply to All (citing original)" vm-followup-include-text vm-message-list]
+      ["Reply to Author (citing original)" vm-reply-include-text
+       vm-message-list]
+      ["Reply to All (citing original)" vm-followup-include-text
+       vm-message-list]
       ["Forward" vm-forward-message vm-message-list]
       ["Resend" vm-resend-message vm-message-list]
       ["Retry Bounce" vm-resend-bounced-message vm-message-list]
       "---"
       ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list]
       ["Decode MIME" vm-decode-mime-message (vm-menu-can-decode-mime-p)]
-      ))))
+      )))
 
-(defconst vm-menu-motion-menu
+(defvar vm-menu-motion-menu
   '("Motion"
     ["Page Up" vm-scroll-backward vm-message-list]
     ["Page Down" vm-scroll-forward vm-message-list]
     ["Go to Parent Message" vm-goto-parent-message t]
     ))
 
-(defconst vm-menu-virtual-menu
+(defvar vm-menu-virtual-menu
   '("Virtual"
     ["Visit Virtual Folder" vm-visit-virtual-folder t]
     ["Create Virtual Folder" vm-create-virtual-folder t]
     "-------"
     ))
 
-(defconst vm-menu-send-menu
+(defvar vm-menu-send-menu
   '("Send"
     ["Compose" vm-mail t]
     ["Continue Composing" vm-continue-composing-message vm-message-list]
     ["Send MIME Digest" vm-send-mime-digest vm-message-list]
     ))
 
-(defconst vm-menu-mark-menu
+(defvar vm-menu-mark-menu
   '("Mark"
     ["Next Command Uses Marks..." vm-next-command-uses-marks
      :active vm-message-list
     ["Unmark Thread Subtree" vm-unmark-thread-subtree vm-message-list]
     ))
 
-(defconst vm-menu-label-menu
+(defvar vm-menu-label-menu
   '("Label"
     ["Add Label" vm-add-message-labels vm-message-list]
     ["Add Existing Label" vm-add-existing-message-labels vm-message-list]
     ["Remove Label" vm-delete-message-labels vm-message-list]
     ))
 
-(defconst vm-menu-sort-menu
+(defvar vm-menu-sort-menu
   '("Sort"
     ["By Multiple Fields..." vm-sort-messages vm-message-list]
     "---"
     ["Revert to Physical Order" (vm-sort-messages "physical-order" t) vm-message-list]
     ))
 
-(defconst vm-menu-help-menu
+(defvar vm-menu-help-menu
   '("Help!"
     ["What Now?" vm-help t]
     ["Describe Mode" describe-mode t]
     ["Quit Without Saving" vm-quit-no-change t]
     ))
 
-(defconst vm-menu-undo-menu
+(defvar vm-menu-undo-menu
   ["Undo" vm-undo (vm-menu-can-undo-p)]
   )
 
-(defconst vm-menu-emacs-button
+(defvar vm-menu-emacs-button
   ["XEmacs" vm-menu-toggle-menubar t]
   )
 
-(defconst vm-menu-vm-button
+(defvar vm-menu-vm-button
   ["VM" vm-menu-toggle-menubar t]
   )
 
-(defconst vm-menu-mail-menu
+(defvar vm-menu-mail-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Mail Commands"
 			 "Mail Commands"
 			 "---"
 			 "---")
 		 (list "Mail Commands"))))
-    (append
-     title
-     (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)]
-	   ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)]
-	   ["Cancel" kill-buffer t]
-	   "----"
-	   ["Yank Original" vm-menu-yank-original vm-reply-list]
-	   "----"
-	   (append
-	    (if (vm-menu-fsfemacs19-menus-p)
-		(list "Send Using MIME..."
-		      "Send Using MIME..."
-		      "---"
-		      "---")
-	      (list "Send Using MIME..."))
-	    (list
-	     ["Use MIME"
-	      (progn (set (make-local-variable 'vm-send-using-mime) t)
-		     (vm-mail-mode-remove-tm-hooks))
-	      :active t
-	      :style radio
-	      :selected vm-send-using-mime]
-	     ["Don't use MIME"
-	      (set (make-local-variable 'vm-send-using-mime) nil)
-	      :active t
-	      :style radio
-	      :selected (not vm-send-using-mime)]))
-	   (append
-	    (if (vm-menu-fsfemacs19-menus-p)
-		(list "Fragment Messages Larger Than ..."
-		      "Fragment Messages Larger Than ..."
-		      "---"
-		      "---")
-	      (list "Fragment Messages Larger Than ..."))
-	    (list ["Infinity, i.e., don't fragment"
-		   (set (make-local-variable 'vm-mime-max-message-size) nil)
-		   :active vm-send-using-mime
-		   :style radio
-		   :selected (eq vm-mime-max-message-size nil)]
-		  ["50000 bytes"
-		   (set (make-local-variable 'vm-mime-max-message-size)
-			50000)
-		   :active vm-send-using-mime
-		   :style radio
-		   :selected (eq vm-mime-max-message-size 50000)]
-		  ["100000 bytes"
-		   (set (make-local-variable 'vm-mime-max-message-size)
-			100000)
-		   :active vm-send-using-mime
-		   :style radio
-		   :selected (eq vm-mime-max-message-size 100000)]
-		  ["200000 bytes"
-		   (set (make-local-variable 'vm-mime-max-message-size)
-			200000)
-		   :active vm-send-using-mime
-		   :style radio
-		   :selected (eq vm-mime-max-message-size 200000)]
-		  ["500000 bytes"
-		   (set (make-local-variable 'vm-mime-max-message-size)
-			500000)
-		   :active vm-send-using-mime
-		   :style radio
-		   :selected (eq vm-mime-max-message-size 500000)]
-		  ["1000000 bytes"
-		   (set (make-local-variable 'vm-mime-max-message-size)
-			1000000)
-		   :active vm-send-using-mime
-		   :style radio
-		   :selected (eq vm-mime-max-message-size 1000000)]
-		  ["2000000 bytes"
-		   (set (make-local-variable 'vm-mime-max-message-size)
-			2000000)
-		   :active vm-send-using-mime
-		   :style radio
-		   :selected (eq vm-mime-max-message-size 2000000)]))
-	   (append
-	    (if (vm-menu-fsfemacs19-menus-p)
-		(list "Encode 8-bit Characters Using ..."
-		      "Encode 8-bit Characters Using ..."
-		      "---"
-		      "---")
-	      (list "Encode 8-bit Characters Using ..."))
-	    (list
-	     ["Nothing, i.e., send unencoded"
-	      (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
-		   '8bit)
-	      :active vm-send-using-mime
-	      :style radio
-	      :selected (eq vm-mime-8bit-text-transfer-encoding '8bit)]
-	     ["Quoted-Printable"
-	      (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
-		   'quoted-printable)
-	      :active vm-send-using-mime
-	      :style radio
-	      :selected (eq vm-mime-8bit-text-transfer-encoding
-			    'quoted-printable)]
-	     ["BASE64"
-	      (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
-		   'base64)
-	      :active vm-send-using-mime
-	      :style radio
-	      :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)]))
-	   "----"
-	   ["Attach File..."	vm-mime-attach-file vm-send-using-mime]
+    `(,@title
+      ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)]
+      ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)]
+      ["Cancel" kill-buffer t]
+      "----"
+      ["Yank Original" vm-menu-yank-original vm-reply-list]
+      "----"
+      (
+       ,@(if (vm-menu-fsfemacs19-menus-p)
+	     (list "Send Using MIME..."
+		   "Send Using MIME..."
+		   "---"
+		   "---")
+	   (list "Send Using MIME..."))
+       ["Use MIME"
+	(progn (set (make-local-variable 'vm-send-using-mime) t)
+	       (vm-mail-mode-remove-tm-hooks))
+	:active t
+	:style radio
+	:selected vm-send-using-mime]
+       ["Don't use MIME"
+	(set (make-local-variable 'vm-send-using-mime) nil)
+	:active t
+	:style radio
+	:selected (not vm-send-using-mime)])
+      (
+       ,@(if (vm-menu-fsfemacs19-menus-p)
+	     (list "Fragment Messages Larger Than ..."
+		   "Fragment Messages Larger Than ..."
+		   "---"
+		   "---")
+	   (list "Fragment Messages Larger Than ..."))
+       ["Infinity, i.e., don't fragment"
+	(set (make-local-variable 'vm-mime-max-message-size) nil)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-max-message-size nil)]
+       ["50000 bytes"
+	(set (make-local-variable 'vm-mime-max-message-size)
+	     50000)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-max-message-size 50000)]
+       ["100000 bytes"
+	(set (make-local-variable 'vm-mime-max-message-size)
+	     100000)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-max-message-size 100000)]
+       ["200000 bytes"
+	(set (make-local-variable 'vm-mime-max-message-size)
+	     200000)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-max-message-size 200000)]
+       ["500000 bytes"
+	(set (make-local-variable 'vm-mime-max-message-size)
+	     500000)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-max-message-size 500000)]
+       ["1000000 bytes"
+	(set (make-local-variable 'vm-mime-max-message-size)
+	     1000000)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-max-message-size 1000000)]
+       ["2000000 bytes"
+	(set (make-local-variable 'vm-mime-max-message-size)
+	     2000000)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-max-message-size 2000000)])
+      (
+       ,@(if (vm-menu-fsfemacs19-menus-p)
+	     (list "Encode 8-bit Characters Using ..."
+		   "Encode 8-bit Characters Using ..."
+		   "---"
+		   "---")
+	   (list "Encode 8-bit Characters Using ..."))
+       ["Nothing, i.e., send unencoded"
+	(set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
+	     '8bit)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-8bit-text-transfer-encoding '8bit)]
+       ["Quoted-Printable"
+	(set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
+	     'quoted-printable)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-8bit-text-transfer-encoding
+		      'quoted-printable)]
+       ["BASE64"
+	(set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
+	     'base64)
+	:active vm-send-using-mime
+	:style radio
+	:selected (eq vm-mime-8bit-text-transfer-encoding 'base64)])
+      "----"
+      ["Attach File..."	vm-mime-attach-file vm-send-using-mime]
 ;;	   ["Attach MIME Message..." vm-mime-attach-mime-file
 ;;	    vm-send-using-mime]
-	   ["Encode MIME, But Don't Send" vm-mime-encode-composition
-	    (and vm-send-using-mime
-		 (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
-	   ["Preview MIME Before Sending" vm-mime-preview-composition
-	    vm-send-using-mime]
-	   ))))
+      ["Encode MIME, But Don't Send" vm-mime-encode-composition
+       (and vm-send-using-mime
+	    (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
+      ["Preview MIME Before Sending" vm-mime-preview-composition
+       vm-send-using-mime]
+      )))
 
-(defconst vm-menu-mime-dispose-menu
+(defvar vm-menu-mime-dispose-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Take Action on MIME body ..."
 			 "Take Action on MIME body ..."
 			 "---"
 			 "---")
 		 (list "Take Action on MIME body ..."))))
-    (append
-     title
-     (list ["Display as Text using Default Face"
-	    (vm-mime-run-display-function-at-point
-	     'vm-mime-display-body-as-text) t]
-	   ["Display using External Viewer"
-	    (vm-mime-run-display-function-at-point
-	     'vm-mime-display-body-using-external-viewer) t])
-     ;; FSF Emacs does not allow a non-string menu element name.
-     (if (vm-menu-can-eval-item-name)
-	 (list [(format "Convert to %s and Display"
-			(or (nth 1 (vm-mime-can-convert
-				(car
-				 (vm-mm-layout-type
-				  (vm-mime-get-button-layout e)))))
-			    "different type"))
-		(vm-mime-run-display-function-at-point
-		 'vm-mime-convert-body-then-display)
-		(vm-mime-can-convert (car (vm-mm-layout-type
-					   (vm-mime-get-button-layout e))))]))
-     (list "---"
-	   ["Save to File" vm-mime-reader-map-save-file t]
-	   ["Save to Folder" vm-mime-reader-map-save-message
-	    (let ((layout (vm-mime-run-display-function-at-point
-			   (function
-			    (lambda (e)
-			      (vm-extent-property e 'vm-mime-layout))))))
-	      (if (null layout)
-		  nil
-		(or (vm-mime-types-match "message/rfc822"
-					 (car (vm-mm-layout-type layout)))
-		    (vm-mime-types-match "message/news"
-					 (car (vm-mm-layout-type layout))))))]
-	   ["Send to Printer" (vm-mime-run-display-function-at-point
-			       'vm-mime-send-body-to-printer) t]
-	   ["Feed to Shell Pipeline (display output)"
-	    (vm-mime-run-display-function-at-point
-	     'vm-mime-pipe-body-to-queried-command) t]
-	   ["Feed to Shell Pipeline (discard output)"
-	    (vm-mime-run-display-function-at-point
-	     'vm-mime-pipe-body-to-queried-command-discard-output) t]
-	   ["Delete object" vm-delete-mime-object t]))))
+    `(,@title
+      ["Display as Text using Default Face"
+       (vm-mime-run-display-function-at-point
+	'vm-mime-display-body-as-text) t]
+      ["Display using External Viewer"
+       (vm-mime-run-display-function-at-point
+	'vm-mime-display-body-using-external-viewer) t]
+      ;; FSF Emacs does not allow a non-string menu element name.
+      ,@(if (vm-menu-can-eval-item-name)
+	    (list [(format "Convert to %s and Display"
+			   (or (nth 1 (vm-mime-can-convert
+				       (car
+					(vm-mm-layout-type
+					 (vm-mime-get-button-layout e)))))
+			       "different type"))
+		   (vm-mime-run-display-function-at-point
+		    'vm-mime-convert-body-then-display)
+		   (vm-mime-can-convert
+		    (car (vm-mm-layout-type
+			  (vm-mime-get-button-layout e))))]))
+      "---"
+      ["Save to File" vm-mime-reader-map-save-file t]
+      ["Save to Folder" vm-mime-reader-map-save-message
+       (let ((layout (vm-mime-run-display-function-at-point
+		      (function
+		       (lambda (e)
+			 (vm-extent-property e 'vm-mime-layout))))))
+	 (if (null layout)
+	     nil
+	   (or (vm-mime-types-match "message/rfc822"
+				    (car (vm-mm-layout-type layout)))
+	       (vm-mime-types-match "message/news"
+				    (car (vm-mm-layout-type layout))))))]
+      ["Send to Printer" (vm-mime-run-display-function-at-point
+			  'vm-mime-send-body-to-printer) t]
+      ["Feed to Shell Pipeline (display output)"
+       (vm-mime-run-display-function-at-point
+	'vm-mime-pipe-body-to-queried-command) t]
+      ["Feed to Shell Pipeline (discard output)"
+       (vm-mime-run-display-function-at-point
+	'vm-mime-pipe-body-to-queried-command-discard-output) t]
+      ["Delete object" vm-delete-mime-object t])))
 
-(defconst vm-menu-url-browser-menu
+(defvar vm-menu-url-browser-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Send URL to ..."
 			 "Send URL to ..."
 		  ((fboundp 'w3-fetch)
 		   'w3-fetch)
 		  (t 'w3-fetch-other-frame))))
-    (append
-     title
-     (list (vector "Emacs W3"
-		   (list 'vm-mouse-send-url-at-position
-			 '(point)
-			 (list 'quote w3))
-		   (list 'fboundp (list 'quote w3)))
-	   ["Mosaic"
-	    (vm-mouse-send-url-at-position (point)
-					   'vm-mouse-send-url-to-mosaic)
-	    t]
-	   ["mMosaic"
-	    (vm-mouse-send-url-at-position (point)
-					   'vm-mouse-send-url-to-mmosaic)
-	    t]
-	   ["Netscape"
-	    (vm-mouse-send-url-at-position (point)
-					   'vm-mouse-send-url-to-netscape)
-	    t]))))
+    `(,@title
+      ["Emacs W3" (vm-mouse-send-url-at-position (point) (quote ,w3))
+       (fboundp (quote ,w3))]
+      ["Mosaic"
+       (vm-mouse-send-url-at-position (point)
+				      'vm-mouse-send-url-to-mosaic)
+       t]
+      ["mMosaic"
+       (vm-mouse-send-url-at-position (point)
+				      'vm-mouse-send-url-to-mmosaic)
+       t]
+      ["Netscape"
+       (vm-mouse-send-url-at-position (point)
+				      'vm-mouse-send-url-to-netscape)
+       t])))
 
-(defconst vm-menu-mailto-url-browser-menu
+(defvar vm-menu-mailto-url-browser-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Send Mail using ..."
 			 "Send Mail using ..."
 			 "---"
 			 "---")
 		 (list "Send Mail using ..."))))
-    (append
-     title
-     (list ["VM" (vm-mouse-send-url-at-position (point) 'ignore) t]))))
+    `(,@title
+      ["VM" (vm-mouse-send-url-at-position (point) 'ignore) t])))
 
-(defconst vm-menu-subject-menu
+(defvar vm-menu-subject-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Take Action on Subject..."
 			 "Take Action on Subject..."
 			 "---"
 			 "---")
 		 (list "Take Action on Subject..."))))
-    (append
-     title
-     (list
+    `(,@title
       ["Kill Subject" vm-kill-subject vm-message-list]
       ["Next Message, Same Subject" vm-next-message-same-subject
        vm-message-list]
        vm-message-list]
       ["Virtual Folder, Matching Subject" vm-menu-create-subject-virtual-folder
        vm-message-list]
-      ))))
+      )))
 
-(defconst vm-menu-author-menu
+(defvar vm-menu-author-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Take Action on Author..."
 			 "Take Action on Author..."
 			 "---"
 			 "---")
 		 (list "Take Action on Author..."))))
-    (append
-     title
-     (list
+    `(,@title
       ["Mark Messages, Same Author" vm-mark-messages-same-author
        vm-message-list]
       ["Unmark Messages, Same Author" vm-unmark-messages-same-author
        vm-message-list]
       ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder
        vm-message-list]
-      ))))
+      )))
 
-(defconst vm-menu-content-disposition-menu
+(defvar vm-menu-content-disposition-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "Set Content Disposition"
 			 "Set Content Disposition"
 			 "---"
 			 "---")
 		 (list "Set Content Disposition"))))
-    (append
-     title
-     (list ["Unspecified"
-	    (vm-mime-set-attachment-disposition-at-point 'unspecified)
-	    :active vm-send-using-mime
-	    :style radio
-	    :selected (eq (vm-mime-attachment-disposition-at-point)
-			  'unspecified)]
-	   ["Inline"
-	    (vm-mime-set-attachment-disposition-at-point 'inline)
-	    :active vm-send-using-mime
-	    :style radio
-	    :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)]
-	   ["Attachment"
-	    (vm-mime-set-attachment-disposition-at-point 'attachment)
-	    :active vm-send-using-mime
-	    :style radio
-	    :selected (eq (vm-mime-attachment-disposition-at-point)
-			  'attachment)]))))
+    `(,@title
+      ["Unspecified"
+       (vm-mime-set-attachment-disposition-at-point 'unspecified)
+       :active vm-send-using-mime
+       :style radio
+       :selected (eq (vm-mime-attachment-disposition-at-point)
+		     'unspecified)]
+      ["Inline"
+       (vm-mime-set-attachment-disposition-at-point 'inline)
+       :active vm-send-using-mime
+       :style radio
+       :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)]
+      ["Attachment"
+       (vm-mime-set-attachment-disposition-at-point 'attachment)
+       :active vm-send-using-mime
+       :style radio
+       :selected (eq (vm-mime-attachment-disposition-at-point)
+		     'attachment)])))
 
 (defvar vm-menu-vm-menubar nil)
 
-(defconst vm-menu-vm-menu
+(defvar vm-menu-vm-menu
   (let ((title (if (vm-menu-fsfemacs19-menus-p)
 		   (list "VM"
 			 "VM"
 			 "---"
 			 "---")
 		 (list "VM"))))
-    (append title
-	    (list vm-menu-folder-menu
-		  vm-menu-motion-menu
-		  vm-menu-send-menu
-		  vm-menu-mark-menu
-		  vm-menu-label-menu
-		  vm-menu-sort-menu
-		  vm-menu-virtual-menu
-;;		  vm-menu-undo-menu
-		  vm-menu-dispose-menu
-		  "---"
-		  "---"
-		  vm-menu-help-menu))))
+    `(,@title
+      vm-menu-folder-menu
+      vm-menu-motion-menu
+      vm-menu-send-menu
+      vm-menu-mark-menu
+      vm-menu-label-menu
+      vm-menu-sort-menu
+      vm-menu-virtual-menu
+;;    vm-menu-undo-menu
+      vm-menu-dispose-menu
+      "---"
+      "---"
+      vm-menu-help-menu)))
 
 (defvar vm-mode-menu-map nil)
 
 	     (not (vm-mime-plain-message-p (car vm-message-pointer)))))
     (error nil)))
 
+(defun vm-menu-can-expunge-pop-messages-p ()
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	(not (eq vm-folder-access-method 'pop)))
+    (error nil)))
+
 (defun vm-menu-yank-original ()
   (interactive)
   (save-excursion

File vm-message.el

View file
  • Ignore whitespace
 (provide 'vm-message)
 
 ;; data that is always shared with virtual folders
-(defmacro vm-location-data-of (message) (list 'aref message 0))
+(defsubst vm-location-data-of (message)
+  (aref message 0))
 ;; where message begins starting at the message separator in the folder
-(defmacro vm-start-of (message) (list 'aref (list 'aref message 0) 0))
+(defsubst vm-start-of (message)
+  (aref (aref message 0) 0))
 ;; where headers start (From_ line)
-(defmacro vm-headers-of (message) (list 'aref (list 'aref message 0) 1))
+(defsubst vm-headers-of (message)
+  (aref (aref message 0) 1))
 ;; where visible headers start
-(defun vm-vheaders-of (message)
+(defsubst vm-vheaders-of (message)
   (or (aref (aref message 0) 2)
       (progn (vm-reorder-message-headers message nil nil)
 	     (aref (aref message 0) 2))))
 ;; where text section starts
-(defun vm-text-of (message)
+(defsubst vm-text-of (message)
   (or (aref (aref message 0) 3) (progn (vm-find-and-set-text-of message)
 				       (aref (aref message 0) 3))))
 ;; where text portion of message ends
-(defmacro vm-text-end-of (message) (list 'aref (list 'aref message 0) 4))
+(defsubst vm-text-end-of (message)
+  (aref (aref message 0) 4))
 ;; where message ends
-(defmacro vm-end-of (message) (list 'aref (list 'aref message 0) 5))
+(defsubst vm-end-of (message)
+  (aref (aref message 0) 5))
 ;; soft data vector
-(defmacro vm-softdata-of (message) (list 'aref message 1))
-(defmacro vm-number-of (message) (list 'aref (list 'aref message 1) 0))
-(defmacro vm-padded-number-of (message) (list 'aref (list 'aref message 1) 1))
-(defmacro vm-mark-of (message) (list 'aref (list 'aref message 1) 2))
+(defsubst vm-softdata-of (message)
+  (aref message 1))
+(defsubst vm-number-of (message)
+  (aref (aref message 1) 0))
+(defsubst vm-padded-number-of (message)
+  (aref (aref message 1) 1))
+(defsubst vm-mark-of (message)
+  (aref (aref message 1) 2))
 ;; start of summary line
-(defmacro vm-su-start-of (message) (list 'aref (list 'aref message 1) 3))
+(defsubst vm-su-start-of (message)
+  (aref (aref message 1) 3))
 ;; end of summary line
-(defmacro vm-su-end-of (message) (list 'aref (list 'aref message 1) 4))
+(defsubst vm-su-end-of (message)
+  (aref (aref message 1) 4))
 ;; symbol whose value is the real message.
-(defmacro vm-real-message-sym-of (message)
-  (list 'aref (list 'aref message 1) 5))
+(defsubst vm-real-message-sym-of (message)
+  (aref (aref message 1) 5))
 ;; real message
-(defmacro vm-real-message-of (message)
-  (list 'symbol-value (list 'aref (list 'aref message 1) 5)))
+(defsubst vm-real-message-of (message)
+  (symbol-value (aref (aref message 1) 5)))
 ;; link to previous message in the message list
-(defmacro vm-reverse-link-of (message)
-  (list 'symbol-value (list 'aref (list 'aref message 1) 6)))
+(defsubst vm-reverse-link-of (message)
+  (symbol-value (aref (aref message 1) 6)))
 ;; message type
-(defmacro vm-message-type-of (message) (list 'aref (list 'aref message 1) 7))
+(defsubst vm-message-type-of (message)
+  (aref (aref message 1) 7))
 ;; number that uniquely identifies each message
 ;; this is for the set handling stuff
-(defmacro vm-message-id-number-of (message)
-  (list 'aref (list 'aref message 1) 8))
+(defsubst vm-message-id-number-of (message)
+  (aref (aref message 1) 8))
 ;; folder buffer of this message
-(defmacro vm-buffer-of (message)
-  (list 'aref (list 'aref message 1) 9))
+(defsubst vm-buffer-of (message)
+  (aref (aref message 1) 9))
 ;; cache thread indentation value
-(defmacro vm-thread-indentation-of (message)
-  (list 'aref (list 'aref message 1) 10))
+(defsubst vm-thread-indentation-of (message)
+  (aref (aref message 1) 10))
 ;; list of symbols from vm-thread-obarray that give this message's lineage
-(defmacro vm-thread-list-of (message)
-  (list 'aref (list 'aref message 1) 11))
+(defsubst vm-thread-list-of (message)
+  (aref (aref message 1) 11))
 ;; babyl header frob flag (0 or 1 at beginning of message)
-(defmacro vm-babyl-frob-flag-of (message)
-  (list 'aref (list 'aref message 1) 12))
+(defsubst vm-babyl-frob-flag-of (message)
+  (aref (aref message 1) 12))
 ;; saved attributes, if message was switched from unmirrored to mirrored
-(defmacro vm-saved-virtual-attributes-of (message)
-  (list 'aref (list 'aref message 1) 13))
+(defsubst vm-saved-virtual-attributes-of (message)
+  (aref (aref message 1) 13))
 ;; saved mirror data, if message was switched from unmirrored to mirrored
-(defmacro vm-saved-virtual-mirror-data-of (message)
-  (list 'aref (list 'aref message 1) 14))
+(defsubst vm-saved-virtual-mirror-data-of (message)
+  (aref (aref message 1) 14))
 ;; summary for unmirrored virtual message
-(defmacro vm-virtual-summary-of (message)
-  (list 'aref (list 'aref message 1) 15))
+(defsubst vm-virtual-summary-of (message)
+  (aref (aref message 1) 15))
 ;; MIME layout information; types, ids, positions, etc. of all MIME entities
-(defmacro vm-mime-layout-of (message)
-  (list 'aref (list 'aref message 1) 16))
-(defmacro vm-mime-encoded-header-flag-of (message)
-  (list 'aref (list 'aref message 1) 17))
-(defmacro vm-su-summary-mouse-track-overlay-of (message)
-  (list 'aref (list 'aref message 1) 18))
-(defmacro vm-message-access-method (message)
-  (list 'aref (list 'aref message 1) 19))
+(defsubst vm-mime-layout-of (message)
+  (aref (aref message 1) 16))
+(defsubst vm-mime-encoded-header-flag-of (message)
+  (aref (aref message 1) 17))
+(defsubst vm-su-summary-mouse-track-overlay-of (message)
+  (aref (aref message 1) 18))
+(defsubst vm-message-access-method (message)
+  (aref (aref message 1) 19))
 ;; message attribute vector
-(defmacro vm-attributes-of (message) (list 'aref message 2))
-(defmacro vm-new-flag (message) (list 'aref (list 'aref message 2) 0))
-(defmacro vm-unread-flag (message) (list 'aref (list 'aref message 2) 1))
-(defmacro vm-deleted-flag (message) (list 'aref (list 'aref message 2) 2))
-(defmacro vm-filed-flag (message) (list 'aref (list 'aref message 2) 3))
-(defmacro vm-replied-flag (message) (list 'aref (list 'aref message 2) 4))
-(defmacro vm-written-flag (message) (list 'aref (list 'aref message 2) 5))
-(defmacro vm-forwarded-flag (message) (list 'aref (list 'aref message 2) 6))
-(defmacro vm-edited-flag (message) (list 'aref (list 'aref message 2) 7))
-(defmacro vm-redistributed-flag (message) (list 'aref (list 'aref message 2) 8))
+(defsubst vm-attributes-of (message) (aref message 2))
+(defsubst vm-new-flag (message) (aref (aref message 2) 0))
+(defsubst vm-unread-flag (message) (aref (aref message 2) 1))
+(defsubst vm-deleted-flag (message) (aref (aref message 2) 2))
+(defsubst vm-filed-flag (message) (aref (aref message 2) 3))
+(defsubst vm-replied-flag (message) (aref (aref message 2) 4))
+(defsubst vm-written-flag (message) (aref (aref message 2) 5))
+(defsubst vm-forwarded-flag (message) (aref (aref message 2) 6))
+(defsubst vm-edited-flag (message) (aref (aref message 2) 7))
+(defsubst vm-redistributed-flag (message) (aref (aref message 2) 8))
 ;; message cached data
-(defmacro vm-cache-of (message) (list 'aref message 3))
+(defsubst vm-cache-of (message) (aref message 3))
 ;; message size in bytes (as a string)
-(defmacro vm-byte-count-of (message) (list 'aref (list 'aref message 3) 0))
+(defsubst vm-byte-count-of (message) (aref (aref message 3) 0))
 ;; weekday sent
-(defmacro vm-weekday-of (message) (list 'aref (list 'aref message 3) 1))
+(defsubst vm-weekday-of (message) (aref (aref message 3) 1))
 ;; month day
-(defmacro vm-monthday-of (message) (list 'aref (list 'aref message 3) 2))
+(defsubst vm-monthday-of (message) (aref (aref message 3) 2))
 ;; month sent
-(defmacro vm-month-of (message) (list 'aref (list 'aref message 3) 3))
+(defsubst vm-month-of (message) (aref (aref message 3) 3))
 ;; year sent
-(defmacro vm-year-of (message) (list 'aref (list 'aref message 3) 4))
+(defsubst vm-year-of (message) (aref (aref message 3) 4))
 ;; hour sent
-(defmacro vm-hour-of (message) (list 'aref (list 'aref message 3) 5))
+(defsubst vm-hour-of (message) (aref (aref message 3) 5))
 ;; timezone
-(defmacro vm-zone-of (message) (list 'aref (list 'aref message 3) 6))
+(defsubst vm-zone-of (message) (aref (aref message 3) 6))
 ;; message author's full name (Full-Name: or gouged from From:)
-(defmacro vm-full-name-of (message) (list 'aref (list 'aref message 3) 7))
+(defsubst vm-full-name-of (message) (aref (aref message 3) 7))
 ;; message author address (gouged from From:)
-(defmacro vm-from-of (message) (list 'aref (list 'aref message 3) 8))
+(defsubst vm-from-of (message) (aref (aref message 3) 8))
 ;; message ID (Message-Id:)
-(defmacro vm-message-id-of (message) (list 'aref (list 'aref message 3) 9))
+(defsubst vm-message-id-of (message) (aref (aref message 3) 9))
 ;; number of lines in message (as a string)
-(defmacro vm-line-count-of (message) (list 'aref (list 'aref message 3) 10))
+(defsubst vm-line-count-of (message) (aref (aref message 3) 10))
 ;; message subject (Subject:)
-(defmacro vm-subject-of (message) (list 'aref (list 'aref message 3) 11))
+(defsubst vm-subject-of (message) (aref (aref message 3) 11))
 ;; Regexp that can be used to find the start of the already ordered headers.
-(defmacro vm-vheaders-regexp-of (message)
-  (list 'aref (list 'aref message 3) 12))
+(defsubst vm-vheaders-regexp-of (message)
+  (aref (aref message 3) 12))
 ;; Addresses of recipients in a comma separated list
-(defmacro vm-to-of (message) (list 'aref (list 'aref message 3) 13))
+(defsubst vm-to-of (message) (aref (aref message 3) 13))
 ;; Full names of recipients in a comma separated list.  Addresses if
 ;; full names not available.
-(defmacro vm-to-names-of (message) (list 'aref (list 'aref message 3) 14))
+(defsubst vm-to-names-of (message) (aref (aref message 3) 14))
 ;; numeric month sent
-(defmacro vm-month-number-of (message) (list 'aref (list 'aref message 3) 15))
+(defsubst vm-month-number-of (message) (aref (aref message 3) 15))
 ;; sortable date string (used for easy sorting, naturally)
-(defmacro vm-sortable-datestring-of (message)
-  (list 'aref (list 'aref message 3) 16))
+(defsubst vm-sortable-datestring-of (message)
+  (aref (aref message 3) 16))
 ;; sortable subject, re: garbage removed
-(defmacro vm-sortable-subject-of (message)
-  (list 'aref (list 'aref message 3) 17))
+(defsubst vm-sortable-subject-of (message)
+  (aref (aref message 3) 17))
 ;; tokenized summary entry
-(defmacro vm-summary-of (message)
-  (list 'aref (list 'aref message 3) 18))
+(defsubst vm-summary-of (message)
+  (aref (aref message 3) 18))
 ;; parent of this message, as determined by threading
-(defmacro vm-parent-of (message)
-  (list 'aref (list 'aref message 3) 19))
+(defsubst vm-parent-of (message)
+  (aref (aref message 3) 19))
 ;; message IDs parsed from References header
-(defmacro vm-references-of (message)
-  (list 'aref (list 'aref message 3) 20))
+(defsubst vm-references-of (message)
+  (aref (aref message 3) 20))
 ;; have we retrieved the headers of this message?
 ;; only valid for remote folder access methods
-(defmacro vm-retrieved-headers-of (message)
-  (list 'aref (list 'aref message 3) 21))
+(defsubst vm-retrieved-headers-of (message)
+  (aref (aref message 3) 21))
 ;; have we retrieved the body of this message?
 ;; only valid for remote folder access methods
-(defmacro vm-retrieved-body-of (message)
-  (list 'aref (list 'aref message 3) 22))
+(defsubst vm-retrieved-body-of (message)
+  (aref (aref message 3) 22))
 ;; pop UIDL value for message
-(defmacro vm-pop-uidl-of (message)
-  (list 'aref (list 'aref message 3) 23))
+(defsubst vm-pop-uidl-of (message)
+  (aref (aref message 3) 23))
 ;; extra data shared by virtual messages if vm-virtual-mirror is non-nil
-(defmacro vm-mirror-data-of (message) (list 'aref message 4))
+(defsubst vm-mirror-data-of (message) (aref message 4))
 ;; if message is being edited, this is the buffer being used.
-(defmacro vm-edit-buffer-of (message) (list 'aref (list 'aref message 4) 0))
+(defsubst vm-edit-buffer-of (message) (aref (aref message 4) 0))
 ;; list of virtual messages mirroring the underlying real message
-(defmacro vm-virtual-messages-of (message)
-  (list 'symbol-value (list 'aref (list 'aref message 4) 1)))
+(defsubst vm-virtual-messages-of (message)
+  (symbol-value (aref (aref message 4) 1)))
 ;; modification flag for this message
 ;; nil if all attribute changes have been stuffed into the folder buffer
-(defmacro vm-modflag-of (message) (list 'aref (list 'aref message 4) 2))
+(defsubst vm-modflag-of (message) (aref (aref message 4) 2))
 ;; list of labels attached to this message
-(defmacro vm-labels-of (message) (list 'aref (list 'aref message 4) 3))
+(defsubst vm-labels-of (message) (aref (aref message 4) 3))
 ;; comma list of labels
-(defmacro vm-label-string-of (message) (list 'aref (list 'aref message 4) 4))
+(defsubst vm-label-string-of (message) (aref (aref message 4) 4))
 
-(defmacro vm-set-location-data-of (message vdata) (list 'aset message 0 vdata))
-(defmacro vm-set-start-of (message start)
-  (list 'aset (list 'aref message 0) 0 start))
-(defmacro vm-set-headers-of (message h)
-  (list 'aset (list 'aref message 0) 1 h))
-(defmacro vm-set-vheaders-of (message vh)
-  (list 'aset (list 'aref message 0) 2 vh))
-(defmacro vm-set-text-of (message text)
-  (list 'aset (list 'aref message 0) 3 text))
-(defmacro vm-set-text-end-of (message text)
-  (list 'aset (list 'aref message 0) 4 text))
-(defmacro vm-set-end-of (message end)
-  (list 'aset (list 'aref message 0) 5 end))
-(defmacro vm-set-softdata-of (message data)
-  (list 'aset message 1 data))
-(defmacro vm-set-number-of (message n)
-  (list 'aset (list 'aref message 1) 0 n))
-(defmacro vm-set-padded-number-of (message n)
-  (list 'aset (list 'aref message 1) 1 n))
-(defmacro vm-set-mark-of (message val)
-  (list 'aset (list 'aref message 1) 2 val))
-(defmacro vm-set-su-start-of (message pos)
-  (list 'aset (list 'aref message 1) 3 pos))
-(defmacro vm-set-su-end-of (message pos)
-  (list 'aset (list 'aref message 1) 4 pos))
-(defmacro vm-set-real-message-sym-of (message sym)
-  (list 'aset (list 'aref message 1) 5 sym))
-(defmacro vm-set-reverse-link-of (message link)
-  (list 'set (list 'aref (list 'aref message 1) 6) link))
-(defmacro vm-set-reverse-link-sym-of (message sym)
-  (list 'aset (list 'aref message 1) 6 sym))
-(defmacro vm-set-message-type-of (message type)
-  (list 'aset (list 'aref message 1) 7 type))
-(defmacro vm-set-message-id-number-of (message number)
-  (list 'aset (list 'aref message 1) 8 number))
-(defmacro vm-set-buffer-of (message buffer)
-  (list 'aset (list 'aref message 1) 9 buffer))
-(defmacro vm-set-thread-indentation-of (message val)
-  (list 'aset (list 'aref message 1) 10 val))
-(defmacro vm-set-thread-list-of (message list)
-  (list 'aset (list 'aref message 1) 11 list))
-(defmacro vm-set-babyl-frob-flag-of (message flag)
-  (list 'aset (list 'aref message 1) 12 flag))
-(defmacro vm-set-saved-virtual-attributes-of (message attrs)
-  (list 'aset (list 'aref message 1) 13 attrs))
-(defmacro vm-set-saved-virtual-mirror-data-of (message data)
-  (list 'aset (list 'aref message 1) 14 data))
-(defmacro vm-set-virtual-summary-of (message summ)
-  (list 'aset (list 'aref message 1) 15 summ))
-(defmacro vm-set-mime-layout-of (message layout)
-  (list 'aset (list 'aref message 1) 16 layout))
-(defmacro vm-set-mime-encoded-header-flag-of (message flag)
-  (list 'aset (list 'aref message 1) 17 flag))
-(defmacro vm-set-su-summary-mouse-track-overlay-of (message overlay)
-  (list 'aset (list 'aref message 1) 18 overlay))
-(defmacro vm-set-message-access-method-of (message method)
-  (list 'aset (list 'aref message 1) 19 method))
-(defmacro vm-set-attributes-of (message attrs) (list 'aset message 2 attrs))
+(defsubst vm-set-location-data-of (message vdata) (aset message 0 vdata))
+(defsubst vm-set-start-of (message start)
+  (aset (aref message 0) 0 start))
+(defsubst vm-set-headers-of (message h)
+  (aset (aref message 0) 1 h))
+(defsubst vm-set-vheaders-of (message vh)
+  (aset (aref message 0) 2 vh))
+(defsubst vm-set-text-of (message text)
+  (aset (aref message 0) 3 text))
+(defsubst vm-set-text-end-of (message text)
+  (aset (aref message 0) 4 text))
+(defsubst vm-set-end-of (message end)
+  (aset (aref message 0) 5 end))
+(defsubst vm-set-softdata-of (message data)
+  (aset message 1 data))
+(defsubst vm-set-number-of (message n)
+  (aset (aref message 1) 0 n))
+(defsubst vm-set-padded-number-of (message n)
+  (aset (aref message 1) 1 n))
+(defsubst vm-set-mark-of (message val)
+  (aset (aref message 1) 2 val))
+(defsubst vm-set-su-start-of (message pos)
+  (aset (aref message 1) 3 pos))
+(defsubst vm-set-su-end-of (message pos)
+  (aset (aref message 1) 4 pos))
+(defsubst vm-set-real-message-sym-of (message sym)
+  (aset (aref message 1) 5 sym))
+(defsubst vm-set-reverse-link-of (message link)
+  (set (aref (aref message 1) 6) link))
+(defsubst vm-set-reverse-link-sym-of (message sym)
+  (aset (aref message 1) 6 sym))
+(defsubst vm-set-message-type-of (message type)
+  (aset (aref message 1) 7 type))
+(defsubst vm-set-message-id-number-of (message number)
+  (aset (aref message 1) 8 number))
+(defsubst vm-set-buffer-of (message buffer)
+  (aset (aref message 1) 9 buffer))
+(defsubst vm-set-thread-indentation-of (message val)
+  (aset (aref message 1) 10 val))
+(defsubst vm-set-thread-list-of (message list)
+  (aset (aref message 1) 11 list))
+(defsubst vm-set-babyl-frob-flag-of (message flag)
+  (aset (aref message 1) 12 flag))
+(defsubst vm-set-saved-virtual-attributes-of (message attrs)
+  (aset (aref message 1) 13 attrs))
+(defsubst vm-set-saved-virtual-mirror-data-of (message data)
+  (aset (aref message 1) 14 data))
+(defsubst vm-set-virtual-summary-of (message summ)
+  (aset (aref message 1) 15 summ))
+(defsubst vm-set-mime-layout-of (message layout)
+  (aset (aref message 1) 16 layout))
+(defsubst vm-set-mime-encoded-header-flag-of (message flag)
+  (aset (aref message 1) 17 flag))
+(defsubst vm-set-su-summary-mouse-track-overlay-of (message overlay)
+  (aset (aref message 1) 18 overlay))
+(defsubst vm-set-message-access-method-of (message method)
+  (aset (aref message 1) 19 method))
+(defsubst vm-set-attributes-of (message attrs) (aset message 2 attrs))
 ;; The other routines in attributes group are part of the undo system.
 (defun vm-set-edited-flag-of (message flag)
   (aset (aref message 2) 7 flag)
     (vm-set-modflag-of message t))
   (and (not (buffer-modified-p)) (vm-set-buffer-modified-p t))
   (vm-clear-modification-flag-undos))
-(defmacro vm-set-cache-of (message cache) (list 'aset message 3 cache))
-(defmacro vm-set-byte-count-of (message count)
-  (list 'aset (list 'aref message 3) 0 count))
-(defmacro vm-set-weekday-of (message val)
-  (list 'aset (list 'aref message 3) 1 val))
-(defmacro vm-set-monthday-of (message val)
-  (list 'aset (list 'aref message 3) 2 val))
-(defmacro vm-set-month-of (message val)
-  (list 'aset (list 'aref message 3) 3 val))
-(defmacro vm-set-year-of (message val)
-  (list 'aset (list 'aref message 3) 4 val))
-(defmacro vm-set-hour-of (message val)
-  (list 'aset (list 'aref message 3) 5 val))
-(defmacro vm-set-zone-of (message val)
-  (list 'aset (list 'aref message 3) 6 val))
-(defmacro vm-set-full-name-of (message author)
-  (list 'aset (list 'aref message 3) 7 author))
-(defmacro vm-set-from-of (message author)
-  (list 'aset (list 'aref message 3) 8 author))
-(defmacro vm-set-message-id-of (message id)
-  (list 'aset (list 'aref message 3) 9 id))
-(defmacro vm-set-line-count-of (message count)
-  (list 'aset (list 'aref message 3) 10 count))
-(defmacro vm-set-subject-of (message subject)
-  (list 'aset (list 'aref message 3) 11 subject))
-(defmacro vm-set-vheaders-regexp-of (message regexp)
-  (list 'aset (list 'aref message 3) 12 regexp))
-(defmacro vm-set-to-of (message recips)
-  (list 'aset (list 'aref message 3) 13 recips))
-(defmacro vm-set-to-names-of (message recips)
-  (list 'aset (list 'aref message 3) 14 recips))
-(defmacro vm-set-month-number-of (message val)
-  (list 'aset (list 'aref message 3) 15 val))
-(defmacro vm-set-sortable-datestring-of (message val)
-  (list 'aset (list 'aref message 3) 16 val))
-(defmacro vm-set-sortable-subject-of (message val)
-  (list 'aset (list 'aref message 3) 17 val))
-(defmacro vm-set-summary-of (message val)
-  (list 'aset (list 'aref message 3) 18 val))
-(defmacro vm-set-parent-of (message val)
-  (list 'aset (list 'aref message 3) 19 val))
-(defmacro vm-set-references-of (message val)
-  (list 'aset (list 'aref message 3) 20 val))
-(defmacro vm-set-retrieved-header-of (message val)
-  (list 'aset (list 'aref message 3) 21 val))
-(defmacro vm-set-retrieved-body-of (message val)
-  (list 'aset (list 'aref message 3) 22 val))
-(defmacro vm-set-pop-uidl-of (message val)
-  (list 'aset (list 'aref message 3) 23 val))
-(defmacro vm-set-mirror-data-of (message data)
-  (list 'aset message 4 data))
-(defmacro vm-set-edit-buffer-of (message buf)
-  (list 'aset (list 'aref message 4) 0 buf))
-(defmacro vm-set-virtual-messages-of (message list)
-  (list 'set (list 'aref (list 'aref message 4) 1) list))
-(defmacro vm-set-virtual-messages-sym-of (message sym)
-  (list 'aset (list 'aref message 4) 1 sym))
-(defmacro vm-set-modflag-of (message val)
-  (list 'aset (list 'aref message 4) 2 val))
-(defmacro vm-set-labels-of (message labels)
-  (list 'aset (list 'aref message 4) 3 labels))
-(defmacro vm-set-label-string-of (message string)
-  (list 'aset (list 'aref message 4) 4 string))
+(defsubst vm-set-cache-of (message cache) (aset message 3 cache))
+(defsubst vm-set-byte-count-of (message count)
+  (aset (aref message 3) 0 count))
+(defsubst vm-set-weekday-of (message val)
+  (aset (aref message 3) 1 val))
+(defsubst vm-set-monthday-of (message val)
+  (aset (aref message 3) 2 val))
+(defsubst vm-set-month-of (message val)
+  (aset (aref message 3) 3 val))
+(defsubst vm-set-year-of (message val)
+  (aset (aref message 3) 4 val))
+(defsubst vm-set-hour-of (message val)
+  (aset (aref message 3) 5 val))
+(defsubst vm-set-zone-of (message val)
+  (aset (aref message 3) 6 val))
+(defsubst vm-set-full-name-of (message author)
+  (aset (aref message 3) 7 author))
+(defsubst vm-set-from-of (message author)
+  (aset (aref message 3) 8 author))
+(defsubst vm-set-message-id-of (message id)
+  (aset (aref message 3) 9 id))
+(defsubst vm-set-line-count-of (message count)
+  (aset (aref message 3) 10 count))
+(defsubst vm-set-subject-of (message subject)
+  (aset (aref message 3) 11 subject))
+(defsubst vm-set-vheaders-regexp-of (message regexp)
+  (aset (aref message 3) 12 regexp))
+(defsubst vm-set-to-of (message recips)
+  (aset (aref message 3) 13 recips))
+(defsubst vm-set-to-names-of (message recips)
+  (aset (aref message 3) 14 recips))
+(defsubst vm-set-month-number-of (message val)
+  (aset (aref message 3) 15 val))
+(defsubst vm-set-sortable-datestring-of (message val)
+  (aset (aref message 3) 16 val))
+(defsubst vm-set-sortable-subject-of (message val)
+  (aset (aref message 3) 17 val))
+(defsubst vm-set-summary-of (message val)
+  (aset (aref message 3) 18 val))
+(defsubst vm-set-parent-of (message val)
+  (aset (aref message 3) 19 val))
+(defsubst vm-set-references-of (message val)
+  (aset (aref message 3) 20 val))
+(defsubst vm-set-retrieved-header-of (message val)
+  (aset (aref message 3) 21 val))
+(defsubst vm-set-retrieved-body-of (message val)
+  (aset (aref message 3) 22 val))
+(defsubst vm-set-pop-uidl-of (message val)
+  (aset (aref message 3) 23 val))
+(defsubst vm-set-mirror-data-of (message data)
+  (aset message 4 data))
+(defsubst vm-set-edit-buffer-of (message buf)
+  (aset (aref message 4) 0 buf))
+(defsubst vm-set-virtual-messages-of (message list)
+  (set (aref (aref message 4) 1) list))
+(defsubst vm-set-virtual-messages-sym-of (message sym)
+  (aset (aref message 4) 1 sym))
+(defsubst vm-set-modflag-of (message val)
+  (aset (aref message 4) 2 val))
+(defsubst vm-set-labels-of (message labels)
+  (aset (aref message 4) 3 labels))
+(defsubst vm-set-label-string-of (message string)
+  (aset (aref message 4) 4 string))
 
 (defun vm-make-message ()
   (let ((v (make-vector 5 nil)) sym)

File vm-mime.el

View file
  • Ignore whitespace
   (error "can't return from vm-mime-error"))
 
 (if (fboundp 'define-error)
-    (define-error 'vm-mime-error "MIME error")
+    (progn
+      (define-error 'vm-image-too-small "Image too small")
+      (define-error 'vm-mime-error "MIME error"))
+  (put 'vm-image-too-small 'error-conditions '(vm-image-too-small error))
+  (put 'vm-image-too-small 'error-message "Image too small")
   (put 'vm-mime-error 'error-conditions '(vm-mime-error error))
   (put 'vm-mime-error 'error-message "MIME error"))
 
 	  ((vm-mime-types-match "message" type) t)
 	  ((vm-mime-types-match "text/html" type)
 	   (and (fboundp 'w3-region)
+		vm-mime-use-w3-for-text/html
 		;; this because GNUS bogusly sets up autoloads
 		;; for w3-region even if W3 isn't installed.
 		(fboundp 'w3-about)
 	;; be signaled if vm-mime-can-display-internal ever asks
 	;; for one of the other fields
 	(fake-layout (make-vector 1 (list nil)))
-	(done nil))
-    (while (and alist (not done))
+	best second-best)
+    (while (and alist (not best))
       (cond ((and (vm-mime-types-match (car (car alist)) type)
-		  (or (progn
-			(setcar (aref fake-layout 0) (nth 1 (car alist)))
-			(vm-mime-can-display-internal fake-layout))
-		      (vm-mime-find-external-viewer (nth 1 (car alist)))))
-	     (setq done t))
-	    (t (setq alist (cdr alist)))))
-    (and alist (car alist))))
+		  (not (vm-mime-types-match (nth 1 (car alist)) type)))
+	     (cond ((and (not best)
+			 (progn
+			   (setcar (aref fake-layout 0) (nth 1 (car alist)))
+			   (vm-mime-can-display-internal fake-layout)))
+		    (setq best (car alist)))
+		   ((and (not second-best)
+			 (vm-mime-find-external-viewer (nth 1 (car alist))))
+		    (setq second-best (car alist))))))
+      (setq alist (cdr alist)))
+    (or best second-best)))
 
 (defun vm-mime-convert-undisplayable-layout (layout)
   (catch 'done
 		      (setq second-best (car part-list))))
 	       (setq part-list (cdr part-list)))
 	     (setq best-layout (or best second-best
+				   (car (vm-mm-layout-parts layout))))))
+	  ((and (consp vm-mime-alternative-select-method)
+		(eq (car vm-mime-alternative-select-method)
+		    'favorite-internal))
+	   (let ((done nil)
+		 (best nil)
+		 (saved-part-list
+		  (nreverse (copy-sequence (vm-mm-layout-parts layout))))
+		 (favs (cdr vm-mime-alternative-select-method))
+		 (second-best nil)
+		 part-list type)
+	     (while (and favs (not done))
+	       (setq part-list saved-part-list)
+	       (while (and part-list (not done))
+		 (setq type (car (vm-mm-layout-type (car part-list))))
+		 (cond ((or (vm-mime-can-display-internal (car part-list) t)
+			    (vm-mime-find-external-viewer type))
+			(if (vm-mime-types-match (car favs) type)
+			    (setq best (car part-list)
+				  done t)
+			  (or second-best
+			      (setq second-best (car part-list))))))
+		 (setq part-list (cdr part-list)))
+	       (setq favs (cdr favs)))
+	     (setq best-layout (or best second-best
+				   (car (vm-mm-layout-parts layout))))))
+	  ((and (consp vm-mime-alternative-select-method)
+		(eq (car vm-mime-alternative-select-method) 'favorite))
+	   (let ((done nil)
+		 (best nil)
+		 (saved-part-list
+		  (nreverse (copy-sequence (vm-mm-layout-parts layout))))
+		 (favs (cdr vm-mime-alternative-select-method))
+		 (second-best nil)
+		 part-list type)
+	     (while (and favs (not done))
+	       (setq part-list saved-part-list)
+	       (while (and part-list (not done))
+		 (setq type (car (vm-mm-layout-type (car part-list))))
+		 (cond ((and (vm-mime-can-display-internal (car part-list) t)
+			     (vm-mime-should-display-internal (car part-list)
+							      nil))
+			(if (vm-mime-types-match (car favs) type)
+			    (setq best (car part-list)
+				  done t)
+			  (or second-best
+			      (setq second-best (car part-list))))))
+		 (setq part-list (cdr part-list)))
+	       (setq favs (cdr favs)))
+	     (setq best-layout (or best second-best
 				   (car (vm-mm-layout-parts layout)))))))
   (vm-decode-mime-layout best-layout)))
 
 	       'vm-mime-display-internal-image-xxxx
 	       tempfile)
 	  (delete-region start end))
-	(if (or (not (bolp))
-		(bobp)
-		(= (point) (vm-text-of (vm-mm-layout-message layout)))
-		(map-extents 'extent-property nil (1- (point)) (point)
-			     'begin-glyph))
+	(if (not (bolp))
 	    (insert "\n"))
 	(setq do-strips (and (stringp vm-imagemagick-convert-program)
 			     vm-mime-use-image-strips))
 	(cond (do-strips
 	       (condition-case error-data
 		   (let ((strips (vm-make-image-strips tempfile
-						       (font-height
-							(face-font 'default))
+						       (* 2 (font-height
+							(face-font 'default)))
 						       image-type
 						       t incremental))
 			 process image-list extent-list
 						     (setq first nil)
 						     "+-----+")
 						 "|image|"))))))
-		       (setq e (vm-make-extent (1- (point)) (point)))
-		       (if (cdr strips) (insert "\n"))
+		       (insert " \n")
+		       (setq e (vm-make-extent (- (point) 2) (1- (point))))
 		       (vm-set-extent-property e 'begin-glyph g)
 		       (vm-set-extent-property e 'start-open t)
 		       (setq extent-list (cons e extent-list))
 	       ;; XEmacs 21.2 can pixel scroll images (sort of)
 	       ;; if the entire image is above the baseline.
 	       (set-glyph-baseline g 100)
-	       (set-glyph-face g 'vm-monochrome-image)
-	       (setq e (vm-make-extent (1- (point)) (point)))
+	       (if (memq image-type '(xbm))
+		   (set-glyph-face g 'vm-monochrome-image))
+	       (insert " \n")
+	       (setq e (vm-make-extent (- (point) 2) (1- (point))))
 	       (vm-set-extent-property e 'begin-glyph g)
 	       (vm-set-extent-property e 'start-open t)))
 	t )))
 			      ':data
 			      (format "[%s image]\n" type-name))))))
       (set-glyph-baseline g 50)
-      (set-glyph-face g 'vm-monochrome-image)
+      (if (memq image-type '(xbm))
+	  (set-glyph-face g 'vm-monochrome-image))
       (set-extent-begin-glyph (car extents) g)
       (setq strips (cdr strips)
 	    extents (cdr extents)))))
 				     ':data
 				     (format "[%s image]\n" type-name))))))
 	     (set-glyph-baseline g 50)
-	     (set-glyph-face g 'vm-monochrome-image)
+	     (if (memq image-type '(xbm))
+		 (set-glyph-face g 'vm-monochrome-image))
 	     (set-extent-begin-glyph (car eee) g)))
       (setq which-strips (cdr which-strips)))))
 
   (if (and (vm-images-possible-here-p)
 	   (vm-image-type-available-p 'xpm))
       (let ((dir vm-image-directory)
-	    ;; no device-bitplanes under FSF Emacs, so assume we
-	    ;; have a >=16-bit display
-	    (colorful t)
+	    ;; no display-planes function under FSF Emacs before
+	    ;; v21, so only try to use it if present.
+	    (colorful (if (fboundp 'display-planes)
+			  (> (display-planes) 15)
+			t))
 	    (tuples
 	     '(("text" "document-simple.xpm" "document-colorful.xpm")
 	       ("image" "mona_stamp-simple.xpm" "mona_stamp-colorful.xpm")

File vm-minibuf.el

View file
  • Ignore whitespace
 	(point-min (if (fboundp 'minibuffer-prompt-end)
 		       (minibuffer-prompt-end)
 		     (point-min)))
+	(case-fold-search completion-ignore-case)
 	trimmed-c-list c-list beg end diff word word-prefix-regexp completion)
     ;; find the beginning and end of the word we're trying to complete
     (if (or (eobp) (memq (following-char) '(?\t ?\n ?\ )))
       (setq diff (- (length completion) (length word)))
       (cond
        ;; We have some completion chars.  Insert them.
-       ((> diff 0)
+       ((or (> diff 0)
+	    (and (zerop diff) (not (string-equal completion word))))
 	(goto-char end)
-	(insert (substring completion (- diff)))
+	(delete-char (- (length word)))
+	(insert completion)
 	(if (and vm-completion-auto-space
 		 (null (cdr trimmed-c-list)))
 	    (insert " ")))

File vm-misc.el

View file
  • Ignore whitespace
 		     nil)))))
 
 (defvar enable-multibyte-characters)
+(defvar buffer-display-table)
 (defun vm-fsfemacs-nonmule-display-8bit-chars ()
   (cond ((and vm-fsfemacs-p 
 	      (or (not vm-fsfemacs-mule-p)
 	(hex-digit-alist '((?0 .  0)  (?1 .  1)  (?2 .  2)  (?3 .  3)
 			   (?4 .  4)  (?5 .  5)  (?6 .  6)  (?7 .  7)
 			   (?8 .  8)  (?9 .  9)  (?A . 10)  (?B . 11)
-			   (?C . 12)  (?D . 13)  (?E . 14)  (?F . 15)))
+			   (?C . 12)  (?D . 13)  (?E . 14)  (?F . 15)
+			   (?a . 10)  (?b . 11)  (?c . 12)  (?d . 13)
+			   (?e . 14)  (?f . 15)))
 	char)
     (save-excursion
       (goto-char (point-min))

File vm-page.el

View file
  • Ignore whitespace
 			   ((symbolp arg) nil)
 			   (t arg))))
 
-(defun vm-scroll-forward-one-line ()
-  "Scroll forward one line."
-  (interactive)
-  (vm-scroll-forward 1))
+(defun vm-scroll-forward-one-line (&optional count)
+  "Scroll forward one line.
+Prefix arg N means scroll forward N lines.
+Negative arg means scroll backward."
+  (interactive "p")
+  (vm-scroll-forward count))
 
-(defun vm-scroll-backward-one-line ()
-  "Scroll backward one line."
-  (interactive)
-  (vm-scroll-forward -1))
+(defun vm-scroll-backward-one-line (&optional count)
+  "Scroll backward one line.
+Prefix arg N means scroll backward N lines.
+Negative arg means scroll forward."
+  (interactive "p")
+  (vm-scroll-forward (- count)))
 
 (defun vm-highlight-headers ()
   (cond
 	(setq search-tuples (cdr search-tuples)))))))
 
 (defun vm-display-xface ()
+  (cond (vm-xemacs-p (vm-display-xface-xemacs))
+	((and vm-fsfemacs-p
+	      (and (stringp vm-uncompface-program)
+		   (fboundp 'create-image)))
+	 (vm-display-xface-fsfemacs))))
+
+(defun vm-display-xface-xemacs ()
   (let ((case-fold-search t) e g h)
     (if (map-extents (function
 		      (lambda (e ignore)
 	    (set-extent-property e 'vm-xface t)
 	    (set-extent-begin-glyph e g))))))
 
+(defun vm-display-xface-fsfemacs ()
+  (catch 'done
+    (let ((case-fold-search t) i g h)
+      (if (next-single-property-change (point-min) 'vm-xface)
+	  nil
+	(goto-char (point-min))
+	(if (re-search-forward "^X-Face:" nil t)
+	    (progn
+	      (goto-char (match-beginning 0))
+	      (vm-match-header)
+	      (setq h (vm-matched-header-contents))
+	      (setq g (intern h vm-xface-cache))
+	      (if (boundp g)
+		  (setq g (symbol-value g))
+		(setq i (vm-convert-xface-to-fsfemacs-image-instantiator h))
+		(cond (i
+		       (set g i)
+		       (setq g (symbol-value g)))
+		      (t (throw 'done nil))))
+	      (let ((pos (vm-vheaders-of (car vm-message-pointer)))
+		    o )
+		;; An image must replace the normal display of at
+		;; least one character.  Since we want to put the
+		;; image at the beginning of the visible headers
+		;; section, it will obscure the first character of
+		;; that section.  To display that character we add
+		;; an after-string that contains the character.
+		;; Kludge city, but it works.
+		(setq o (make-overlay (+ 0 pos) (+ 1 pos)))
+		(overlay-put o 'after-string
+			     (char-to-string (char-after pos)))
+		(overlay-put o 'display g))))))))
+
+(defun vm-convert-xface-to-fsfemacs-image-instantiator (data)
+  (let ((work-buffer nil)
+	retval)
+    (catch 'done
+      (unwind-protect
+	  (save-excursion
+	    (if (not (stringp vm-uncompface-program))
+		(throw 'done nil))
+	    (setq work-buffer (vm-make-work-buffer))
+	    (set-buffer work-buffer)
+	    (insert data)
+	    (setq retval
+		  (apply 'call-process-region
+			 (point-min) (point-max)
+			 vm-uncompface-program t t nil
+			 (if vm-uncompface-accepts-dash-x '("-X") nil)))
+	    (if (not (eq retval 0))
+		(throw 'done nil))
+	    (if vm-uncompface-accepts-dash-x
+		(throw 'done
+		       (list 'image ':type 'xbm
+			     ':ascent 80
+			     ':foreground "black"
+			     ':background "white"
+			     ':data (buffer-string))))
+	    (if (not (stringp vm-icontopbm-program))
+		(throw 'done nil))
+	    (goto-char (point-min))
+	    (insert "/* Width=48, Height=48 */\n");
+	    (setq retval
+		  (call-process-region
+		   (point-min) (point-max)
+		   vm-icontopbm-program t t nil))
+	    (if (not (eq retval 0))
+		nil
+	      (list 'image ':type 'pbm
+		    ':ascent 80
+		    ':foreground "black"
+		    ':background "white"
+		    ':data (buffer-string))))
+	(and work-buffer (kill-buffer work-buffer))))))
+
 (defun vm-url-help (object)
   (format
    "Use mouse button 2 to send the URL to %s.
 	(vm-energize-headers)))
   ;; display xfaces, if we can
   (if (and vm-display-xfaces
-	   vm-xemacs-p
-	   (featurep 'xface))
+	   (or (and vm-xemacs-p (featurep 'xface))
+	       (and vm-fsfemacs-p (fboundp 'create-image)
+		    (stringp vm-uncompface-program))))
       (save-restriction
 	(widen)
 	(narrow-to-region (vm-headers-of (car vm-message-pointer))
 (defun vm-preview-current-message ()
   ;; Set just-passing-through if the user will never see the
   ;; message in the previewed state.  Save some time later by not
-  ;; doing preview action that hte user will never see anyway.
+  ;; doing preview action that the user will never see anyway.
   (let ((just-passing-through
 	 (or (null vm-preview-lines)
 	     (and (not vm-preview-read-messages)

File vm-pop.el

View file
  • Ignore whitespace
   (vm-select-folder-buffer)
   (vm-check-for-killed-summary)
   (vm-error-if-virtual-folder)
+  (if (and (interactive-p) (eq vm-folder-access-method 'pop))
+      (error "This command is not meant for POP folders.  Use the normal folder expunge instead."))
   (let ((process nil)
 	(source nil)
 	(trouble nil)
 				 (cdr (car r-list))))
 		     (vm-pop-retrieve-to-target process folder-buffer
 						statblob)
-		     (setq r-list (cdr r-list))))
+		     (setq r-list (cdr r-list)
+			   n (1+ n))))
 	       (error
 		(message "Retrieval from %s signaled: %s" safe-popdrop
 			 error-data))

File vm-reply.el

View file
  • Ignore whitespace
 	      (setq resent t))
 	  (vm-mail-mode-remove-header "Date:")))))
 
+(defvar vm-dont-ask-coding-system-question nil)
+
+(cond ((and vm-fsfemacs-mule-p
+	    (not (fboundp 'vm-old-select-message-coding-system)))
+       (fset 'vm-old-select-message-coding-system
+	     (symbol-function 'select-message-coding-system))
+       (defun select-message-coding-system (&rest ignored)
+	 (if vm-dont-ask-coding-system-question
+	     nil
+	   (apply 'vm-old-select-message-coding-system ignored)))))
+
 (defun vm-mail-send ()
   "Just like mail-send except that VM flags the appropriate message(s)
 as replied to, forwarded, etc, if appropriate."
       ;; save-excursion to be sure.
       ;;
       ;; also protect value of this-command from minibuffer reads
-      (let ((this-command this-command))
+      (let ((this-command this-command)
+	    ;; For Emacs 21.
+	    (mail-send-nonascii t)
+	    (sendmail-coding-system (vm-binary-coding-system))
+	    (vm-dont-ask-coding-system-question t))
 	(save-excursion
 	  (mail-send))))
     ;; be careful, something could have killed the composition

File vm-startup.el

View file
  • Ignore whitespace
 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 7.00.
+This is VM 7.03.
 
 Commands:
    h - summarize folder contents
    vm-honor-page-delimiters
    vm-image-directory
    vm-imagemagick-convert-program
+   vm-imagemagick-identify-program
    vm-imap-auto-expunge-alist
    vm-imap-bytes-per-session
    vm-imap-expunge-after-retrieving
   (vm-check-for-killed-folder)
   (vm-select-folder-buffer-if-possible)
   (vm-check-for-killed-summary)
+  (if (and (equal folder "") (stringp vm-last-visit-pop-folder))
+      (setq folder vm-last-visit-pop-folder))
   (if (null (vm-pop-find-spec-for-name folder))
       (error "No such POP folder: %s" folder))
   (setq vm-last-visit-pop-folder folder)
       'vm-honor-page-delimiters
       'vm-image-directory
       'vm-imagemagick-convert-program
+      'vm-imagemagick-identify-program
 ;; IMAP passwords might be listed here
 ;;      'vm-imap-auto-expunge-alist
       'vm-imap-bytes-per-session
       'vm-mail-header-insert-date
       'vm-mail-header-insert-message-id
       'vm-mail-hook
-      'vm-make-crash-box-name
-      'vm-make-spool-file-name
       'vm-mail-check-interval
       'vm-mail-mode-hook
       'vm-mail-send-hook
+      'vm-make-crash-box-name
+      'vm-make-spool-file-name
       'vm-mime-7bit-composition-charset
       'vm-mime-8bit-composition-charset
       'vm-mime-8bit-text-transfer-encoding

File vm-summary.el

View file
  • Ignore whitespace
 	   (setq timezone (substring date (match-beginning 0) (match-end 0)))))
     (while (and (or (zerop (length monthday))
 		    (zerop (length year)))
-		(string-match "\\(^\\| \\)\\([0-9]+\\) " date start))
+		(string-match "\\(^\\| \\)\\([0-9]+\\)\\($\\| \\)" date start))
       (setq string (substring date (match-beginning 2) (match-end 2))
 	    start (match-end 0))
       (cond ((and (zerop (length monthday))

File vm-vars.el

View file
  • Ignore whitespace
 
 (provide 'vm-vars)
 
-(defvar vm-init-file "~/.vm"
+;; Emacs 19.34 doens't have defcustom but we want to continue to
+;; supoprt that Emacs version.  So fake up some definitions if we
+;; need them and erase them after we're done.
+
+(defvar vm-faked-defcustom nil)
+
+(eval-and-compile
+  (condition-case ()
+      (require 'custom)
+    (error nil))
+  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+      nil ;; We've got what we needed
+    ;; We have the old custom-library, or no library at all so
+    ;; hack around it!
+    (setq vm-faked-defcustom t)
+    (defmacro defgroup (&rest args) nil)
+    (defmacro defcustom (var value doc &rest args) 
+      (` (defvar (, var) (, value) (, doc))))))
+
+(defcustom vm-init-file "~/.vm"
   "*Startup file for VM that is loaded the first time you run VM
-in an Emacs session.")
-
-(defvar vm-preferences-file "~/.vm.preferences"
-  "*Secondary startup file for VM, loaded after `vm-init-file'.
+in an Emacs session."
+  :type 'file)
+
+(defcustom vm-preferences-file "~/.vm.preferences"
+  "Unused.
+*Secondary startup file for VM, loaded after `vm-init-file'.
 This file is written and overwritten by VM and is not meant for
-users to edit directly.")
-
-(defvar vm-folder-directory nil
-  "*Directory where folders of mail are kept.")
-
-(defvar vm-primary-inbox "~/INBOX"
-  "*Mail is moved from the system mailbox to this file for reading.")
-
-(defvar vm-crash-box "~/INBOX.CRASH"
+users to edit directly."
+  :type 'file)
+
+(defcustom vm-folder-directory nil
+  "*Directory where folders of mail are kept."
+  :type '(choice (const nil) directory))
+
+(defcustom vm-primary-inbox "~/INBOX"
+  "*Mail is moved from the system mailbox to this file for reading."
+  :type 'file)
+
+(defcustom vm-crash-box "~/INBOX.CRASH"
   "*File in which to store mail temporarily while it is transferred from
 the system mailbox to the primary inbox.  If a crash occurs
 during this mail transfer, any missing mail will be found in this
 file.  VM will do crash recovery from this file automatically at
-startup, as necessary.")
-
-(defvar vm-keep-crash-boxes nil
+startup, as necessary."
+  :type 'file)
+
+(defcustom vm-keep-crash-boxes nil
   "*Non-nil value should be a string specifying a directory where
 your crash boxes should be moved after VM has copied new mail
 out of them.  This is a safety measure.  In at least one case a
 clean out this directory from time to time; VM does not do so.
 
 A nil value means VM should just delete crash boxes after it
-has copied out the mail.")
-
-(defvar vm-index-file-suffix nil
+has copied out the mail."
+  :type 'boolean)
+
+(defcustom vm-index-file-suffix nil
   "*Suffix used to construct VM index file names.
 When VM visits a folder, it checks for the existence of a file
 whose name is the folder's file name with the value of this
 than parsing the folder itself.
 
 When you save a folder, the index file will be rewritten with
-updated informatoin about the folder.
-
-A nil value means VM should not read or write index files.")
+updated information about the folder.
+
+A nil value means VM should not read or write index files."
+  :type '(choice string (const nil)))
 
 ;; use this function to access vm-spool-files on the fly.  this
 ;; allows us to use environmental variables without setting
 	   (setq vm-spool-files (vm-delete-directory-names
 				 (list vm-spool-files))))))
 
-(defvar vm-spool-files nil
+(defcustom vm-spool-files nil
   "*If non-nil this variable's value should be a list of strings 
 or a list of lists.
 
 `vm-spool-files' will default to the value of the shell
 environmental variables MAILPATH or MAIL if either of these
 variables are defined and no particular value for `vm-spool-files'
-has been specified.")
-
-(defvar vm-spool-file-suffixes nil
+has been specified."
+  :type '(choice (repeat string)
+		 (repeat (list string string string))))
+
+(defcustom vm-spool-file-suffixes nil
   "*List of suffixes to be used to create possible spool file names
 for folders.  Example:
 
 
 The value of `vm-spool-files-suffixes' will not be used unless
 `vm-crash-box-suffix' is also defined, since a crash box is
-required for all mail retrieval from spool files.")
-
-(defvar vm-crash-box-suffix nil
+required for all mail retrieval from spool files."
+  :type '(list string))
+
+(defcustom vm-crash-box-suffix nil
   "*String suffix used to create possible crash box file names for folders.
 When VM uses `vm-spool-file-suffixes' to create a spool file name,
 it will append the value of `vm-crash-box-suffix' to the folder's
-file name to create a crash box name.")
-
-(defvar vm-make-spool-file-name nil
+file name to create a crash box name."
+  :type '(list string))
+
+(defcustom vm-make-spool-file-name nil
   "*Non-nil value should be a function that returns a spool file name
 for a folder.  The function will be called with one argument, the
 folder's file name.  If the folder does not have a file name,
-the function will not be called.")
-
-(defvar vm-make-crash-box-name nil
+the function will not be called."
+  :type 'function)
+
+(defcustom vm-make-crash-box-name nil
   "*Non-nil value should be a function that returns a crash box file name
 for a folder.  The function will be called with one argument, the
 folder's file name.  If the folder does not have a file name,
-the function will not be called.")
-
-(defvar vm-pop-md5-program "md5"
+the function will not be called."
+  :type 'function)
+
+(defcustom vm-pop-md5-program "md5"
   "*Program that reads a message on its standard input and writes an
-MD5 digest on its output.")
-
-(defvar vm-pop-max-message-size nil
-  "*If VM is about to retrieve via POP a message larger than this size
-(in bytes) it will ask the you whether it should retrieve the message.
+MD5 digest on its output."
+  :type 'string)
+
+(defcustom vm-pop-max-message-size nil
+  "*If VM is about to retrieve via POP a message larger than this
+size (in bytes) it will ask the you whether it should retrieve
+the message.
 
 If VM is retrieving mail automatically because `vm-auto-get-new-mail'
 is set to a numeric value then you will not be prompted about large
 warning message.  You will be able to retrieved any skipped messages
 later by running `vm-get-new-mail' interactively.
 
-A nil value for `vm-pop-max-message-size' means no size limit.")
-
-(defvar vm-pop-messages-per-session nil
+A nil value for `vm-pop-max-message-size' means no size limit."
+  :type '(choice (const nil) integer))
+
+(defcustom vm-pop-messages-per-session nil