mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00
Code Issues Releases Activity

(pmail-message-labels-p): Function moved from pmail.el and rewritten.

Browse Source 
(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.
This commit is contained in:
Richard M. Stallman 2009-01-05 15:41:36 +00:00
parent 56f668f7ea
commit 91552da9ad
1 changed files with 256 additions and 228 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

484
lisp/mail/pmailsum.el
View File

@ -92,6 +92,11 @@ LABELS should be a string containing the desired labels, separated by commas."
'pmail-message-labels-p 'pmail-message-labels-p
(concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) (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 ;;;###autoload
(defun pmail-summary-by-recipients (recipients &optional primary-only) (defun pmail-summary-by-recipients (recipients &optional primary-only)
"Display a summary of all messages with the given RECIPIENTS. "Display a summary of all messages with the given RECIPIENTS.
@ -106,6 +111,17 @@ RECIPIENTS is a string of regexps separated by commas."
'pmail-message-recipients-p 'pmail-message-recipients-p
(mail-comma-list-regexp recipients) primary-only)) (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 ;;;###autoload
(defun pmail-summary-by-regexp (regexp) (defun pmail-summary-by-regexp (regexp)
"Display a summary of all messages according to regexp REGEXP. "Display a summary of all messages according to regexp REGEXP.
@ -122,8 +138,15 @@ Emacs will list the header line in the PMAIL-summary."
'pmail-message-regexp-p 'pmail-message-regexp-p
regexp)) 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 ;;;###autoload
(defun pmail-summary-by-topic (subject &optional whole-message) (defun pmail-summary-by-topic (subject &optional whole-message)
@ -133,10 +156,7 @@ but if WHOLE-MESSAGE is non-nil (prefix arg given),
look in the whole message. look in the whole message.
SUBJECT is a string of regexps separated by commas." SUBJECT is a string of regexps separated by commas."
(interactive (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" (prompt (concat "Topics to summarize by (regexp"
(if subject ", default current subject" "") (if subject ", default current subject" "")
"): "))) "): ")))
@ -148,20 +168,9 @@ SUBJECT is a string of regexps separated by commas."
(mail-comma-list-regexp subject) whole-message)) (mail-comma-list-regexp subject) whole-message))
(defun pmail-message-subject-p (msg subject &optional 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 ;;;###autoload
(defun pmail-summary-by-senders (senders) (defun pmail-summary-by-senders (senders)
@ -175,13 +184,7 @@ SENDERS is a string of names separated by commas."
(mail-comma-list-regexp senders))) (mail-comma-list-regexp senders)))
(defun pmail-message-senders-p (msg 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. ;; General making of a summary buffer.
@ -229,7 +232,7 @@ nil for FUNCTION means all messages."
(pmail-summary-construct-io-menu) (pmail-summary-construct-io-menu)
(message "Computing summary lines...done"))) (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. "Filter messages to obtain summary lines.
DESCRIPTION is added to the mode line. DESCRIPTION is added to the mode line.
@ -247,9 +250,11 @@ message."
;; Scan the messages, getting their summary strings ;; Scan the messages, getting their summary strings
;; and putting the list of them in SUMMARY-MSGS. ;; and putting the list of them in SUMMARY-MSGS.
(let ((msgnum 1) (let ((msgnum 1)
(main-buffer (current-buffer))
(total pmail-total-messages) (total pmail-total-messages)
(inhibit-read-only t)) (inhibit-read-only t))
(save-excursion (save-excursion
;; Go where the mbox text is.
(if (pmail-buffers-swapped-p) (if (pmail-buffers-swapped-p)
(set-buffer pmail-view-buffer)) (set-buffer pmail-view-buffer))
(let ((old-min (point-min-marker)) (let ((old-min (point-min-marker))
@ -261,13 +266,13 @@ message."
(widen) (widen)
(goto-char (point-min)) (goto-char (point-min))
(while (>= total msgnum) (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)) (cons (cons msgnum (pmail-get-summary msgnum))
summary-msgs)))) summary-msgs))))
(setq msgnum (1+ msgnum)) (setq msgnum (1+ msgnum))
@ -322,6 +327,9 @@ buffer, or by creating a new summary buffer."
(defun pmail-get-summary (msgnum) (defun pmail-get-summary (msgnum)
"Return the summary line for message 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 If the message has a summary line already, it will be stored in
the message as a header and simply returned, otherwise the the message as a header and simply returned, otherwise the
summary line is created, saved in the message header, cached and summary line is created, saved in the message header, cached and
@ -332,40 +340,55 @@ The current buffer contains the unrestricted message collection."
(unless line (unless line
;; Register a summary line for MSGNUM. ;; Register a summary line for MSGNUM.
(setq pmail-new-summary-line-count (1+ pmail-new-summary-line-count) (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. ;; Cache the summary line for use during this Pmail session.
(aset pmail-summary-vector (1- msgnum) line)) (aset pmail-summary-vector (1- msgnum) line))
line)) line))
;;;###autoload ;;;###autoload
(defcustom pmail-summary-line-decoder (function identity) (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
and should return the decoded string.
By default, `identity' is set." By default, it is `identity', which returns the string unaltered."
:type 'function :type 'function
:group 'pmail-summary) :group 'pmail-summary)
(defun pmail-get-create-summary-line (msgnum) (defun pmail-create-summary-line (msgnum)
"Return the summary line for message MSGNUM. "Return the summary line for message MSGNUM.
Obtain the message summary from the header if it is available Obtain the message summary from the header if it is available
otherwise create it and store it in the message header. 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)) (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 () (defun pmail-get-summary-labels ()
"Return a coded string wrapped in curly braces denoting the status 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." the message being processed."
(let ((status (mail-fetch-field pmail-attribute-header)) (let ((status (mail-fetch-field pmail-attribute-header))
(index 0) (index 0)
@ -385,21 +408,39 @@ the message being processed."
(setq result (concat "{" result "}"))) (setq result (concat "{" result "}")))
result)) result))
(defun pmail-create-summary (msgnum) (defun pmail-create-summary (msgnum deleted unseen lines)
"Return the summary line for message MSGNUM. "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)) (goto-char (point-min))
(let ((line (pmail-make-basic-summary-line)) (let ((line (pmail-header-summary))
(labels (pmail-get-summary-labels)) (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 ? )) (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 ;;;###autoload
(defcustom pmail-user-mail-address-regexp nil (defcustom pmail-user-mail-address-regexp nil
@ -419,125 +460,110 @@ Setting this variable has an effect only before reading a mail."
:group 'pmail-retrieve :group 'pmail-retrieve
:version "21.1") :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)) (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) (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. ;; Simple motion in a summary buffer.
@ -609,9 +635,9 @@ With prefix argument N, do this N times.
If N is negative, go backwards." If N is negative, go backwards."
(interactive "p") (interactive "p")
(let ((forward (> n 0)) (let ((forward (> n 0))
search-regexp i found) subject i found)
(with-current-buffer pmail-buffer (with-current-buffer pmail-buffer
(setq search-regexp (pmail-current-subject-regexp) (setq subject (pmail-simplified-subject)
i pmail-current-message)) i pmail-current-message))
(save-excursion (save-excursion
(while (and (/= n 0) (while (and (/= n 0)
@ -629,18 +655,7 @@ If N is negative, go backwards."
(setq i (string-to-number (setq i (string-to-number
(buffer-substring (point) (buffer-substring (point)
(min (point-max) (+ 6 (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))) (if done (setq found i)))
(setq n (if forward (1- n) (1+ n))))) (setq n (if forward (1- n) (1+ n)))))
(if found (if found
@ -1575,43 +1590,20 @@ see the documentation of `pmail-resend'."
;; Summary output commands. ;; 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) (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,
outputting in the appropriate format for each.
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 N consecutive messages A prefix argument N says to output that many consecutive messages
starting with the current one. Deleted messages are skipped and don't count." 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 (interactive
(progn (require 'pmailout) (progn (require 'pmailout)
(list (pmail-output-read-file-name) (list (pmail-output-read-file-name)
@ -1633,6 +1625,42 @@ starting with the current one. Deleted messages are skipped and don't count."
(if (< i n) (if (< i n)
(pmail-summary-next-msg 1)))))) (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 () (defun pmail-summary-output-menu ()
"Output current message to another Pmail file, chosen with a menu. "Output current message to another Pmail file, chosen with a menu.
Also set the default for subsequent \\[pmail-output-to-babyl-file] commands. Also set the default for subsequent \\[pmail-output-to-babyl-file] commands.
@ -1659,7 +1687,7 @@ The variables `pmail-secondary-file-directory' and
(cons "Output Pmail File" (cons "Output Pmail File"
(pmail-list-to-menu "Output Pmail File" (pmail-list-to-menu "Output Pmail File"
files files
'pmail-summary-output-to-babyl-file)))) 'pmail-summary-output))))
(define-key pmail-summary-mode-map [menu-bar classify input-menu] (define-key pmail-summary-mode-map [menu-bar classify input-menu]
'("Input Pmail File" . pmail-disable-menu)) '("Input Pmail File" . pmail-disable-menu))
(define-key pmail-summary-mode-map [menu-bar classify output-menu] (define-key pmail-summary-mode-map [menu-bar classify output-menu]