diff lisp/vm/vm-summary.el @ 20:859a2309aef8 r19-15b93

Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 376386a54a3c
children 4103f0995bd7
line wrap: on
line diff
--- a/lisp/vm/vm-summary.el	Mon Aug 13 08:49:44 2007 +0200
+++ b/lisp/vm/vm-summary.el	Mon Aug 13 08:50:05 2007 +0200
@@ -1,5 +1,5 @@
 ;;; Summary gathering and formatting routines for VM
-;;; Copyright (C) 1989, 1990, 1993, 1994, 1995 Kyle E. Jones
+;;; Copyright (C) 1989-1995 Kyle E. Jones
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -22,7 +22,7 @@
 	major-mode 'vm-summary-mode
 	mode-line-format vm-mode-line-format
 	;; must come after the setting of major-mode
-	mode-popup-menu (and vm-use-menus
+	mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3
 			     (vm-menu-support-possible-p)
 			     (vm-menu-mode-menu))
 	buffer-read-only t
@@ -38,7 +38,8 @@
   (use-local-map vm-summary-mode-map)
   (and (vm-menu-support-possible-p)
        (vm-menu-install-menus))
-  (and (vm-mouse-support-possible-p)
+  (and vm-mouse-track-summary
+       (vm-mouse-support-possible-p)
        (vm-mouse-xemacs-mouse-p)
        (add-hook 'mode-motion-hook 'mode-motion-highlight-line))
   (if (or vm-frame-per-folder vm-frame-per-summary)
@@ -50,12 +51,12 @@
 (fset 'vm-summary-mode 'vm-mode)
 (put 'vm-summary-mode 'mode-class 'special)
 
-(defun vm-summarize (&optional display)
+(defun vm-summarize (&optional display raise)
   "Summarize the contents of the folder in a summary buffer. 
 The format is as described by the variable vm-summary-format.  Generally
 one line per message is most pleasing to the eye but this is not
 mandatory."
-  (interactive "p")
+  (interactive "p\np")
   (vm-select-folder-buffer)
   (vm-check-for-killed-summary)
   (if (null vm-summary-buffer)
@@ -79,20 +80,11 @@
 	(vm-set-summary-redo-start-point t)))
   (if display
       (save-excursion
-	(if vm-frame-per-summary
-	    (let ((w (vm-get-buffer-window vm-summary-buffer)))
-	      (if (null w)
-		  (progn
-		    (vm-goto-new-frame 'summary)
-		    (vm-set-hooks-for-frame-deletion))
-		(save-excursion
-		  (select-window w)
-		  (and vm-warp-mouse-to-new-frame
-		       (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))
+	(vm-goto-new-summary-frame-maybe)
 	(vm-display vm-summary-buffer t
 		    '(vm-summarize
 		      vm-summarize-other-frame)
-		    (list this-command))
+		    (list this-command) (not raise))
 	;; need to do this after any frame creation because the
 	;; toolbar sets frame-specific height and width specifiers.
 	(set-buffer vm-summary-buffer)
@@ -118,7 +110,8 @@
 	;; Just for laughs, make the update interval vary.
 	(modulus (+ (% (vm-abs (random)) 11) 10))
 	(mouse-track-func
-	    (and (vm-mouse-support-possible-p)
+	    (and vm-mouse-track-summary
+		 (vm-mouse-support-possible-p)
 		 (vm-mouse-fsfemacs-mouse-p)
 		 (function vm-mouse-set-mouse-track-highlight)))
 	summary)
@@ -188,7 +181,8 @@
 	   (marker-buffer (vm-su-start-of m)))
       (let ((modified (buffer-modified-p))
 	    (mouse-track-func
-	     (and (vm-mouse-support-possible-p)
+	     (and vm-mouse-track-summary
+		  (vm-mouse-support-possible-p)
 		  (vm-mouse-fsfemacs-mouse-p)
 		  (function vm-mouse-set-mouse-track-highlight)))
 	    summary)
@@ -203,7 +197,7 @@
 		  (goto-char (vm-su-start-of m))
 		  (setq selected (not (looking-at vm-summary-no-=>)))
 		  ;; We do a little dance to update the text in
-		  ;; order to make the markets in the text do
+		  ;; order to make the markers in the text do
 		  ;; what we want.
 		  ;;
 		  ;; 1. We need to avoid having the su-start-of
@@ -244,7 +238,8 @@
   (if vm-summary-buffer
       (let ((w (vm-get-visible-buffer-window vm-summary-buffer))
 	    (mouse-track-func
-	       (and (vm-mouse-support-possible-p)
+	       (and vm-mouse-track-summary
+		    (vm-mouse-support-possible-p)
 		    (vm-mouse-fsfemacs-mouse-p)
 		    (function vm-mouse-set-mouse-track-highlight)))
 	    (old-window nil))
@@ -299,6 +294,13 @@
 	 (if (and vm-summary-overlay (extent-end-position vm-summary-overlay))
 	     (set-extent-endpoints vm-summary-overlay start end)
 	   (setq vm-summary-overlay (make-extent start end))
+	   ;; the reason this isn't needed under FSF Emacs is
+	   ;; that insert-before-marker also inserts before
+	   ;; overlays!  so a summary update of an entry just
+	   ;; before this overlay in the summary buffer won't
+	   ;; leak into the overlay, but it _will_ leak into an
+	   ;; XEmacs extent.
+	   (set-extent-property vm-summary-overlay 'start-open t)
 	   (set-extent-property vm-summary-overlay 'detachable nil)
 	   (set-extent-property vm-summary-overlay 'face face)))))
 
@@ -493,7 +495,7 @@
     (put format-variable 'vm-compiled-format format)
     (put format-variable 'vm-format-sexp (if list (cons 'list list) sexp))))
 
-(defun vm-get-header-contents (message header-name-regexp)
+(defun vm-get-header-contents (message header-name-regexp &optional clump-sep)
   (let ((contents nil)
 	regexp)
     (setq regexp (concat "^\\(" header-name-regexp "\\)")
@@ -504,12 +506,13 @@
 	(widen)
 	(goto-char (vm-headers-of message))
 	(let ((case-fold-search t))
-	  (while (and (re-search-forward regexp (vm-text-of message) t)
+	  (while (and (or (null contents) clump-sep)
+		      (re-search-forward regexp (vm-text-of message) t)
 		      (save-excursion (goto-char (match-beginning 0))
 				      (vm-match-header)))
 	    (if contents
 		(setq contents
-		      (concat contents ", " (vm-matched-header-contents)))
+		      (concat contents clump-sep (vm-matched-header-contents)))
 	      (setq contents (vm-matched-header-contents))))))
       contents )))
 
@@ -612,18 +615,19 @@
       nil
     (save-excursion
       (set-buffer (vm-buffer-of (vm-real-message-of message)))
-      (save-restriction
-	(widen)
-	(goto-char (vm-start-of message))
-	(let ((case-fold-search nil))
-	  (if (or (looking-at
-		   ;; special case this so that the "remote from blah"
-		   ;; isn't included.
-		   "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\) remote from .*")
-		  (looking-at "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\)"))
-	      (vm-buffer-substring-no-properties
-	       (match-beginning 1)
-	       (match-end 1))))))))
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (goto-char (vm-start-of message))
+	  (let ((case-fold-search nil))
+	    (if (or (looking-at
+		     ;; special case this so that the "remote from blah"
+		     ;; isn't included.
+		     "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\) remote from .*")
+		    (looking-at "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\)"))
+		(vm-buffer-substring-no-properties
+		 (match-beginning 1)
+		 (match-end 1)))))))))
 
 (defun vm-parse-date (date)
   (let ((weekday "")
@@ -779,20 +783,21 @@
       nil
     (save-excursion
       (set-buffer (vm-buffer-of message))
-      (save-restriction
-	(widen)
-	(goto-char (vm-start-of message))
-	(let ((case-fold-search nil))
-	  (if (looking-at "From \\([^ \t\n]+\\)")
-	      (vm-buffer-substring-no-properties
-	       (match-beginning 1)
-	       (match-end 1))))))))
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (goto-char (vm-start-of message))
+	  (let ((case-fold-search nil))
+	    (if (looking-at "From \\([^ \t\n]+\\)")
+		(vm-buffer-substring-no-properties
+		 (match-beginning 1)
+		 (match-end 1)))))))))
 
 (defun vm-su-do-author (m)
   (let ((full-name (vm-get-header-contents m "Full-Name:"))
-	(from (or (vm-get-header-contents m "From:")
+	(from (or (vm-get-header-contents m "From:" ", ")
 		  (vm-grok-From_-author m)))
-	pair)
+	pair i)
     (if (and full-name (string-match "^[ \t]*$" full-name))
 	(setq full-name nil))
     (if (null from)
@@ -806,6 +811,9 @@
     (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name)
  	(setq full-name
  	      (substring full-name (match-beginning 1) (match-end 1))))
+    (setq full-name (vm-decode-mime-encoded-words-maybe full-name))
+    (while (setq i (string-match "\n" full-name i))
+      (aset full-name i ?\ ))
     (vm-set-full-name-of m full-name)
     (vm-set-from-of m from)))
 
@@ -862,37 +870,29 @@
     (funcall vm-chop-full-name-function address)))
 
 (defun vm-su-do-recipients (m)
-  (let ((mail-use-rfc822 t) names addresses to cc all list)
-    (setq to (or (vm-get-header-contents m "To:")
-		 (vm-get-header-contents m "Apparently-To:")
+  (let ((mail-use-rfc822 t) i names addresses to cc all list full-name)
+    (setq to (or (vm-get-header-contents m "To:" ", ")
+		 (vm-get-header-contents m "Apparently-To:" ", ")
 		 ;; desperation....
 		 (user-login-name))
-	  cc (vm-get-header-contents m "Cc:")
+	  cc (vm-get-header-contents m "Cc:" ", ")
 	  all to
 	  all (if all (concat all ", " cc) cc)
 	  addresses (rfc822-addresses all))
     (setq list (vm-parse-addresses all))
     (while list
-      (cond ((string= (car list) ""))
-	    ((string-match "^\\(\"?\\([^<]+[^ \t\n\"]\\)\"?[ \t\n]+\\)?<\\([^>]+\\)>"
-			   (car list))
-	     (if (match-beginning 2)
-		 (setq names
-		       (cons
-			(substring (car list) (match-beginning 2)
-				   (match-end 2))
-			names))
-	       (setq names
-		     (cons
-		      (substring (car list) (match-beginning 3)
-				 (match-end 3))
-		      names))))
-	    ((string-match "[\000-\177]*(\\([^)]+\\))[\000-\177]*" (car list))
-	     (setq names
-		   (cons (substring (car list) (match-beginning 1)
-				    (match-end 1))
-			 names)))
-	    (t (setq names (cons (car list) names))))
+      ;; Just like vm-su-do-author:
+      (setq full-name (or (nth 0 (funcall vm-chop-full-name-function
+					  (car list)))
+			  (car list)))
+      ;; If double quoted are around the full name, fish the name out.
+      (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name)
+	  (setq full-name
+		(substring full-name (match-beginning 1) (match-end 1))))
+      (setq full-name (vm-decode-mime-encoded-words-maybe full-name))
+      (while (setq i (string-match "\n" full-name i))
+	(aset full-name i ?\ ))
+      (setq names (cons full-name names))
       (setq list (cdr list)))
     (setq names (nreverse names)) ; added by jwz for fixed vm-parse-addresses
     (vm-set-to-of m (mapconcat 'identity addresses ", "))
@@ -941,11 +941,11 @@
   (or (vm-subject-of m)
       (vm-set-subject-of
        m
-       (let ((subject (or (vm-get-header-contents m "Subject:") ""))
+       (let ((subject (or (vm-get-header-contents m "Subject:" " ") ""))
 	     (i nil))
-	 (if vm-summary-subject-no-newlines
-	     (while (setq i (string-match "\n" subject i))
-	       (aset subject i ?\ )))
+	 (setq subject (vm-decode-mime-encoded-words-maybe subject))
+	 (while (setq i (string-match "\n" subject i))
+	   (aset subject i ?\ ))
 	 subject ))))
 
 (defun vm-su-summary (m)
@@ -971,8 +971,8 @@
     (while mp
       (vm-set-summary-of (car mp) nil)
       (vm-mark-for-summary-update (car mp))
-      (vm-stuff-attributes (car mp))
       (setq mp (cdr mp)))
+    (vm-stuff-folder-attributes nil)
     (set-buffer-modified-p t)
     (vm-update-summary-and-mode-line))
   (vm-unsaved-message "Fixing your summary... done"))