diff options
| author | Richard M. Stallman | 2009-01-05 15:41:36 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2009-01-05 15:41:36 +0000 |
| commit | 91552da9ad303cb4ed6b8efeb79c39cbe425f673 (patch) | |
| tree | 7374b1aabff08db9f54c9631cfb12c677abd830c | |
| parent | 56f668f7ea5f290a9276b567aabd01caa2711a7f (diff) | |
| download | emacs-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.el | 444 |
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. |
| 134 | SUBJECT is a string of regexps separated by commas." | 157 | SUBJECT 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. |
| 234 | DESCRIPTION is added to the mode line. | 237 | DESCRIPTION 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. |
| 330 | The mbox buffer must be current when you call this function | ||
| 331 | even if its text is swapped. | ||
| 332 | |||
| 325 | If the message has a summary line already, it will be stored in | 333 | If the message has a summary line already, it will be stored in |
| 326 | the message as a header and simply returned, otherwise the | 334 | the message as a header and simply returned, otherwise the |
| 327 | summary line is created, saved in the message header, cached and | 335 | summary 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. |
| 351 | It receives the summary line for one message as a string | ||
| 352 | and should return the decoded string. | ||
| 343 | 353 | ||
| 344 | By default, `identity' is set." | 354 | By 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. |
| 350 | Obtain the message summary from the header if it is available | 360 | Obtain the message summary from the header if it is available |
| 351 | otherwise create it and store it in the message header. | 361 | otherwise create it and store it in the message header. |
| 352 | 362 | ||
| 353 | The current buffer contains the unrestricted message collection." | 363 | The mbox buffer must be current when you call this function |
| 364 | even 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 | ||
| 368 | The current buffer is narrowed to the message headers for | 391 | The current buffer must already be narrowed to the message headers for |
| 369 | the message being processed." | 392 | the 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. |
| 390 | The current buffer is narrowed to the header for message MSGNUM." | 413 | The current buffer should already be narrowed to the header for that message. |
| 414 | It could be either buffer, so don't access Pmail local variables. | ||
| 415 | DELETED is t if this message is marked deleted. | ||
| 416 | UNSEEN is t if it is marked unseen. | ||
| 417 | LINES 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. | ||
| 465 | The value is a list of two strings, the first and second parts of the summary. | ||
| 466 | |||
| 467 | The current buffer must already be narrowed to the message headers for | ||
| 468 | the 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. | |||
| 609 | If N is negative, go backwards." | 635 | If 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. |
| 1580 | If the file does not exist, ask if it should be created. | 1595 | This works with both mbox format and Babyl format files, |
| 1581 | If file is being visited, the message is appended to the Emacs | 1596 | outputting in the appropriate format for each. |
| 1582 | buffer visiting that file. | 1597 | The default file name comes from `pmail-default-file', |
| 1583 | 1598 | which is updated to the name you use in this command. | |
| 1584 | A prefix argument N says to output N consecutive messages | 1599 | |
| 1585 | starting with the current one. Deleted messages are skipped and don't count." | 1600 | A prefix argument N says to output that many consecutive messages |
| 1601 | from those in the summary, starting with the current one. | ||
| 1602 | Deleted messages are skipped and don't count. | ||
| 1603 | When called from Lisp code, N may be omitted and defaults to 1. | ||
| 1604 | |||
| 1605 | This command always outputs the complete message header, | ||
| 1606 | even 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. |
| 1633 | A prefix argument N says to output that many consecutive messages, | ||
| 1634 | from the summary, starting with the current one. | ||
| 1635 | Deleted messages are skipped and don't count. | ||
| 1636 | When called from Lisp code, N may be omitted and defaults to 1. | ||
| 1612 | 1637 | ||
| 1613 | A prefix argument N says to output N consecutive messages | 1638 | This outputs the message header as you see it (or would see it) |
| 1614 | starting with the current one. Deleted messages are skipped and don't count." | 1639 | displayed in Pmail. |
| 1640 | |||
| 1641 | The default file name comes from `pmail-default-file', | ||
| 1642 | which 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] |