emacs: lisp/mail/pmailsum.el comparison

comparison lisp/mail/pmailsum.el @ 100911:21becd9cb5d4

(pmail-message-labels-p): Function moved from pmail.el and rewritten. (pmail-message-recipients-p): Likewise. (pmail-message-regexp-p): Likewise. (pmail-message-recipients-p-1): New subroutine. (pmail-message-regexp-p-1): Likewise. (pmail-summary-by-topic): Use pmail-simplified-subject. Delete subject-re variable. (pmail-message-subject-p): Total rewrite. (pmail-message-senders-p): Total rewrite. (pmail-new-summary-1): Call FUNCTION in the main Pmail buffer. (pmail-get-summary): Doc fix. (pmail-create-summary-line): Renamed from pmail-get-create-summary-line, and major rewrite. (pmail-get-summary-labels): Doc fix. (pmail-create-summary): Major rewrite. Construct line counts here. (pmail-header-summary): Renamed from pmail-make-basic-summary-line. Return list of two strings. (pmail-summary-next-same-subject): Extract subjects and compare. (pmail-summary-output): Renamed from pmail-summary-output-to-babyl-file. Use pmail-output. (pmail-summary-output-as-seen): Renamed from pmail-summary-output. Use pmail-output-as-seen. (pmail-summary-construct-io-menu): Use pmail-summary-output.

author	Richard M. Stallman <rms@gnu.org>
date	Mon, 05 Jan 2009 15:41:36 +0000
parents	a9dc0e7c3f2b
children	50cbf7fa2d88

comparison

equal deleted inserted replaced

-:772f216c2808
+:21becd9cb5d4
 (pmail-new-summary (concat "labels " labels)
 		     (list 'pmail-summary-by-labels labels)
 		     'pmail-message-labels-p
 		     (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
+;; Return t if the attributes/keywords line of msg number MSG
+;; contains a match for the regexp LABELS.
+(defun pmail-message-labels-p (msg labels)
+(string-match labels (pmail-get-labels msg)))
 ;;;###autoload
 (defun pmail-summary-by-recipients (recipients &optional primary-only)
 "Display a summary of all messages with the given RECIPIENTS.
 Normally checks the To, From and Cc fields of headers;
 but if PRIMARY-ONLY is non-nil (prefix arg given),
 (pmail-new-summary
 (concat "recipients " recipients)
 (list 'pmail-summary-by-recipients recipients primary-only)
 'pmail-message-recipients-p
 (mail-comma-list-regexp recipients) primary-only))
+(defun pmail-message-recipients-p (msg recipients &optional primary-only)
+(pmail-apply-in-message msg 'pmail-message-recipients-p-1
+			  recipients primary-only))
+(defun pmail-message-recipients-p-1 (recipients &optional primary-only)
+(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
+(or (string-match recipients (or (mail-fetch-field "To") ""))
+(string-match recipients (or (mail-fetch-field "From") ""))
+(if (not primary-only)
+	  (string-match recipients (or (mail-fetch-field "Cc") "")))))
 ;;;###autoload
 (defun pmail-summary-by-regexp (regexp)
 "Display a summary of all messages according to regexp REGEXP.
 If the regular expression is found in the header of the message
 (pmail-new-summary (concat "regexp " regexp)
 		     (list 'pmail-summary-by-regexp regexp)
 		     'pmail-message-regexp-p
 regexp))
-;; pmail-summary-by-topic
+(defun pmail-message-regexp-p (msg regexp)
-;; 1989 R.A. Schnitzler
+"Return t, if for message number MSG, regexp REGEXP matches in the header."
+(pmail-apply-in-message msg 'pmail-message-regexp-p-1 msg regexp))
+(defun pmail-message-regexp-p-1 (msg regexp)
+(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
+(if pmail-enable-mime
+(funcall pmail-search-mime-header-function msg regexp (point))
+(re-search-forward regexp nil t)))
 ;;;###autoload
 (defun pmail-summary-by-topic (subject &optional whole-message)
 "Display a summary of all messages with the given SUBJECT.
 Normally checks the Subject field of headers;
 but if WHOLE-MESSAGE is non-nil (prefix arg given),
 look in the whole message.
 SUBJECT is a string of regexps separated by commas."
 (interactive
-(let* ((subject (with-current-buffer pmail-buffer
+(let* ((subject (pmail-simplified-subject))
-		     (pmail-current-subject)))
-	  (subject-re (with-current-buffer pmail-buffer
-			(pmail-current-subject-regexp)))
 	  (prompt (concat "Topics to summarize by (regexp"
 			  (if subject ", default current subject" "")
 			  "): ")))
 (list (read-string prompt nil nil subject) current-prefix-arg)))
 (pmail-new-summary
 (list 'pmail-summary-by-topic subject whole-message)
 'pmail-message-subject-p
 (mail-comma-list-regexp subject) whole-message))
 (defun pmail-message-subject-p (msg subject &optional whole-message)
-;;;??? BROKEN
+(if whole-message
-(error "pmail-message-subject-p has not been updated for Pmail")
+(pmail-apply-in-message msg 're-search-forward subject nil t)
-(save-restriction
+(string-match subject (pmail-simplified-subject msg))))
-(goto-char (pmail-msgbeg msg))
-(search-forward "\n*** EOOH ***\n" (pmail-msgend msg) 'move)
-(narrow-to-region
-(point)
-(progn (search-forward (if whole-message "\^_" "\n\n")) (point)))
-(goto-char (point-min))
-(if whole-message (re-search-forward subject nil t)
-(string-match subject (let ((subj (mail-fetch-field "Subject")))
-			      (if subj
-				  (funcall pmail-summary-line-decoder subj)
-				""))))))
 ;;;###autoload
 (defun pmail-summary-by-senders (senders)
 "Display a summary of all messages with the given SENDERS.
 SENDERS is a string of names separated by commas."
 (list 'pmail-summary-by-senders senders)
 'pmail-message-senders-p
 (mail-comma-list-regexp senders)))
 (defun pmail-message-senders-p (msg senders)
-;;;??? BROKEN
+(string-match senders (or (pmail-get-header "From" msg) "")))
-(error "pmail-message-senders-p has not been updated for Pmail")
-(save-restriction
-(goto-char (pmail-msgbeg msg))
-(search-forward "\n*** EOOH ***\n")
-(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
-(string-match senders (or (mail-fetch-field "From") ""))))
 ;; General making of a summary buffer.
 (defvar pmail-summary-symbol-number 0)
 (set-buffer pmail-summary-buffer))
 (pmail-summary-goto-msg mesg t t)
 (pmail-summary-construct-io-menu)
 (message "Computing summary lines...done")))
-(defun pmail-new-summary-1 (description form function &rest args)
+(defun pmail-new-summary-1 (description form function args)
 "Filter messages to obtain summary lines.
 DESCRIPTION is added to the mode line.
 Return the summary buffer by invoking FUNCTION on each message
 passing the message number and ARGS...
 	(pmail-new-summary-line-count 0)
 	(sumbuf (pmail-get-create-summary-buffer)))
 ;; Scan the messages, getting their summary strings
 ;; and putting the list of them in SUMMARY-MSGS.
 (let ((msgnum 1)
+	  (main-buffer (current-buffer))
 	  (total pmail-total-messages)
 	  (inhibit-read-only t))
 (save-excursion
+	;; Go where the mbox text is.
 	(if (pmail-buffers-swapped-p)
 	    (set-buffer pmail-view-buffer))
 	(let ((old-min (point-min-marker))
 	      (old-max (point-max-marker)))
 	  (unwind-protect
 	      ;; plan to modify text outside the original restriction.
 	      (save-excursion
 		(widen)
 		(goto-char (point-min))
 		(while (>= total msgnum)
-		  ;; First test whether to include this message.
+		  ;; Go back to the Pmail buffer so
-		  (if (or (null function)
+		  ;; so FUNCTION and pmail-get-summary can see its local vars.
-			  (apply function (cons msgnum args)))
+		  (with-current-buffer main-buffer
-		      (setq summary-msgs
+		    ;; First test whether to include this message.
-			    ;; Go back to the Pmail buffer so
+		    (if (or (null function)
-			    ;; so pmail-get-summary can see its local vars.
+			    (apply function msgnum args))
-			    (with-current-buffer pmail-buffer
+			(setq summary-msgs
 			      (cons (cons msgnum (pmail-get-summary msgnum))
 				    summary-msgs))))
 		  (setq msgnum (1+ msgnum))
 		  ;; Provide a periodic User progress message.
 		  (if (zerop (% pmail-new-summary-line-count 10))
 ;; Low levels of generating a summary.
 (defun pmail-get-summary (msgnum)
 "Return the summary line for message MSGNUM.
+The mbox buffer must be current when you call this function
+even if its text is swapped.
 If the message has a summary line already, it will be stored in
 the message as a header and simply returned, otherwise the
 summary line is created, saved in the message header, cached and
 returned.
 The current buffer contains the unrestricted message collection."
 (let ((line (aref pmail-summary-vector (1- msgnum))))
 (unless line
 ;; Register a summary line for MSGNUM.
 (setq pmail-new-summary-line-count (1+ pmail-new-summary-line-count)
-	    line (pmail-get-create-summary-line msgnum))
+	    line (pmail-create-summary-line msgnum))
 ;; Cache the summary line for use during this Pmail session.
 (aset pmail-summary-vector (1- msgnum) line))
 line))
 ;;;###autoload
 (defcustom pmail-summary-line-decoder (function identity)
-"*Function to decode summary-line.
+"*Function to decode a Pmail summary line.
+It receives the summary line for one message as a string
-By default, `identity' is set."
+and should return the decoded string.
+By default, it is `identity', which returns the string unaltered."
 :type 'function
 :group 'pmail-summary)
-(defun pmail-get-create-summary-line (msgnum)
+(defun pmail-create-summary-line (msgnum)
 "Return the summary line for message MSGNUM.
 Obtain the message summary from the header if it is available
 otherwise create it and store it in the message header.
-The current buffer contains the unrestricted message collection."
+The mbox buffer must be current when you call this function
+even if its text is swapped."
 (let ((beg (pmail-msgbeg msgnum))
-	(end (pmail-msgend msgnum)))
+	(end (pmail-msgend msgnum))
-(goto-char beg)
+	(deleted (pmail-message-deleted-p msgnum))
-(if (search-forward "\n\n" end t)
+	(unseen (pmail-message-unseen-p msgnum))
-	(save-restriction
+	lines)
-	  (narrow-to-region beg (point))
+(save-excursion
-	  ;; Generate a status line from the message and put it in the
+;; Switch to the buffer that has the whole mbox text.
-	  ;; message.
+(if (pmail-buffers-swapped-p)
-	  (pmail-create-summary msgnum))
+	  (set-buffer pmail-view-buffer))
-(pmail-error-bad-format msgnum))))
+;; Now we can compute the line count.
+(if pmail-summary-line-count-flag
+	  (setq lines (count-lines beg end)))
+;; Narrow to the message header.
+(save-excursion
+	(goto-char beg)
+	(if (search-forward "\n\n" end t)
+	    (save-restriction
+	      (narrow-to-region beg (point))
+	      ;; Generate a status line from the message.
+	      (pmail-create-summary msgnum deleted unseen lines))
+	  (pmail-error-bad-format msgnum))))))
 (defun pmail-get-summary-labels ()
 "Return a coded string wrapped in curly braces denoting the status labels.
-The current buffer is narrowed to the message headers for
+The current buffer must already be narrowed to the message headers for
 the message being processed."
 (let ((status (mail-fetch-field pmail-attribute-header))
 	(index 0)
 	(result "")
 	char)
 (setq index (1+ index)))
 (when (> (length result) 0)
 (setq result (concat "{" result "}")))
 result))
-(defun pmail-create-summary (msgnum)
+(defun pmail-create-summary (msgnum deleted unseen lines)
 "Return the summary line for message MSGNUM.
-The current buffer is narrowed to the header for message MSGNUM."
+The current buffer should already be narrowed to the header for that message.
+It could be either buffer, so don't access Pmail local variables.
+DELETED is t if this message is marked deleted.
+UNSEEN is t if it is marked unseen.
+LINES is the number of lines in the message (if we should display that)
+or else nil."
 (goto-char (point-min))
-(let ((line (pmail-make-basic-summary-line))
+(let ((line (pmail-header-summary))
 	(labels (pmail-get-summary-labels))
-	pos prefix status suffix)
+	pos status prefix basic-start basic-end linecount-string)
-(setq pos (string-match "#" line)
-	  status (cond
+(setq linecount-string
-		  ((pmail-message-deleted-p msgnum) ?D)
+	  (cond
-		  ((pmail-message-unseen-p msgnum) ?-)
+	   ((not lines)       " ")
+	   ((<= lines      9) (format "   [%d]" lines))
+	   ((<= lines     99) (format "  [%d]" lines))
+	   ((<= lines    999) (format " [%d]" lines))
+	   ((<= lines   9999) (format "  [%dk]" (/ lines 1000)))
+	   ((<= lines  99999) (format " [%dk]" (/ lines 1000)))
+	   (t                 (format "[%dk]" (/ lines 1000)))))
+(setq status (cond
+		  (deleted ?D)
+		  (unseen ?-)
 		  (t ? ))
-	  prefix (format "%5d%c %s" msgnum status (substring line 0 pos))
+	  prefix (format "%5d%c" msgnum status)
-	  suffix (substring line (1+ pos)))
+	  basic-start (car line)
-(funcall pmail-summary-line-decoder (concat prefix labels suffix))))
+	  basic-end (cadr line))
+(funcall pmail-summary-line-decoder
+	     (concat prefix basic-start linecount-string " "
+		     labels basic-end))))
 ;;;###autoload
 (defcustom pmail-user-mail-address-regexp nil
 "*Regexp matching user mail addresses.
 If non-nil, this variable is used to identify the correspondent
 Setting this variable has an effect only before reading a mail."
 :type '(choice (const :tag "None" nil) regexp)
 :group 'pmail-retrieve
 :version "21.1")
-(defun pmail-make-basic-summary-line ()
+(defun pmail-header-summary ()
+"Return a message summary based on the message headers.
+The value is a list of two strings, the first and second parts of the summary.
+The current buffer must already be narrowed to the message headers for
+the message being processed."
 (goto-char (point-min))
-(concat (save-excursion
+(list
-	    (if (not (re-search-forward "^Date:" nil t))
+(concat (save-excursion
-		"      "
+	     (if (not (re-search-forward "^Date:" nil t))
-	      (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
+		 "      "
-		      (save-excursion (end-of-line) (point)) t)
+	       (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
-		     (format "%2d-%3s"
+		       (save-excursion (end-of-line) (point)) t)
-			     (string-to-number (buffer-substring
+		      (format "%2d-%3s"
-(match-beginning 2)
+			      (string-to-number (buffer-substring
-(match-end 2)))
+						 (match-beginning 2)
-			     (buffer-substring
+						 (match-end 2)))
-			      (match-beginning 4) (match-end 4))))
+			      (buffer-substring
-		    ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
+			       (match-beginning 4) (match-end 4))))
-		      (save-excursion (end-of-line) (point)) t)
+		     ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
-		     (format "%2d-%3s"
+		       (save-excursion (end-of-line) (point)) t)
-			     (string-to-number (buffer-substring
+		      (format "%2d-%3s"
-(match-beginning 4)
+			      (string-to-number (buffer-substring
-(match-end 4)))
+						 (match-beginning 4)
-			     (buffer-substring
+						 (match-end 4)))
-			      (match-beginning 2) (match-end 2))))
+			      (buffer-substring
-		    ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)"
+			       (match-beginning 2) (match-end 2))))
-		      (save-excursion (end-of-line) (point)) t)
+		     ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)"
-		     (format "%2s%2s%2s"
+		       (save-excursion (end-of-line) (point)) t)
-			     (buffer-substring
+		      (format "%2s%2s%2s"
-			      (match-beginning 2) (match-end 2))
+			      (buffer-substring
-			     (buffer-substring
+			       (match-beginning 2) (match-end 2))
-			      (match-beginning 3) (match-end 3))
+			      (buffer-substring
-			     (buffer-substring
+			       (match-beginning 3) (match-end 3))
-			      (match-beginning 4) (match-end 4))))
+			      (buffer-substring
-		    (t "??????"))))
+			       (match-beginning 4) (match-end 4))))
-	  "  "
+		     (t "??????"))))
-	  (save-excursion
+	   "  "
-	    (let* ((from (and (re-search-forward "^From:[ \t]*" nil t)
+	   (save-excursion
-			      (mail-strip-quoted-names
+	     (let* ((from (and (re-search-forward "^From:[ \t]*" nil t)
-			       (buffer-substring
+			       (mail-strip-quoted-names
-				(1- (point))
+				(buffer-substring
-				;; Get all the lines of the From field
+				 (1- (point))
-				;; so that we get a whole comment if there is one,
+				 ;; Get all the lines of the From field
-				;; so that mail-strip-quoted-names can discard it.
+				 ;; so that we get a whole comment if there is one,
-				(let ((opoint (point)))
+				 ;; so that mail-strip-quoted-names can discard it.
-				  (while (progn (forward-line 1)
+				 (let ((opoint (point)))
-						(looking-at "[ \t]")))
+				   (while (progn (forward-line 1)
-				  ;; Back up over newline, then trailing spaces or tabs
+						 (looking-at "[ \t]")))
-				  (forward-char -1)
+				   ;; Back up over newline, then trailing spaces or tabs
-				  (skip-chars-backward " \t")
+				   (forward-char -1)
-				  (point))))))
+				   (skip-chars-backward " \t")
-		   len mch lo)
+				   (point))))))
-	      (if (or (null from)
+		    len mch lo)
-		      (string-match
+	       (if (or (null from)
-		       (or pmail-user-mail-address-regexp
+		       (string-match
-			   (concat "^\\("
+			(or pmail-user-mail-address-regexp
-				   (regexp-quote (user-login-name))
+			    (concat "^\\("
-				   "\\($\\|@\\)\\|"
+				    (regexp-quote (user-login-name))
-				   (regexp-quote
+				    "\\($\\|@\\)\\|"
-				    ;; Don't lose if run from init file
+				    (regexp-quote
-				    ;; where user-mail-address is not
+				     ;; Don't lose if run from init file
-				    ;; set yet.
+				     ;; where user-mail-address is not
-				    (or user-mail-address
+				     ;; set yet.
-					(concat (user-login-name) "@"
+				     (or user-mail-address
-						(or mail-host-address
+					 (concat (user-login-name) "@"
-						    (system-name)))))
+						 (or mail-host-address
-				   "\\>\\)"))
+						     (system-name)))))
-		       from))
+				    "\\>\\)"))
-		  ;; No From field, or it's this user.
+			from))
-		  (save-excursion
+		   ;; No From field, or it's this user.
-		    (goto-char (point-min))
+		   (save-excursion
-		    (if (not (re-search-forward "^To:[ \t]*" nil t))
+		     (goto-char (point-min))
-			nil
+		     (if (not (re-search-forward "^To:[ \t]*" nil t))
-		      (setq from
+			 nil
-			    (concat "to: "
+		       (setq from
-				    (mail-strip-quoted-names
+			     (concat "to: "
-				     (buffer-substring
+				     (mail-strip-quoted-names
-				      (point)
+				      (buffer-substring
-				      (progn (end-of-line)
+				       (point)
-					     (skip-chars-backward " \t")
-					     (point)))))))))
-	      (if (null from)
-		  "                         "
-		(setq len (length from))
-		(setq mch (string-match "[@%]" from))
-		(format "%25s"
-			(if (or (not mch) (<= len 25))
-			    (substring from (max 0 (- len 25)))
-			  (substring from
-				     (setq lo (cond ((< (- mch 14) 0) 0)
-						    ((< len (+ mch 11))
-						     (- len 25))
-						    (t (- mch 14))))
-				     (min len (+ lo 25))))))))
-(if pmail-summary-line-count-flag
-	      (save-excursion
-		(save-restriction
-		  (widen)
-		  (let ((beg (pmail-msgbeg msgnum))
-			(end (pmail-msgend msgnum))
-			lines)
-		    (save-excursion
-		      (goto-char beg)
-		      ;; Count only lines in the reformatted header,
-		      ;; if we have reformatted it.
-		      (search-forward "\n*** EOOH ***\n" end t)
-		      (setq lines (count-lines (point) end)))
-		    (format (cond
-			     ((<= lines     9) "   [%d]")
-			     ((<= lines    99) "  [%d]")
-			     ((<= lines   999) " [%3d]")
-			     (t		    "[%d]"))
-			    lines))))
-" ")
-	  " #"				;The # is part of the format.
-	  (if (re-search-forward "^Subject:" nil t)
-	      (progn (skip-chars-forward " \t")
-		     (buffer-substring (point)
 				       (progn (end-of-line)
-					      (point))))
+					      (skip-chars-backward " \t")
-	    (re-search-forward "[\n][\n]+" nil t)
+					      (point)))))))))
-	    (buffer-substring (point) (progn (end-of-line) (point))))
+	       (if (null from)
-	  "\n"))
+		   "                         "
+		 (setq len (length from))
+		 (setq mch (string-match "[@%]" from))
+		 (format "%25s"
+			 (if (or (not mch) (<= len 25))
+			     (substring from (max 0 (- len 25)))
+			   (substring from
+				      (setq lo (cond ((< (- mch 14) 0) 0)
+						     ((< len (+ mch 11))
+						      (- len 25))
+						     (t (- mch 14))))
+				      (min len (+ lo 25)))))))))
+(concat (if (re-search-forward "^Subject:" nil t)
+	       (progn (skip-chars-forward " \t")
+		      (buffer-substring (point)
+					(progn (end-of-line)
+					       (point))))
+	     (re-search-forward "[\n][\n]+" nil t)
+	     (buffer-substring (point) (progn (end-of-line) (point))))
+	   "\n")))
 ;; Simple motion in a summary buffer.
 (defun pmail-summary-next-all (&optional number)
 (interactive "p")
 "Go to the next message in the summary having the same subject.
 With prefix argument N, do this N times.
 If N is negative, go backwards."
 (interactive "p")
 (let ((forward (> n 0))
-	search-regexp i found)
+	subject i found)
 (with-current-buffer pmail-buffer
-(setq search-regexp (pmail-current-subject-regexp)
+(setq subject (pmail-simplified-subject)
 	    i pmail-current-message))
 (save-excursion
 (while (and (/= n 0)
 		  (if forward
 		      (not (eobp))
 	    (forward-line (if forward 1 -1))
 	    ;; Get msg number of this line.
 	    (setq i (string-to-number
 		     (buffer-substring (point)
 				       (min (point-max) (+ 6 (point))))))
-	    ;; See if that msg has desired subject.
+	    (setq done (string-equal subject (pmail-simplified-subject i))))
-	    (save-excursion
-	      (set-buffer pmail-buffer)
-	      (save-restriction
-		(widen)
-		(goto-char (pmail-msgbeg i))
-		(search-forward "\n*** EOOH ***\n")
-		(let ((beg (point)) end)
-		  (search-forward "\n\n")
-		  (setq end (point))
-		  (goto-char beg)
-		  (setq done (re-search-forward search-regexp end t))))))
 	  (if done (setq found i)))
 	(setq n (if forward (1- n) (1+ n)))))
 (if found
 	(pmail-summary-goto-msg found)
 (error "No %s message with same subject"
 	(set-buffer pmail-buffer)))
 (call-interactively 'pmail-resend)))
 ;; Summary output commands.
-(defun pmail-summary-output-to-babyl-file (&optional file-name n)
-"Append the current message to an Pmail file named FILE-NAME.
-If the file does not exist, ask if it should be created.
-If file is being visited, the message is appended to the Emacs
-buffer visiting that file.
-A prefix argument N says to output N consecutive messages
-starting with the current one.  Deleted messages are skipped and don't count."
-(interactive
-(progn (require 'pmailout)
-	  (list (pmail-output-read-pmail-file-name)
-		(prefix-numeric-value current-prefix-arg))))
-(let ((i 0) prev-msg)
-(while
-	(and (< i n)
-	     (progn (pmail-summary-goto-msg)
-		    (not (eq prev-msg
-			     (setq prev-msg
-				   (with-current-buffer pmail-buffer
-				     pmail-current-message))))))
-(setq i (1+ i))
-(with-current-buffer pmail-buffer
-	(let ((pmail-delete-after-output nil))
-	  (pmail-output-to-babyl-file file-name 1)))
-(if pmail-delete-after-output
-	  (pmail-summary-delete-forward nil)
-	(if (< i n)
-	    (pmail-summary-next-msg 1))))))
-(defalias 'pmail-summary-output-to-pmail-file
-'pmail-summary-output-to-babyl-file)
 (defun pmail-summary-output (&optional file-name n)
-"Append this message to Unix mail file named FILE-NAME.
+"Append this message to mail file FILE-NAME.
+This works with both mbox format and Babyl format files,
-A prefix argument N says to output N consecutive messages
+outputting in the appropriate format for each.
-starting with the current one.  Deleted messages are skipped and don't count."
+The default file name comes from `pmail-default-file',
+which is updated to the name you use in this command.
+A prefix argument N says to output that many consecutive messages
+from those in the summary, starting with the current one.
+Deleted messages are skipped and don't count.
+When called from Lisp code, N may be omitted and defaults to 1.
+This command always outputs the complete message header,
+even the header display is currently pruned."
 (interactive
 (progn (require 'pmailout)
 	  (list (pmail-output-read-file-name)
 		(prefix-numeric-value current-prefix-arg))))
 (let ((i 0) prev-msg)
 (if pmail-delete-after-output
 	  (pmail-summary-delete-forward nil)
 	(if (< i n)
 	    (pmail-summary-next-msg 1))))))
+(defalias 'pmail-summary-output-to-pmail-file
+'pmail-summary-output-to-babyl-file)
+(defun pmail-summary-output-as-seen (&optional file-name n)
+"Append this message to system-inbox-format mail file named FILE-NAME.
+A prefix argument N says to output that many consecutive messages,
+from the summary, starting with the current one.
+Deleted messages are skipped and don't count.
+When called from Lisp code, N may be omitted and defaults to 1.
+This outputs the message header as you see it (or would see it)
+displayed in Pmail.
+The default file name comes from `pmail-default-file',
+which is updated to the name you use in this command."
+(interactive
+(progn (require 'pmailout)
+	  (list (pmail-output-read-file-name)
+		(prefix-numeric-value current-prefix-arg))))
+(let ((i 0) prev-msg)
+(while
+	(and (< i n)
+	     (progn (pmail-summary-goto-msg)
+		    (not (eq prev-msg
+			     (setq prev-msg
+				   (with-current-buffer pmail-buffer
+				     pmail-current-message))))))
+(setq i (1+ i))
+(with-current-buffer pmail-buffer
+	(let ((pmail-delete-after-output nil))
+	  (pmail-output-as-seen file-name 1)))
+(if pmail-delete-after-output
+	  (pmail-summary-delete-forward nil)
+	(if (< i n)
+	    (pmail-summary-next-msg 1))))))
 (defun pmail-summary-output-menu ()
 "Output current message to another Pmail file, chosen with a menu.
 Also set the default for subsequent \\[pmail-output-to-babyl-file] commands.
 The variables `pmail-secondary-file-directory' and
 `pmail-secondary-file-regexp' control which files are offered in the menu."
 				      'pmail-summary-input)))
 	  (define-key pmail-summary-mode-map [menu-bar classify output-menu]
 	    (cons "Output Pmail File"
 		  (pmail-list-to-menu "Output Pmail File"
 				      files
-				      'pmail-summary-output-to-babyl-file))))
+				      'pmail-summary-output))))
 (define-key pmail-summary-mode-map [menu-bar classify input-menu]
 	'("Input Pmail File" . pmail-disable-menu))
 (define-key pmail-summary-mode-map [menu-bar classify output-menu]
 	'("Output Pmail File" . pmail-disable-menu)))))

Mercurial > emacs

comparison lisp/mail/pmailsum.el @ 100911:21becd9cb5d4