aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2009-01-05 15:41:36 +0000
committerRichard M. Stallman2009-01-05 15:41:36 +0000
commit91552da9ad303cb4ed6b8efeb79c39cbe425f673 (patch)
tree7374b1aabff08db9f54c9631cfb12c677abd830c
parent56f668f7ea5f290a9276b567aabd01caa2711a7f (diff)
downloademacs-91552da9ad303cb4ed6b8efeb79c39cbe425f673.tar.gz
emacs-91552da9ad303cb4ed6b8efeb79c39cbe425f673.zip
(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.
-rw-r--r--lisp/mail/pmailsum.el444
1 files changed, 236 insertions, 208 deletions
diff --git a/lisp/mail/pmailsum.el b/lisp/mail/pmailsum.el
index dff571dff95..6a6a07723c3 100644
--- a/lisp/mail/pmailsum.el
+++ b/lisp/mail/pmailsum.el
@@ -92,6 +92,11 @@ LABELS should be a string containing the desired labels, separated by commas."
92 'pmail-message-labels-p 92 'pmail-message-labels-p
93 (concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) 93 (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
94 94
95;; Return t if the attributes/keywords line of msg number MSG
96;; contains a match for the regexp LABELS.
97(defun pmail-message-labels-p (msg labels)
98 (string-match labels (pmail-get-labels msg)))
99
95;;;###autoload 100;;;###autoload
96(defun pmail-summary-by-recipients (recipients &optional primary-only) 101(defun pmail-summary-by-recipients (recipients &optional primary-only)
97 "Display a summary of all messages with the given RECIPIENTS. 102 "Display a summary of all messages with the given RECIPIENTS.
@@ -106,6 +111,17 @@ RECIPIENTS is a string of regexps separated by commas."
106 'pmail-message-recipients-p 111 'pmail-message-recipients-p
107 (mail-comma-list-regexp recipients) primary-only)) 112 (mail-comma-list-regexp recipients) primary-only))
108 113
114(defun pmail-message-recipients-p (msg recipients &optional primary-only)
115 (pmail-apply-in-message msg 'pmail-message-recipients-p-1
116 recipients primary-only))
117
118(defun pmail-message-recipients-p-1 (recipients &optional primary-only)
119 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
120 (or (string-match recipients (or (mail-fetch-field "To") ""))
121 (string-match recipients (or (mail-fetch-field "From") ""))
122 (if (not primary-only)
123 (string-match recipients (or (mail-fetch-field "Cc") "")))))
124
109;;;###autoload 125;;;###autoload
110(defun pmail-summary-by-regexp (regexp) 126(defun pmail-summary-by-regexp (regexp)
111 "Display a summary of all messages according to regexp REGEXP. 127 "Display a summary of all messages according to regexp REGEXP.
@@ -122,8 +138,15 @@ Emacs will list the header line in the PMAIL-summary."
122 'pmail-message-regexp-p 138 'pmail-message-regexp-p
123 regexp)) 139 regexp))
124 140
125;; pmail-summary-by-topic 141(defun pmail-message-regexp-p (msg regexp)
126;; 1989 R.A. Schnitzler 142 "Return t, if for message number MSG, regexp REGEXP matches in the header."
143 (pmail-apply-in-message msg 'pmail-message-regexp-p-1 msg regexp))
144
145(defun pmail-message-regexp-p-1 (msg regexp)
146 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
147 (if pmail-enable-mime
148 (funcall pmail-search-mime-header-function msg regexp (point))
149 (re-search-forward regexp nil t)))
127 150
128;;;###autoload 151;;;###autoload
129(defun pmail-summary-by-topic (subject &optional whole-message) 152(defun pmail-summary-by-topic (subject &optional whole-message)
@@ -133,10 +156,7 @@ but if WHOLE-MESSAGE is non-nil (prefix arg given),
133 look in the whole message. 156 look in the whole message.
134SUBJECT is a string of regexps separated by commas." 157SUBJECT is a string of regexps separated by commas."
135 (interactive 158 (interactive
136 (let* ((subject (with-current-buffer pmail-buffer 159 (let* ((subject (pmail-simplified-subject))
137 (pmail-current-subject)))
138 (subject-re (with-current-buffer pmail-buffer
139 (pmail-current-subject-regexp)))
140 (prompt (concat "Topics to summarize by (regexp" 160 (prompt (concat "Topics to summarize by (regexp"
141 (if subject ", default current subject" "") 161 (if subject ", default current subject" "")
142 "): "))) 162 "): ")))
@@ -148,20 +168,9 @@ SUBJECT is a string of regexps separated by commas."
148 (mail-comma-list-regexp subject) whole-message)) 168 (mail-comma-list-regexp subject) whole-message))
149 169
150(defun pmail-message-subject-p (msg subject &optional whole-message) 170(defun pmail-message-subject-p (msg subject &optional whole-message)
151 ;;;??? BROKEN 171 (if whole-message
152 (error "pmail-message-subject-p has not been updated for Pmail") 172 (pmail-apply-in-message msg 're-search-forward subject nil t)
153 (save-restriction 173 (string-match subject (pmail-simplified-subject msg))))
154 (goto-char (pmail-msgbeg msg))
155 (search-forward "\n*** EOOH ***\n" (pmail-msgend msg) 'move)
156 (narrow-to-region
157 (point)
158 (progn (search-forward (if whole-message "\^_" "\n\n")) (point)))
159 (goto-char (point-min))
160 (if whole-message (re-search-forward subject nil t)
161 (string-match subject (let ((subj (mail-fetch-field "Subject")))
162 (if subj
163 (funcall pmail-summary-line-decoder subj)
164 ""))))))
165 174
166;;;###autoload 175;;;###autoload
167(defun pmail-summary-by-senders (senders) 176(defun pmail-summary-by-senders (senders)
@@ -175,13 +184,7 @@ SENDERS is a string of names separated by commas."
175 (mail-comma-list-regexp senders))) 184 (mail-comma-list-regexp senders)))
176 185
177(defun pmail-message-senders-p (msg senders) 186(defun pmail-message-senders-p (msg senders)
178 ;;;??? BROKEN 187 (string-match senders (or (pmail-get-header "From" msg) "")))
179 (error "pmail-message-senders-p has not been updated for Pmail")
180 (save-restriction
181 (goto-char (pmail-msgbeg msg))
182 (search-forward "\n*** EOOH ***\n")
183 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
184 (string-match senders (or (mail-fetch-field "From") ""))))
185 188
186;; General making of a summary buffer. 189;; General making of a summary buffer.
187 190
@@ -229,7 +232,7 @@ nil for FUNCTION means all messages."
229 (pmail-summary-construct-io-menu) 232 (pmail-summary-construct-io-menu)
230 (message "Computing summary lines...done"))) 233 (message "Computing summary lines...done")))
231 234
232(defun pmail-new-summary-1 (description form function &rest args) 235(defun pmail-new-summary-1 (description form function args)
233 "Filter messages to obtain summary lines. 236 "Filter messages to obtain summary lines.
234DESCRIPTION is added to the mode line. 237DESCRIPTION is added to the mode line.
235 238
@@ -247,9 +250,11 @@ message."
247 ;; Scan the messages, getting their summary strings 250 ;; Scan the messages, getting their summary strings
248 ;; and putting the list of them in SUMMARY-MSGS. 251 ;; and putting the list of them in SUMMARY-MSGS.
249 (let ((msgnum 1) 252 (let ((msgnum 1)
253 (main-buffer (current-buffer))
250 (total pmail-total-messages) 254 (total pmail-total-messages)
251 (inhibit-read-only t)) 255 (inhibit-read-only t))
252 (save-excursion 256 (save-excursion
257 ;; Go where the mbox text is.
253 (if (pmail-buffers-swapped-p) 258 (if (pmail-buffers-swapped-p)
254 (set-buffer pmail-view-buffer)) 259 (set-buffer pmail-view-buffer))
255 (let ((old-min (point-min-marker)) 260 (let ((old-min (point-min-marker))
@@ -261,13 +266,13 @@ message."
261 (widen) 266 (widen)
262 (goto-char (point-min)) 267 (goto-char (point-min))
263 (while (>= total msgnum) 268 (while (>= total msgnum)
264 ;; First test whether to include this message. 269 ;; Go back to the Pmail buffer so
265 (if (or (null function) 270 ;; so FUNCTION and pmail-get-summary can see its local vars.
266 (apply function (cons msgnum args))) 271 (with-current-buffer main-buffer
267 (setq summary-msgs 272 ;; First test whether to include this message.
268 ;; Go back to the Pmail buffer so 273 (if (or (null function)
269 ;; so pmail-get-summary can see its local vars. 274 (apply function msgnum args))
270 (with-current-buffer pmail-buffer 275 (setq summary-msgs
271 (cons (cons msgnum (pmail-get-summary msgnum)) 276 (cons (cons msgnum (pmail-get-summary msgnum))
272 summary-msgs)))) 277 summary-msgs))))
273 (setq msgnum (1+ msgnum)) 278 (setq msgnum (1+ msgnum))
@@ -322,6 +327,9 @@ buffer, or by creating a new summary buffer."
322 327
323(defun pmail-get-summary (msgnum) 328(defun pmail-get-summary (msgnum)
324 "Return the summary line for message MSGNUM. 329 "Return the summary line for message MSGNUM.
330The mbox buffer must be current when you call this function
331even if its text is swapped.
332
325If the message has a summary line already, it will be stored in 333If the message has a summary line already, it will be stored in
326the message as a header and simply returned, otherwise the 334the message as a header and simply returned, otherwise the
327summary line is created, saved in the message header, cached and 335summary line is created, saved in the message header, cached and
@@ -332,40 +340,55 @@ The current buffer contains the unrestricted message collection."
332 (unless line 340 (unless line
333 ;; Register a summary line for MSGNUM. 341 ;; Register a summary line for MSGNUM.
334 (setq pmail-new-summary-line-count (1+ pmail-new-summary-line-count) 342 (setq pmail-new-summary-line-count (1+ pmail-new-summary-line-count)
335 line (pmail-get-create-summary-line msgnum)) 343 line (pmail-create-summary-line msgnum))
336 ;; Cache the summary line for use during this Pmail session. 344 ;; Cache the summary line for use during this Pmail session.
337 (aset pmail-summary-vector (1- msgnum) line)) 345 (aset pmail-summary-vector (1- msgnum) line))
338 line)) 346 line))
339 347
340;;;###autoload 348;;;###autoload
341(defcustom pmail-summary-line-decoder (function identity) 349(defcustom pmail-summary-line-decoder (function identity)
342 "*Function to decode summary-line. 350 "*Function to decode a Pmail summary line.
351It receives the summary line for one message as a string
352and should return the decoded string.
343 353
344By default, `identity' is set." 354By default, it is `identity', which returns the string unaltered."
345 :type 'function 355 :type 'function
346 :group 'pmail-summary) 356 :group 'pmail-summary)
347 357
348(defun pmail-get-create-summary-line (msgnum) 358(defun pmail-create-summary-line (msgnum)
349 "Return the summary line for message MSGNUM. 359 "Return the summary line for message MSGNUM.
350Obtain the message summary from the header if it is available 360Obtain the message summary from the header if it is available
351otherwise create it and store it in the message header. 361otherwise create it and store it in the message header.
352 362
353The current buffer contains the unrestricted message collection." 363The mbox buffer must be current when you call this function
364even if its text is swapped."
354 (let ((beg (pmail-msgbeg msgnum)) 365 (let ((beg (pmail-msgbeg msgnum))
355 (end (pmail-msgend msgnum))) 366 (end (pmail-msgend msgnum))
356 (goto-char beg) 367 (deleted (pmail-message-deleted-p msgnum))
357 (if (search-forward "\n\n" end t) 368 (unseen (pmail-message-unseen-p msgnum))
358 (save-restriction 369 lines)
359 (narrow-to-region beg (point)) 370 (save-excursion
360 ;; Generate a status line from the message and put it in the 371 ;; Switch to the buffer that has the whole mbox text.
361 ;; message. 372 (if (pmail-buffers-swapped-p)
362 (pmail-create-summary msgnum)) 373 (set-buffer pmail-view-buffer))
363 (pmail-error-bad-format msgnum)))) 374 ;; Now we can compute the line count.
375 (if pmail-summary-line-count-flag
376 (setq lines (count-lines beg end)))
377
378 ;; Narrow to the message header.
379 (save-excursion
380 (goto-char beg)
381 (if (search-forward "\n\n" end t)
382 (save-restriction
383 (narrow-to-region beg (point))
384 ;; Generate a status line from the message.
385 (pmail-create-summary msgnum deleted unseen lines))
386 (pmail-error-bad-format msgnum))))))
364 387
365(defun pmail-get-summary-labels () 388(defun pmail-get-summary-labels ()
366 "Return a coded string wrapped in curly braces denoting the status labels. 389 "Return a coded string wrapped in curly braces denoting the status labels.
367 390
368The current buffer is narrowed to the message headers for 391The current buffer must already be narrowed to the message headers for
369the message being processed." 392the message being processed."
370 (let ((status (mail-fetch-field pmail-attribute-header)) 393 (let ((status (mail-fetch-field pmail-attribute-header))
371 (index 0) 394 (index 0)
@@ -385,21 +408,39 @@ the message being processed."
385 (setq result (concat "{" result "}"))) 408 (setq result (concat "{" result "}")))
386 result)) 409 result))
387 410
388(defun pmail-create-summary (msgnum) 411(defun pmail-create-summary (msgnum deleted unseen lines)
389 "Return the summary line for message MSGNUM. 412 "Return the summary line for message MSGNUM.
390The current buffer is narrowed to the header for message MSGNUM." 413The current buffer should already be narrowed to the header for that message.
414It could be either buffer, so don't access Pmail local variables.
415DELETED is t if this message is marked deleted.
416UNSEEN is t if it is marked unseen.
417LINES is the number of lines in the message (if we should display that)
418 or else nil."
391 (goto-char (point-min)) 419 (goto-char (point-min))
392 (let ((line (pmail-make-basic-summary-line)) 420 (let ((line (pmail-header-summary))
393 (labels (pmail-get-summary-labels)) 421 (labels (pmail-get-summary-labels))
394 pos prefix status suffix) 422 pos status prefix basic-start basic-end linecount-string)
395 (setq pos (string-match "#" line) 423
396 status (cond 424 (setq linecount-string
397 ((pmail-message-deleted-p msgnum) ?D) 425 (cond
398 ((pmail-message-unseen-p msgnum) ?-) 426 ((not lines) " ")
427 ((<= lines 9) (format " [%d]" lines))
428 ((<= lines 99) (format " [%d]" lines))
429 ((<= lines 999) (format " [%d]" lines))
430 ((<= lines 9999) (format " [%dk]" (/ lines 1000)))
431 ((<= lines 99999) (format " [%dk]" (/ lines 1000)))
432 (t (format "[%dk]" (/ lines 1000)))))
433
434 (setq status (cond
435 (deleted ?D)
436 (unseen ?-)
399 (t ? )) 437 (t ? ))
400 prefix (format "%5d%c %s" msgnum status (substring line 0 pos)) 438 prefix (format "%5d%c" msgnum status)
401 suffix (substring line (1+ pos))) 439 basic-start (car line)
402 (funcall pmail-summary-line-decoder (concat prefix labels suffix)))) 440 basic-end (cadr line))
441 (funcall pmail-summary-line-decoder
442 (concat prefix basic-start linecount-string " "
443 labels basic-end))))
403 444
404;;;###autoload 445;;;###autoload
405(defcustom pmail-user-mail-address-regexp nil 446(defcustom pmail-user-mail-address-regexp nil
@@ -419,125 +460,110 @@ Setting this variable has an effect only before reading a mail."
419 :group 'pmail-retrieve 460 :group 'pmail-retrieve
420 :version "21.1") 461 :version "21.1")
421 462
422(defun pmail-make-basic-summary-line () 463(defun pmail-header-summary ()
464 "Return a message summary based on the message headers.
465The value is a list of two strings, the first and second parts of the summary.
466
467The current buffer must already be narrowed to the message headers for
468the message being processed."
423 (goto-char (point-min)) 469 (goto-char (point-min))
424 (concat (save-excursion 470 (list
425 (if (not (re-search-forward "^Date:" nil t)) 471 (concat (save-excursion
426 " " 472 (if (not (re-search-forward "^Date:" nil t))
427 (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" 473 " "
428 (save-excursion (end-of-line) (point)) t) 474 (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
429 (format "%2d-%3s" 475 (save-excursion (end-of-line) (point)) t)
430 (string-to-number (buffer-substring 476 (format "%2d-%3s"
431 (match-beginning 2) 477 (string-to-number (buffer-substring
432 (match-end 2))) 478 (match-beginning 2)
433 (buffer-substring 479 (match-end 2)))
434 (match-beginning 4) (match-end 4)))) 480 (buffer-substring
435 ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" 481 (match-beginning 4) (match-end 4))))
436 (save-excursion (end-of-line) (point)) t) 482 ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
437 (format "%2d-%3s" 483 (save-excursion (end-of-line) (point)) t)
438 (string-to-number (buffer-substring 484 (format "%2d-%3s"
439 (match-beginning 4) 485 (string-to-number (buffer-substring
440 (match-end 4))) 486 (match-beginning 4)
441 (buffer-substring 487 (match-end 4)))
442 (match-beginning 2) (match-end 2)))) 488 (buffer-substring
443 ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)" 489 (match-beginning 2) (match-end 2))))
444 (save-excursion (end-of-line) (point)) t) 490 ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)"
445 (format "%2s%2s%2s" 491 (save-excursion (end-of-line) (point)) t)
446 (buffer-substring 492 (format "%2s%2s%2s"
447 (match-beginning 2) (match-end 2)) 493 (buffer-substring
448 (buffer-substring 494 (match-beginning 2) (match-end 2))
449 (match-beginning 3) (match-end 3)) 495 (buffer-substring
450 (buffer-substring 496 (match-beginning 3) (match-end 3))
451 (match-beginning 4) (match-end 4)))) 497 (buffer-substring
452 (t "??????")))) 498 (match-beginning 4) (match-end 4))))
453 " " 499 (t "??????"))))
454 (save-excursion 500 " "
455 (let* ((from (and (re-search-forward "^From:[ \t]*" nil t) 501 (save-excursion
456 (mail-strip-quoted-names 502 (let* ((from (and (re-search-forward "^From:[ \t]*" nil t)
457 (buffer-substring 503 (mail-strip-quoted-names
458 (1- (point)) 504 (buffer-substring
459 ;; Get all the lines of the From field 505 (1- (point))
460 ;; so that we get a whole comment if there is one, 506 ;; Get all the lines of the From field
461 ;; so that mail-strip-quoted-names can discard it. 507 ;; so that we get a whole comment if there is one,
462 (let ((opoint (point))) 508 ;; so that mail-strip-quoted-names can discard it.
463 (while (progn (forward-line 1) 509 (let ((opoint (point)))
464 (looking-at "[ \t]"))) 510 (while (progn (forward-line 1)
465 ;; Back up over newline, then trailing spaces or tabs 511 (looking-at "[ \t]")))
466 (forward-char -1) 512 ;; Back up over newline, then trailing spaces or tabs
467 (skip-chars-backward " \t") 513 (forward-char -1)
468 (point)))))) 514 (skip-chars-backward " \t")
469 len mch lo) 515 (point))))))
470 (if (or (null from) 516 len mch lo)
471 (string-match 517 (if (or (null from)
472 (or pmail-user-mail-address-regexp 518 (string-match
473 (concat "^\\(" 519 (or pmail-user-mail-address-regexp
474 (regexp-quote (user-login-name)) 520 (concat "^\\("
475 "\\($\\|@\\)\\|" 521 (regexp-quote (user-login-name))
476 (regexp-quote 522 "\\($\\|@\\)\\|"
477 ;; Don't lose if run from init file 523 (regexp-quote
478 ;; where user-mail-address is not 524 ;; Don't lose if run from init file
479 ;; set yet. 525 ;; where user-mail-address is not
480 (or user-mail-address 526 ;; set yet.
481 (concat (user-login-name) "@" 527 (or user-mail-address
482 (or mail-host-address 528 (concat (user-login-name) "@"
483 (system-name))))) 529 (or mail-host-address
484 "\\>\\)")) 530 (system-name)))))
485 from)) 531 "\\>\\)"))
486 ;; No From field, or it's this user. 532 from))
487 (save-excursion 533 ;; No From field, or it's this user.
488 (goto-char (point-min)) 534 (save-excursion
489 (if (not (re-search-forward "^To:[ \t]*" nil t)) 535 (goto-char (point-min))
490 nil 536 (if (not (re-search-forward "^To:[ \t]*" nil t))
491 (setq from 537 nil
492 (concat "to: " 538 (setq from
493 (mail-strip-quoted-names 539 (concat "to: "
494 (buffer-substring 540 (mail-strip-quoted-names
495 (point) 541 (buffer-substring
496 (progn (end-of-line) 542 (point)
497 (skip-chars-backward " \t")
498 (point)))))))))
499 (if (null from)
500 " "
501 (setq len (length from))
502 (setq mch (string-match "[@%]" from))
503 (format "%25s"
504 (if (or (not mch) (<= len 25))
505 (substring from (max 0 (- len 25)))
506 (substring from
507 (setq lo (cond ((< (- mch 14) 0) 0)
508 ((< len (+ mch 11))
509 (- len 25))
510 (t (- mch 14))))
511 (min len (+ lo 25))))))))
512 (if pmail-summary-line-count-flag
513 (save-excursion
514 (save-restriction
515 (widen)
516 (let ((beg (pmail-msgbeg msgnum))
517 (end (pmail-msgend msgnum))
518 lines)
519 (save-excursion
520 (goto-char beg)
521 ;; Count only lines in the reformatted header,
522 ;; if we have reformatted it.
523 (search-forward "\n*** EOOH ***\n" end t)
524 (setq lines (count-lines (point) end)))
525 (format (cond
526 ((<= lines 9) " [%d]")
527 ((<= lines 99) " [%d]")
528 ((<= lines 999) " [%3d]")
529 (t "[%d]"))
530 lines))))
531 " ")
532 " #" ;The # is part of the format.
533 (if (re-search-forward "^Subject:" nil t)
534 (progn (skip-chars-forward " \t")
535 (buffer-substring (point)
536 (progn (end-of-line) 543 (progn (end-of-line)
537 (point)))) 544 (skip-chars-backward " \t")
538 (re-search-forward "[\n][\n]+" nil t) 545 (point)))))))))
539 (buffer-substring (point) (progn (end-of-line) (point)))) 546 (if (null from)
540 "\n")) 547 " "
548 (setq len (length from))
549 (setq mch (string-match "[@%]" from))
550 (format "%25s"
551 (if (or (not mch) (<= len 25))
552 (substring from (max 0 (- len 25)))
553 (substring from
554 (setq lo (cond ((< (- mch 14) 0) 0)
555 ((< len (+ mch 11))
556 (- len 25))
557 (t (- mch 14))))
558 (min len (+ lo 25)))))))))
559 (concat (if (re-search-forward "^Subject:" nil t)
560 (progn (skip-chars-forward " \t")
561 (buffer-substring (point)
562 (progn (end-of-line)
563 (point))))
564 (re-search-forward "[\n][\n]+" nil t)
565 (buffer-substring (point) (progn (end-of-line) (point))))
566 "\n")))
541 567
542;; Simple motion in a summary buffer. 568;; Simple motion in a summary buffer.
543 569
@@ -609,9 +635,9 @@ With prefix argument N, do this N times.
609If N is negative, go backwards." 635If N is negative, go backwards."
610 (interactive "p") 636 (interactive "p")
611 (let ((forward (> n 0)) 637 (let ((forward (> n 0))
612 search-regexp i found) 638 subject i found)
613 (with-current-buffer pmail-buffer 639 (with-current-buffer pmail-buffer
614 (setq search-regexp (pmail-current-subject-regexp) 640 (setq subject (pmail-simplified-subject)
615 i pmail-current-message)) 641 i pmail-current-message))
616 (save-excursion 642 (save-excursion
617 (while (and (/= n 0) 643 (while (and (/= n 0)
@@ -629,18 +655,7 @@ If N is negative, go backwards."
629 (setq i (string-to-number 655 (setq i (string-to-number
630 (buffer-substring (point) 656 (buffer-substring (point)
631 (min (point-max) (+ 6 (point)))))) 657 (min (point-max) (+ 6 (point))))))
632 ;; See if that msg has desired subject. 658 (setq done (string-equal subject (pmail-simplified-subject i))))
633 (save-excursion
634 (set-buffer pmail-buffer)
635 (save-restriction
636 (widen)
637 (goto-char (pmail-msgbeg i))
638 (search-forward "\n*** EOOH ***\n")
639 (let ((beg (point)) end)
640 (search-forward "\n\n")
641 (setq end (point))
642 (goto-char beg)
643 (setq done (re-search-forward search-regexp end t))))))
644 (if done (setq found i))) 659 (if done (setq found i)))
645 (setq n (if forward (1- n) (1+ n))))) 660 (setq n (if forward (1- n) (1+ n)))))
646 (if found 661 (if found
@@ -1575,17 +1590,23 @@ see the documentation of `pmail-resend'."
1575 1590
1576;; Summary output commands. 1591;; Summary output commands.
1577 1592
1578(defun pmail-summary-output-to-babyl-file (&optional file-name n) 1593(defun pmail-summary-output (&optional file-name n)
1579 "Append the current message to an Pmail file named FILE-NAME. 1594 "Append this message to mail file FILE-NAME.
1580If the file does not exist, ask if it should be created. 1595This works with both mbox format and Babyl format files,
1581If file is being visited, the message is appended to the Emacs 1596outputting in the appropriate format for each.
1582buffer visiting that file. 1597The default file name comes from `pmail-default-file',
1583 1598which is updated to the name you use in this command.
1584A prefix argument N says to output N consecutive messages 1599
1585starting with the current one. Deleted messages are skipped and don't count." 1600A prefix argument N says to output that many consecutive messages
1601from those in the summary, starting with the current one.
1602Deleted messages are skipped and don't count.
1603When called from Lisp code, N may be omitted and defaults to 1.
1604
1605This command always outputs the complete message header,
1606even the header display is currently pruned."
1586 (interactive 1607 (interactive
1587 (progn (require 'pmailout) 1608 (progn (require 'pmailout)
1588 (list (pmail-output-read-pmail-file-name) 1609 (list (pmail-output-read-file-name)
1589 (prefix-numeric-value current-prefix-arg)))) 1610 (prefix-numeric-value current-prefix-arg))))
1590 (let ((i 0) prev-msg) 1611 (let ((i 0) prev-msg)
1591 (while 1612 (while
@@ -1598,7 +1619,7 @@ starting with the current one. Deleted messages are skipped and don't count."
1598 (setq i (1+ i)) 1619 (setq i (1+ i))
1599 (with-current-buffer pmail-buffer 1620 (with-current-buffer pmail-buffer
1600 (let ((pmail-delete-after-output nil)) 1621 (let ((pmail-delete-after-output nil))
1601 (pmail-output-to-babyl-file file-name 1))) 1622 (pmail-output file-name 1)))
1602 (if pmail-delete-after-output 1623 (if pmail-delete-after-output
1603 (pmail-summary-delete-forward nil) 1624 (pmail-summary-delete-forward nil)
1604 (if (< i n) 1625 (if (< i n)
@@ -1607,11 +1628,18 @@ starting with the current one. Deleted messages are skipped and don't count."
1607(defalias 'pmail-summary-output-to-pmail-file 1628(defalias 'pmail-summary-output-to-pmail-file
1608 'pmail-summary-output-to-babyl-file) 1629 'pmail-summary-output-to-babyl-file)
1609 1630
1610(defun pmail-summary-output (&optional file-name n) 1631(defun pmail-summary-output-as-seen (&optional file-name n)
1611 "Append this message to Unix mail file named FILE-NAME. 1632 "Append this message to system-inbox-format mail file named FILE-NAME.
1633A prefix argument N says to output that many consecutive messages,
1634from the summary, starting with the current one.
1635Deleted messages are skipped and don't count.
1636When called from Lisp code, N may be omitted and defaults to 1.
1612 1637
1613A prefix argument N says to output N consecutive messages 1638This outputs the message header as you see it (or would see it)
1614starting with the current one. Deleted messages are skipped and don't count." 1639displayed in Pmail.
1640
1641The default file name comes from `pmail-default-file',
1642which is updated to the name you use in this command."
1615 (interactive 1643 (interactive
1616 (progn (require 'pmailout) 1644 (progn (require 'pmailout)
1617 (list (pmail-output-read-file-name) 1645 (list (pmail-output-read-file-name)
@@ -1627,7 +1655,7 @@ starting with the current one. Deleted messages are skipped and don't count."
1627 (setq i (1+ i)) 1655 (setq i (1+ i))
1628 (with-current-buffer pmail-buffer 1656 (with-current-buffer pmail-buffer
1629 (let ((pmail-delete-after-output nil)) 1657 (let ((pmail-delete-after-output nil))
1630 (pmail-output file-name 1))) 1658 (pmail-output-as-seen file-name 1)))
1631 (if pmail-delete-after-output 1659 (if pmail-delete-after-output
1632 (pmail-summary-delete-forward nil) 1660 (pmail-summary-delete-forward nil)
1633 (if (< i n) 1661 (if (< i n)
@@ -1659,7 +1687,7 @@ The variables `pmail-secondary-file-directory' and
1659 (cons "Output Pmail File" 1687 (cons "Output Pmail File"
1660 (pmail-list-to-menu "Output Pmail File" 1688 (pmail-list-to-menu "Output Pmail File"
1661 files 1689 files
1662 'pmail-summary-output-to-babyl-file)))) 1690 'pmail-summary-output))))
1663 (define-key pmail-summary-mode-map [menu-bar classify input-menu] 1691 (define-key pmail-summary-mode-map [menu-bar classify input-menu]
1664 '("Input Pmail File" . pmail-disable-menu)) 1692 '("Input Pmail File" . pmail-disable-menu))
1665 (define-key pmail-summary-mode-map [menu-bar classify output-menu] 1693 (define-key pmail-summary-mode-map [menu-bar classify output-menu]