Mercurial > emacs
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
100910:772f216c2808 | 100911:21becd9cb5d4 |
---|---|
90 (pmail-new-summary (concat "labels " labels) | 90 (pmail-new-summary (concat "labels " labels) |
91 (list 'pmail-summary-by-labels labels) | 91 (list 'pmail-summary-by-labels labels) |
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. |
98 Normally checks the To, From and Cc fields of headers; | 103 Normally checks the To, From and Cc fields of headers; |
99 but if PRIMARY-ONLY is non-nil (prefix arg given), | 104 but if PRIMARY-ONLY is non-nil (prefix arg given), |
103 (pmail-new-summary | 108 (pmail-new-summary |
104 (concat "recipients " recipients) | 109 (concat "recipients " recipients) |
105 (list 'pmail-summary-by-recipients recipients primary-only) | 110 (list 'pmail-summary-by-recipients recipients primary-only) |
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)) |
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") ""))))) | |
108 | 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. |
112 If the regular expression is found in the header of the message | 128 If the regular expression is found in the header of the message |
120 (pmail-new-summary (concat "regexp " regexp) | 136 (pmail-new-summary (concat "regexp " regexp) |
121 (list 'pmail-summary-by-regexp regexp) | 137 (list 'pmail-summary-by-regexp regexp) |
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) |
130 "Display a summary of all messages with the given SUBJECT. | 153 "Display a summary of all messages with the given SUBJECT. |
131 Normally checks the Subject field of headers; | 154 Normally checks the Subject field of headers; |
132 but if WHOLE-MESSAGE is non-nil (prefix arg given), | 155 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 "): "))) |
143 (list (read-string prompt nil nil subject) current-prefix-arg))) | 163 (list (read-string prompt nil nil subject) current-prefix-arg))) |
144 (pmail-new-summary | 164 (pmail-new-summary |
146 (list 'pmail-summary-by-topic subject whole-message) | 166 (list 'pmail-summary-by-topic subject whole-message) |
147 'pmail-message-subject-p | 167 'pmail-message-subject-p |
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) |
168 "Display a summary of all messages with the given SENDERS. | 177 "Display a summary of all messages with the given SENDERS. |
169 SENDERS is a string of names separated by commas." | 178 SENDERS is a string of names separated by commas." |
173 (list 'pmail-summary-by-senders senders) | 182 (list 'pmail-summary-by-senders senders) |
174 'pmail-message-senders-p | 183 'pmail-message-senders-p |
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 |
188 (defvar pmail-summary-symbol-number 0) | 191 (defvar pmail-summary-symbol-number 0) |
189 | 192 |
227 (set-buffer pmail-summary-buffer)) | 230 (set-buffer pmail-summary-buffer)) |
228 (pmail-summary-goto-msg mesg t t) | 231 (pmail-summary-goto-msg mesg t t) |
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 |
236 Return the summary buffer by invoking FUNCTION on each message | 239 Return the summary buffer by invoking FUNCTION on each message |
237 passing the message number and ARGS... | 240 passing the message number and ARGS... |
245 (pmail-new-summary-line-count 0) | 248 (pmail-new-summary-line-count 0) |
246 (sumbuf (pmail-get-create-summary-buffer))) | 249 (sumbuf (pmail-get-create-summary-buffer))) |
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)) |
256 (old-max (point-max-marker))) | 261 (old-max (point-max-marker))) |
257 (unwind-protect | 262 (unwind-protect |
259 ;; plan to modify text outside the original restriction. | 264 ;; plan to modify text outside the original restriction. |
260 (save-excursion | 265 (save-excursion |
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)) |
274 ;; Provide a periodic User progress message. | 279 ;; Provide a periodic User progress message. |
275 (if (zerop (% pmail-new-summary-line-count 10)) | 280 (if (zerop (% pmail-new-summary-line-count 10)) |
320 | 325 |
321 ;; Low levels of generating a summary. | 326 ;; Low levels of generating a summary. |
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 |
328 returned. | 336 returned. |
329 | 337 |
330 The current buffer contains the unrestricted message collection." | 338 The current buffer contains the unrestricted message collection." |
331 (let ((line (aref pmail-summary-vector (1- msgnum)))) | 339 (let ((line (aref pmail-summary-vector (1- msgnum)))) |
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. |
343 | 351 It receives the summary line for one message as a string |
344 By default, `identity' is set." | 352 and should return the decoded string. |
353 | |
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) |
372 (result "") | 395 (result "") |
373 char) | 396 char) |
383 (setq index (1+ index))) | 406 (setq index (1+ index))) |
384 (when (> (length result) 0) | 407 (when (> (length result) 0) |
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 |
406 "*Regexp matching user mail addresses. | 447 "*Regexp matching user mail addresses. |
407 If non-nil, this variable is used to identify the correspondent | 448 If non-nil, this variable is used to identify the correspondent |
417 Setting this variable has an effect only before reading a mail." | 458 Setting this variable has an effect only before reading a mail." |
418 :type '(choice (const :tag "None" nil) regexp) | 459 :type '(choice (const :tag "None" nil) regexp) |
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 |
544 (defun pmail-summary-next-all (&optional number) | 570 (defun pmail-summary-next-all (&optional number) |
545 (interactive "p") | 571 (interactive "p") |
607 "Go to the next message in the summary having the same subject. | 633 "Go to the next message in the summary having the same subject. |
608 With prefix argument N, do this N times. | 634 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) |
618 (if forward | 644 (if forward |
619 (not (eobp)) | 645 (not (eobp)) |
627 (forward-line (if forward 1 -1)) | 653 (forward-line (if forward 1 -1)) |
628 ;; Get msg number of this line. | 654 ;; Get msg number of this line. |
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 |
647 (pmail-summary-goto-msg found) | 662 (pmail-summary-goto-msg found) |
648 (error "No %s message with same subject" | 663 (error "No %s message with same subject" |
1573 (set-buffer pmail-buffer))) | 1588 (set-buffer pmail-buffer))) |
1574 (call-interactively 'pmail-resend))) | 1589 (call-interactively '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) | |
1579 "Append the current message to an Pmail file named FILE-NAME. | |
1580 If the file does not exist, ask if it should be created. | |
1581 If file is being visited, the message is appended to the Emacs | |
1582 buffer visiting that file. | |
1583 | |
1584 A prefix argument N says to output N consecutive messages | |
1585 starting with the current one. Deleted messages are skipped and don't count." | |
1586 (interactive | |
1587 (progn (require 'pmailout) | |
1588 (list (pmail-output-read-pmail-file-name) | |
1589 (prefix-numeric-value current-prefix-arg)))) | |
1590 (let ((i 0) prev-msg) | |
1591 (while | |
1592 (and (< i n) | |
1593 (progn (pmail-summary-goto-msg) | |
1594 (not (eq prev-msg | |
1595 (setq prev-msg | |
1596 (with-current-buffer pmail-buffer | |
1597 pmail-current-message)))))) | |
1598 (setq i (1+ i)) | |
1599 (with-current-buffer pmail-buffer | |
1600 (let ((pmail-delete-after-output nil)) | |
1601 (pmail-output-to-babyl-file file-name 1))) | |
1602 (if pmail-delete-after-output | |
1603 (pmail-summary-delete-forward nil) | |
1604 (if (< i n) | |
1605 (pmail-summary-next-msg 1)))))) | |
1606 | |
1607 (defalias 'pmail-summary-output-to-pmail-file | |
1608 'pmail-summary-output-to-babyl-file) | |
1609 | |
1610 (defun pmail-summary-output (&optional file-name n) | 1593 (defun pmail-summary-output (&optional file-name n) |
1611 "Append this message to Unix mail file named FILE-NAME. | 1594 "Append this message to mail file FILE-NAME. |
1612 | 1595 This works with both mbox format and Babyl format files, |
1613 A prefix argument N says to output N consecutive messages | 1596 outputting in the appropriate format for each. |
1614 starting with the current one. Deleted messages are skipped and don't count." | 1597 The default file name comes from `pmail-default-file', |
1598 which is updated to the name you use in this command. | |
1599 | |
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." | |
1615 (interactive | 1607 (interactive |
1616 (progn (require 'pmailout) | 1608 (progn (require 'pmailout) |
1617 (list (pmail-output-read-file-name) | 1609 (list (pmail-output-read-file-name) |
1618 (prefix-numeric-value current-prefix-arg)))) | 1610 (prefix-numeric-value current-prefix-arg)))) |
1619 (let ((i 0) prev-msg) | 1611 (let ((i 0) prev-msg) |
1631 (if pmail-delete-after-output | 1623 (if pmail-delete-after-output |
1632 (pmail-summary-delete-forward nil) | 1624 (pmail-summary-delete-forward nil) |
1633 (if (< i n) | 1625 (if (< i n) |
1634 (pmail-summary-next-msg 1)))))) | 1626 (pmail-summary-next-msg 1)))))) |
1635 | 1627 |
1628 (defalias 'pmail-summary-output-to-pmail-file | |
1629 'pmail-summary-output-to-babyl-file) | |
1630 | |
1631 (defun pmail-summary-output-as-seen (&optional file-name n) | |
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. | |
1637 | |
1638 This outputs the message header as you see it (or would see it) | |
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." | |
1643 (interactive | |
1644 (progn (require 'pmailout) | |
1645 (list (pmail-output-read-file-name) | |
1646 (prefix-numeric-value current-prefix-arg)))) | |
1647 (let ((i 0) prev-msg) | |
1648 (while | |
1649 (and (< i n) | |
1650 (progn (pmail-summary-goto-msg) | |
1651 (not (eq prev-msg | |
1652 (setq prev-msg | |
1653 (with-current-buffer pmail-buffer | |
1654 pmail-current-message)))))) | |
1655 (setq i (1+ i)) | |
1656 (with-current-buffer pmail-buffer | |
1657 (let ((pmail-delete-after-output nil)) | |
1658 (pmail-output-as-seen file-name 1))) | |
1659 (if pmail-delete-after-output | |
1660 (pmail-summary-delete-forward nil) | |
1661 (if (< i n) | |
1662 (pmail-summary-next-msg 1)))))) | |
1663 | |
1636 (defun pmail-summary-output-menu () | 1664 (defun pmail-summary-output-menu () |
1637 "Output current message to another Pmail file, chosen with a menu. | 1665 "Output current message to another Pmail file, chosen with a menu. |
1638 Also set the default for subsequent \\[pmail-output-to-babyl-file] commands. | 1666 Also set the default for subsequent \\[pmail-output-to-babyl-file] commands. |
1639 The variables `pmail-secondary-file-directory' and | 1667 The variables `pmail-secondary-file-directory' and |
1640 `pmail-secondary-file-regexp' control which files are offered in the menu." | 1668 `pmail-secondary-file-regexp' control which files are offered in the menu." |
1657 'pmail-summary-input))) | 1685 'pmail-summary-input))) |
1658 (define-key pmail-summary-mode-map [menu-bar classify output-menu] | 1686 (define-key pmail-summary-mode-map [menu-bar classify output-menu] |
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] |
1666 '("Output Pmail File" . pmail-disable-menu))))) | 1694 '("Output Pmail File" . pmail-disable-menu))))) |
1667 | 1695 |