Anonymous avatar Anonymous committed 2027e80

vm-6.72, package standards update

Comments (0)

Files changed (16)

 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 1.20
-AUTHOR_VERSION = 6.71
+VERSION = 1.21
+AUTHOR_VERSION = 6.72
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = vm
 PKG_TYPE = regular
 (vm
-  (standards-version 1.0
+  (standards-version 1.1
    version VERSION
    author-version AUTHOR_VERSION
    date DATE
    build-date BUILD_DATE
    maintainer MAINTAINER
-   distribution stable
+   distribution xemacs
    priority medium
    category CATEGORY
    dump nil
 	  (setq lines (cdr lines)))))
   (message ""))
 
-(defun vm-session-initialization ()
-  ;; If this is the first time VM has been run in this Emacs session,
-  ;; do some necessary preparations.
-  (if (or (not (boundp 'vm-session-beginning))
-	  vm-session-beginning)
-      (progn
-	(random t)
-	(vm-load-init-file)
-	(if (not vm-window-configuration-file)
-	    (setq vm-window-configurations vm-default-window-configuration)
-	  (or (vm-load-window-configurations vm-window-configuration-file)
-	      (setq vm-window-configurations vm-default-window-configuration)))
-	(setq vm-buffers-needing-display-update (make-vector 29 0))
-	(setq vm-session-beginning nil))))
-
 (defun vm-toggle-read-only ()
   (interactive)
   (vm-select-folder-buffer)
 	(coding-system-for-read 'binary)
 	(coding-system-for-write 'binary)
 	greeting timestamp
-	host port auth user pass source-list process-buffer
+	host port mailbox auth user pass source-list process-buffer
 	source-nopwd-nombox)
     (unwind-protect
 	(catch 'end-of-session
 	    ;; Tell MULE not to mess with the text.
 	    (if (or vm-xemacs-mule-p vm-fsfemacs-mule-p)
 		(set-buffer-file-coding-system 'binary t))
-	    (insert "starting IMAP session " (current-time-string) "\n")
-	    (insert (format "connecting to %s:%s\n" host port))
-	    ;; open the connection to the server
-	    (setq process (open-network-stream "IMAP" process-buffer
-					       host port))
-	    (and (null process) (throw 'end-of-session nil))
-	    (insert "connected\n")
+	    (if (equal auth "preauth")
+		(setq process
+		      (run-hook-with-args-until-success 'vm-imap-session-preauth-hook
+							host port mailbox
+							user pass)))
+	    (if (processp process)
+		(set-process-buffer process (current-buffer))
+	      (insert "starting IMAP session " (current-time-string) "\n")
+	      (insert (format "connecting to %s:%s\n" host port))
+	      ;; open the connection to the server
+	      (setq process (open-network-stream "IMAP" process-buffer
+						 host port))
+	      (and (null process) (throw 'end-of-session nil))
+	      (insert "connected\n"))
 	    (process-kill-without-query process)
 	    (make-local-variable 'vm-imap-read-point)
 	    (setq vm-imap-read-point (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]))))
+	     'vm-mime-pipe-body-to-queried-command-discard-output) t]
+	   ["Delete object" 'vm-delete-mime-object t]))))
 
 (defconst vm-menu-url-browser-menu
   (let ((title (if (vm-menu-fsfemacs-menus-p)
 
 (defun vm-set-mm-layout-type (e type) (aset e 0 type))
 (defun vm-set-mm-layout-qtype (e type) (aset e 1 type))
+(defun vm-set-mm-layout-encoding (e encoding) (aset e 2 encoding))
+(defun vm-set-mm-layout-id (e id) (aset e 3 id))
+(defun vm-set-mm-layout-description (e des) (aset e 4 des))
+(defun vm-set-mm-layout-disposition (e d) (aset e 5 d))
+(defun vm-set-mm-layout-qdisposition (e d) (aset e 6 d))
+(defun vm-set-mm-layout-header-start (e start) (aset e 7 start))
+(defun vm-set-mm-layout-body-start (e start) (aset e 8 start))
+(defun vm-set-mm-layout-body-end (e end) (aset e 9 end))
+(defun vm-set-mm-layout-parts (e parts) (aset e 10 parts))
 (defun vm-set-mm-layout-cache (e c) (aset e 11 c))
 (defun vm-set-mm-layout-display-error (e c) (aset e 13 c))
 
 	       ;; In XEmacs 20.0 beta93 decode-coding-region moves point.
 	       (goto-char opoint))))
 	((not (vm-multiple-fonts-possible-p)) nil)
-	((vm-string-member charset vm-mime-default-face-charsets) nil)
+	((vm-mime-default-face-charset-p charset) nil)
 	(t
 	 (let ((font (cdr (vm-string-assoc
 			   charset
 
 (defun vm-mime-parse-entity (&optional m default-type default-encoding
 				       passing-message-only)
-  (let ((case-fold-search t) version type qtype encoding id description
-	disposition qdisposition boundary boundary-regexp start
-	multipart-list c-t c-t-e done p returnval)
-    (catch 'return-value
-      (save-excursion
-	(if (and m (not passing-message-only))
-	    (progn
-	      (setq m (vm-real-message-of m))
-	      (set-buffer (vm-buffer-of m))))
+  (catch 'return-value
+    (save-excursion
+      (if (and m (not passing-message-only))
+	  (progn
+	    (setq m (vm-real-message-of m))
+	    (set-buffer (vm-buffer-of m))))
+      (let ((case-fold-search t) version type qtype encoding id description
+	    disposition qdisposition boundary boundary-regexp start
+	    multipart-list c-t c-t-e done p returnval)
 	(save-excursion
 	  (save-restriction
 	    (if (and m (not passing-message-only))
 	      (vm-marker (point-max))
 	      nil
 	      nil
-	      (vm-mm-layout-message layout)
+	      (vm-mime-make-message-symbol (vm-mm-layout-message layout))
 	      nil))))
 
 (defun vm-mime-should-display-button (layout dont-honor-content-disposition)
 				       layout)
 			    (void-function nil)))))
 		((and (vm-mime-should-display-internal layout dont-honor-c-d)
-		      (condition-case nil
+		      (or (condition-case nil
 			      (funcall (intern
 					(concat "vm-mime-display-internal-"
 						type))
 				       layout)
-			    (void-function nil))))
+			    (void-function nil))
+			  (condition-case nil
+			      (funcall (intern
+					(concat "vm-mime-display-internal-"
+						type-no-subtype))
+				       layout)
+			    (void-function nil)))))
 		((vm-mime-types-match "multipart" type)
 		 (or (condition-case nil
 			 (funcall (intern
 (defun vm-mime-display-button-text (layout)
   (vm-mime-display-button-xxxx layout t))
 
+(defun vm-mime-display-internal-text (layout)
+  (vm-mime-display-internal-text/plain layout))
+
 (defun vm-mime-display-internal-text/html (layout)
   (if (fboundp 'w3-region)
       (condition-case error-data
 	    (or (not (file-exists-p file))
 		(y-or-n-p "File exists, overwrite? ")
 		(error "Aborted"))
-	    ;; Bind the function jka-compr-get-compression-info to
-	    ;; somethign that will return nil so that jka-compr
-	    ;; won't compress already compressed data.  This is a
-	    ;; crock, but I'm tired of hearing about this.
-	    (let ((jk-func (and (fboundp 'jka-compr-get-compression-info)
-				(symbol-function
-				 'jka-compr-get-compression-info))))
-	      (unwind-protect
-		  (progn
-		    (fset 'jka-compr-get-compression-info 'ignore)
-		    (write-region (point-min) (point-max) file nil nil))
-		(if jk-func
-		    (fset 'jka-compr-get-compression-info jk-func)
-		  (fmakunbound 'jka-compr-get-compression-info)))))
+	    ;; Bind the jka-compr-compression-info-list to nil so
+	    ;; that jka-compr won't compress already compressed
+	    ;; data.  This is a crock, but as usual I'm getting
+	    ;; the bug reports for somebody else's bad code.
+	    (let ((jka-compr-compression-info-list nil))
+	      (write-region (point-min) (point-max) file nil nil))
+	    (if vm-mime-delete-after-saving
+		(vm-mime-discard-layout-contents layout
+						 (expand-file-name file))))
 	(and work-buffer (kill-buffer work-buffer))))))
 
 (defun vm-mime-pipe-body-to-command (command layout &optional discard-output)
 					 (car (vm-mm-layout-type o)))
 		    (let* ((charset (or (vm-mime-get-parameter o "charset")
 				      "us-ascii")))
-		      (vm-string-member charset vm-mime-default-face-charsets))
+		      (vm-mime-default-face-charset-p charset))
 		    (string-match "^\\(7bit\\|8bit\\|binary\\)$"
 				  (vm-mm-layout-encoding o))))))))
 
 (defun vm-mime-charset-internally-displayable-p (name)
   (cond ((and vm-xemacs-mule-p (memq (device-type) '(x mswindows)))
 	 (vm-string-assoc name vm-mime-mule-charset-to-coding-alist))
-	((and vm-fsfemacs-mule-p (memq window-system '(x win32)))
+	((and vm-fsfemacs-mule-p (memq window-system '(x win32 w32)))
 	 (vm-string-assoc name vm-mime-mule-charset-to-coding-alist))
 	((vm-multiple-fonts-possible-p)
-	 (or (vm-string-member name vm-mime-default-face-charsets)
+	 (or (vm-mime-default-face-charset-p name)
 	     (vm-string-assoc name vm-mime-charset-font-alist)))
 	(t
-	 (vm-string-member name vm-mime-default-face-charsets))))
+	 (vm-mime-default-face-charset-p name))))
+
+(defun vm-mime-default-face-charset-p (charset)
+  (and (or (eq vm-mime-default-face-charsets t)
+	   (and (consp vm-mime-default-face-charsets)
+		(vm-string-member charset vm-mime-default-face-charsets)))
+       (not (vm-string-member charset
+			      vm-mime-default-face-charset-exceptions))))
+
 
 (defun vm-mime-find-message/partials (layout id)
   (let ((list nil)
 ;;	      (ellipsis (concat description "..."))
 ;;	      (t description))))))
 
+(defun vm-delete-mime-object ()
+  "Deletes the contents of MIME object referred to by the MIME
+button at point.  The MIME object is replaced by a text/plain
+object that briefly describes what was deleted."
+  (interactive)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-check-for-killed-presentation)
+  (vm-error-if-folder-read-only)
+  (vm-error-if-folder-empty)
+  (if (and (vm-virtual-message-p (car vm-message-pointer))
+	   (null (vm-virtual-messages-of (car vm-message-pointer))))
+      (error "Can't edit unmirrored virtual messages."))
+  (and vm-presentation-buffer
+       (set-buffer vm-presentation-buffer))
+  (let (layout)
+    (cond (vm-fsfemacs-p
+	   (let (o-list o (found nil))
+	     (setq o-list (overlays-at (point)))
+	     (while (and o-list (not found))
+	       (setq o (car o-list))
+	       (cond ((setq layout (overlay-get o 'vm-mime-layout))
+		      (setq found t)
+		      (if (eq layout
+			      (vm-mime-layout-of
+			       (vm-mm-layout-message layout)))
+			  (error "Can't delete only MIME object; use vm-delete-message instead."))
+		      (if vm-mime-confirm-delete
+			  (or (y-or-n-p (vm-mime-sprintf "Delete %t? " layout))
+			      (error "Aborted")))
+		      (funcall 'vm-mime-discard-layout-contents layout)))
+	       (setq o-list (cdr o-list)))
+	     (if (not found)
+		 (error "No MIME button found at point."))
+	     (let ((inhibit-read-only t)
+		   (buffer-read-only nil))
+	       (save-excursion
+		 (vm-save-restriction
+		  (goto-char (overlay-start o))
+		  (insert "Deleted " (vm-mime-sprintf "%d\n" layout))
+		  (delete-region (point) (overlay-end o)))))))
+	  (vm-xemacs-p
+	   (let ((e (extent-at (point) nil 'vm-mime-layout)))
+	     (if (null e)
+		 (error "No MIME button found at point.")
+	       (setq layout (extent-property e 'vm-mime-layout))
+	       (if (= (vm-mm-layout-header-start layout)
+		      (vm-headers-of (vm-mm-layout-message layout)))
+		   (error "Can't delete only MIME object; use vm-delete-message instead."))
+	       (if vm-mime-confirm-delete
+		   (or (y-or-n-p (vm-mime-sprintf "Delete %t? " layout))
+		       (error "Aborted")))
+	       (let ((inhibit-read-only t)
+		     opos
+		     (buffer-read-only nil))
+		 (save-excursion
+		   (vm-save-restriction
+		     (goto-char (extent-start-position e))
+		     (setq opos (point))
+		     (insert "Deleted " (vm-mime-sprintf "%d\n" layout))
+		     (delete-region (point) (extent-end-position e))
+		     (set-extent-endpoints e opos (point)))))
+	       (funcall 'vm-mime-discard-layout-contents layout)))))))
+
+(defun vm-mime-discard-layout-contents (layout &optional file)
+  (save-excursion
+    (set-buffer (vm-buffer-of (vm-real-message-of
+			       (vm-mm-layout-message layout))))
+    (let ((inhibit-read-only t)
+	  (buffer-read-only nil)
+	  newid new-layout)
+      (vm-save-restriction
+	(widen)
+	(goto-char (vm-mm-layout-header-start layout))
+	(cond ((null file)
+	       (insert "Content-Type: text/plain; charset=us-ascii\n\n")
+	       (vm-set-mm-layout-body-start layout (point-marker))
+	       (insert "[Deleted " (vm-mime-sprintf "%d]\n" layout)))
+	      (t
+	       (insert "Content-Type: message/external-body; access-type=local-file; name=\"" file "\"\n")
+	       (insert "Content-Transfer-Encoding: 7bit\n\n")
+	       (insert "Content-Type: " (car (vm-mm-layout-qtype layout)))
+	       (if (cdr (vm-mm-layout-qtype layout))
+		   (let ((p (cdr (vm-mm-layout-qtype layout))))
+		     (insert "; " (mapconcat 'identity p "; "))))
+	       (insert "\n")
+	       (if (vm-mm-layout-qdisposition layout)
+		   (let ((p (vm-mm-layout-qdisposition layout)))
+		     (insert "Content-Disposition: "
+			     (mapconcat 'identity p "; ")
+			     "\n")))
+	       (if (vm-mm-layout-id layout)
+		   (insert "Content-ID: " (vm-mm-layout-id layout) "\n")
+		 (setq newid (vm-make-message-id))
+		 (insert "Content-ID: " newid "\n"))
+	       (insert "Content-Transfer-Encoding: binary\n\n")
+	       (insert "[Deleted " (vm-mime-sprintf "%d]\n" layout))
+	       (insert "[Saved to  " file " on " (system-name) "]\n")))
+	(delete-region (point) (vm-mm-layout-body-end layout))
+	(vm-set-edited-flag-of (vm-mm-layout-message layout) t)
+	(cond (file
+	       (save-restriction
+		 (narrow-to-region (vm-mm-layout-header-start layout)
+				   (vm-mm-layout-body-end layout))
+		 (setq new-layout (vm-mime-parse-entity-safe))
+		 ;; should use accessor and mutator functions
+		 ;; to copy the layout struct members, but i'm
+		 ;; tired.
+		 (let ((i (1- (length layout))))
+		   (while (>= i 0)
+		     (aset layout i (aref new-layout i))
+		     (setq i (1- i))))))
+	      (t
+	       (vm-set-mm-layout-type layout '("text/x-vm-deleted"))
+	       (vm-set-mm-layout-qtype layout '("text/x-vm-deleted"))
+	       (vm-set-mm-layout-encoding layout "7bit")
+	       (vm-set-mm-layout-id layout nil)
+	       (vm-set-mm-layout-description
+		layout
+		(vm-mime-sprintf "Deleted %d" layout))
+	       (vm-set-mm-layout-disposition layout nil)
+	       (vm-set-mm-layout-qdisposition layout nil)
+	       (vm-set-mm-layout-parts layout nil)
+	       (vm-set-mm-layout-cache layout nil)
+	       (vm-set-mm-layout-display-error layout nil)))))))
+
 (defun vm-mime-encode-composition ()
  "MIME encode the current mail composition buffer.
 Attachment tags added to the buffer with vm-mime-attach-file are expanded
 			  'binary))
 		       ;; no transformations!
 		       (format-alist nil)
+		       ;; no decompression!
+		       (jka-compr-compression-info-list nil)
 		       ;; don't let buffer-file-coding-system be changed
 		       ;; by insert-file-contents.  The
 		       ;; value we bind to it to here isn't important.
 			   'binary))
 			;; no transformations!
 			(format-alist nil)
+			;; no decompression!
+			(jka-compr-compression-info-list nil)
 			;; don't let buffer-file-coding-system be
 			;; changed by insert-file-contents.  The
 			;; value we bind to it to here isn't
   (let ((p vm-mime-button-format-alist)
 	(type (car (vm-mm-layout-type layout))))
     (catch 'done
+      (cond ((vm-mime-types-match "error/error" type)
+	     (throw 'done "%d"))
+	    ((vm-mime-types-match "text/x-vm-deleted" type)
+	     (throw 'done "%d")))
       (while p
 	(if (vm-mime-types-match (car (car p)) type)
 	    (throw 'done (cdr (car p)))
 (defun vm-fill-paragraphs-containing-long-lines (len start end)
   (let ((done nil)
 	(buffer-read-only nil)
-	(fill-column (1- len))
+	(fill-column vm-paragraph-fill-column)
 	;; user doesn't want long line, so set this to zero for them.
 	(filladapt-fill-column-forward-fuzz 0))
     (save-excursion
 	     (fill-paragraph nil))
 	 (forward-line)
 	 (setq done (>= (point) end)))))))
+
+(defun vm-make-message-id ()
+  (let (hostname
+	(time (current-time)))
+    (setq hostname (cond ((string-match "\\." (system-name))
+			  (system-name))
+			 ((and (stringp mail-host-address)
+			       (string-match "\\." mail-host-address))
+			  mail-host-address)
+			 (t "gargle.gargle.HOWL")))
+    (format "<%d.%d.%d.%d@%s>"
+	    (car time) (nth 1 time) (nth 2 time)
+	    (random 1000000)
+	    hostname)))
 as having been replied to, if appropriate."
   (interactive "P")
   (vm-check-for-killed-folder)
+  (if (and (boundp 'mail-alias-file)
+	   mail-alias-file
+	   (not (eq (user-uid) 0)))
+      (error "Must be superuser to use mail-alias-file.  Please set mail-alias-file to nil."))
   (let ((b (current-buffer)))
     (vm-mail-send)
     (cond ((null (buffer-name b)) ;; dead buffer
       nil
     (save-restriction
       (save-excursion
-	(let ((resent nil)
-	      hostname
-	      (time (current-time)))
-	  (setq hostname (cond ((string-match "\\." (system-name))
-				(system-name))
-			       ((and (stringp mail-host-address)
-				     (string-match "\\." mail-host-address))
-				mail-host-address)
-			       (t "gargle.gargle.HOWL")))
+	(let ((resent nil))
 	  (if (or (vm-mail-mode-get-header-contents "Resent-To:")
 		  (vm-mail-mode-get-header-contents "Resent-Cc:")
 		  (vm-mail-mode-get-header-contents "Resent-Bcc:"))
 	    (vm-mail-mode-remove-header "Message-ID:"))
 	  (widen)
 	  (goto-char (point-min))
-	  (insert (format "%sMessage-ID: <%d.%d.%d.%d@%s>\n"
+	  (insert (format "%sMessage-ID: %s\n"
 			  (if resent "Resent-" "")
-			  (car time) (nth 1 time) (nth 2 time)
-			  (random 1000000)
-			  hostname)))))))
+			  (vm-make-message-id))))))))
 
 (defun vm-mail-mode-insert-date-maybe ()
   (if (not vm-mail-header-insert-date)
       (setq key (car key-list))
       (cond ((equal key "thread")
 	     (vm-build-threads-if-unbuilt)
+	     (vm-build-thread-lists)
 	     (setq key-funcs (cons 'vm-sort-compare-thread key-funcs)))
 	    ((equal key "author")
 	     (setq key-funcs (cons 'vm-sort-compare-author key-funcs)))
 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 6.71.
+This is VM 6.72.
 
 Commands:
    h - summarize folder contents
 		       (< emacs-minor-version 34))))
 	 (error "VM %s must be run on Emacs 19.34 or a later v19 version."
 		vm-version))
-	((and vm-fsfemacs-p
-	      (= emacs-major-version 20)
-	      (< emacs-minor-version 4))
-	 (error "VM must be run on Emacs 20.4 or a later v20 version."))))
+	((and vm-fsfemacs-p (= emacs-major-version 20))
+	 (error "VM has not been ported to v20 Emacs."))))
 
 (defun vm-set-debug-flags ()
   (or stack-trace-on-error
 (defun vm-session-initialization ()
   (require 'vm)
   (vm-note-emacs-version)
-  (vm-check-emacs-version)
+;;  (vm-check-emacs-version)
 ;;  (vm-set-debug-flags)
   ;; If this is the first time VM has been run in this Emacs session,
   ;; do some necessary preparations.
 ;; The date format recognized here is the one specified in RFC 822.
 ;; Some slop is allowed e.g. dashes between the monthday, month and year
 ;; because such malformed headers have been observed.
-"\\(\\([a-z][a-z][a-z]\\),\\)?[ \t\n]*\\([0-9][0-9]?\\)[ \t\n---]*\\([a-z][a-z][a-z]\\)[ \t\n---]*\\([0-9]*[0-9][0-9]\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+][0-9][0-9][0-9][0-9]\\)"
+"\\(\\([a-z][a-z][a-z]\\),\\)?[ \t\n]*\\([0-9][0-9]?\\)[ \t\n---]*\\([a-z][a-z][a-z]\\)[ \t\n---]*\\([0-9]*[0-9][0-9]\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+]?[0-9][0-9][0-9][0-9]\\)"
        date)
       (if (match-beginning 2)
 	  (vm-su-do-weekday m (substring date (match-beginning 2)
     (if (> n modulus)
 	(message "Building threads... done"))))
 
+;; used by the thread sort code.
+;;
+;; vm-th-thread-list initializes the oldest-date property on
+;; the message-id symbols.  Since this property is used as an
+;; ordering key by the thread sort the oldest-date properties
+;; must be computed before the sort begins, not during it.
+;; Otherwise the sort won't be stable and there will be chaos.
+(defun vm-build-thread-lists ()
+  (let ((mp vm-message-list))
+    (while mp
+      (vm-th-thread-list (car mp))
+      (setq mp (cdr mp)))))
+
 (defun vm-thread-mark-for-summary-update (message-list)
   (let (m)
     (while message-list
 		(while labels
 		  (intern (car labels) vm-label-obarray)
 		  (setq labels (cdr labels))))
-	      (setq labels (cdr labels)))))
+	      (setq mm-list (cdr mm-list)))))
       (setq act-labels action-labels
 	    labels (copy-sequence (vm-labels-of (car m-list))))
       (if add
 itself is not modified; its text is copied into a presentation
 buffer before the filling is done.")
 
+(defvar vm-paragraph-fill-column (default-value 'fill-column)
+  "*Column beyond which automatic line-wrapping should happen when
+doing re-filling lines longer than the value of
+`vm-fill-paragraphs-containing-long-lines'.")
+
 (defvar vm-display-using-mime t
   "*Non-nil value means VM should display messages using MIME.
 MIME (Multipurpose Internet Mail Extensions) is a set of
 
 (defvar vm-mime-default-face-charsets
   (if vm-fsfemacs-mule-p
-      '("us-ascii")
+      (if (eq window-system nil)
+	  '("us-ascii" "iso-8859-1")
+	'("us-ascii"))
     '("us-ascii" "iso-8859-1"))
   "*List of character sets that can be displayed using the `default' face.
 The default face is what you normally see when you edit text in Emacs.
 
 Case is not significant in character set names.
 
+A value of t means all characters set can be displayed by the
+default face.  This should be used in combination with
+`vm-mime-default-face-charset-exceptions' to tell VM that most of
+the mail you receive is displayable using your default face and
+its associated font, even though the messages might arrive with
+unknown or unregistered character sets specified in the MIME
+Content-Type header.
+
 To tell VM how to display other character sets, see
 `vm-mime-charset-font-alist'.")
 
+(defvar vm-mime-default-face-charset-exceptions nil
+  "*List of character sets that cannot be displayed using the default face.
+This variable acts as an exception list for `vm-mime-default-face-charsets'.
+Character sets listed here will not be considered displayable using the
+default face even if they are also listed in `vm-mime-default-face-charsets'.")
+
 (defvar vm-mime-charset-font-alist nil
   "*Assoc list of character sets and fonts that can be used to display them.
 The format of the list is:
 you use must be the same height as your default font.  XEmacs
 does not have this limitation.")
 
+(defvar vm-mime-delete-after-saving nil
+  "*Non-nil value causes VM to delete MIME body contents from a folder
+after the MIME object has been saved to disk.  The MIME object is replaced
+with a message/external-body object that points to the disk copy of the
+object.")
+
+(defvar vm-mime-confirm-delete t
+  "*Non-nil value causes VM to request confirmation from the user before
+deleting a MIME object with vm-delete-mime-object.")
+
 (defvar vm-mime-button-face 'gui-button-face
   "*Face used for text in buttons that trigger the display of MIME objects.")
 
     ("audio" . "%-35.35(%d%) [%k to %a]")
     ("video" . "%-35.35(%d%) [%k to %a]")
     ("image" . "%-35.35(%d%) [%k to %a]")
-    ("application/octet-stream" . "%-35.35(%d, %f%) [%k to %a]")
-    ;; for parse errors
-    ("error/error" . "%d"))
+    ("application/octet-stream" . "%-35.35(%d, %f%) [%k to %a]"))
   "*List of types and formats for MIME buttons.
 When VM does not display a MIME object immediately, it displays a
 button or tag line in its place that describes the object and what you
 that `vm-decode-mime-message' would do is not done, because this
 function is expected to subsume all of it.")
 
+(defvar vm-imap-session-preauth-hook nil
+  "*List of hook functions to call to generate an authenticated
+IMAP session process.  This hook is only run if the
+authentication method for the IMAP mailbox is ``preauth''.  Each
+hook is called with five arguments: HOST, PORT, MAILBOX, USER,
+PASSWORD.  (See the documentation for vm-spool-files to find out
+about these arguments.)  It is the responsibility of the hook
+function to create an Emacs process whose input/output streams
+are connected to an authenticated IMAP session, and to return
+this process.  If the hook cannot accomplish this, it should
+return nil.  If all the hooks return nil, VM will signal an error.")
+
 (defvar mail-yank-hooks nil
   "Hooks called after a message is yanked into a mail composition.
 
     (define-key map "$s" 'vm-mime-reader-map-save-file)
     (define-key map "$|" 'vm-mime-reader-map-pipe-to-command)
     (define-key map "$p" 'vm-mime-reader-map-pipe-to-printer)
-    (define-key map "$d" 'vm-mime-reader-map-display-using-default)
+    (define-key map "$\r" 'vm-mime-reader-map-display-using-default)
+    (define-key map "$d" 'vm-delete-mime-object)
     (define-key map "$e" 'vm-mime-reader-map-display-using-external-viewer)
     (define-key map "\r" 'vm-mime-run-display-function-at-point)
     (cond ((vm-mouse-xemacs-mouse-p)
     (author . vm-vs-author)
     (author-or-recipient . vm-vs-author-or-recipient)
     (subject . vm-vs-subject)
+    (sortable-subject . vm-vs-sortable-subject)
     (sent-before . vm-vs-sent-before)
     (sent-after . vm-vs-sent-after)
     (more-chars-than . vm-vs-more-chars-than)
 
 (provide 'vm-version)
 
-(defconst vm-version "6.71"
+(defconst vm-version "6.72"
   "Version number of VM.")
 
 (defun vm-version ()
   (cond (vm-xemacs-p
 	 (memq 'win (device-matching-specifier-tag-list)))
 	(vm-fsfemacs-p
-	 (memq window-system '(x win32)))))
+	 (memq window-system '(x w32 win32)))))
 
 (defun vm-menu-support-possible-p ()
   (cond (vm-xemacs-p
   (cond (vm-xemacs-p
 	 (memq (device-type) '(x mswindows)))
 	(vm-fsfemacs-p
-	 (or (eq window-system 'x)
-	     (eq window-system 'win32)))))
+	 (memq window-system '(x w32 win32)))))
 
 (defun vm-images-possible-here-p ()
   (and vm-xemacs-p (memq (device-type) '(x mswindows))))
 	      displayed-subject "\"\"")
       (setq subject (regexp-quote subject)))
     (vm-create-virtual-folder
-     'subject subject nil
+     'sortable-subject subject nil
      (format "%s %s %s" (buffer-name) 'subject displayed-subject))))
 
 (defun vm-create-virtual-folder-same-author ()
 (defun vm-vs-subject (m arg)
   (string-match arg (vm-su-subject m)))
 
+(defun vm-vs-sortable-subject (m arg)
+  (string-match arg (vm-so-sortable-subject m)))
+
 (defun vm-vs-sent-before (m arg)
   (string< (vm-so-sortable-datestring m) (vm-timezone-make-date-sortable arg)))
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.