![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mh-e.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to mh-e.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;;; mh-e.el (Version: 3.8 for GNU Emacs Version 18 and MH.5 and MH.6)
2:
3: (defvar mh-e-RCS-id)
4: (setq mh-e-RCS-id "$Header: mh-e.el,v 3.5 92/01/21 11:21:59 gildea Exp $")
5: (setq mh-e-time-stamp "92/01/21 10:59:18 gildea")
6: (provide 'mh-e)
7:
8: ;;; Copyright (c) 1985,1986,1987,1988,1990,1992 Free Software Foundation
9: ;;; Maintainer: Stephen Gildea <[email protected]>
10: ;;; Please send suggestions and corrections to the above address.
11: ;;;
12: ;;; This file contains mh-e, a GNU Emacs front end to the MH mail system.
13:
14: ;; This file is part of GNU Emacs.
15:
16: ;; GNU Emacs is free software; you can redistribute it and/or modify
17: ;; it under the terms of the GNU General Public License as published by
18: ;; the Free Software Foundation; either version 1, or (at your option)
19: ;; any later version.
20:
21: ;; GNU Emacs is distributed in the hope that it will be useful,
22: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24: ;; GNU General Public License for more details.
25:
26: ;; You should have received a copy of the GNU General Public License
27: ;; along with GNU Emacs; see the file COPYING. If not, write to
28: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
29:
30:
31: ;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
32: ;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
33: ;;; Rewritten for GNU Emacs, James Larus 1985. [email protected]
34: ;;; Modified by Stephen Gildea, BBN, 1988, and MIT, 1990. [email protected]
35:
36:
37: ;;; NB. MH must have been compiled with the MHE compiler flag or several
38: ;;; features necessary mh-e will be missing from MH commands, specifically
39: ;;; the -build switch to repl and forw.
40:
41: ;;; HOW TO USE:
42: ;;; M-x mh-rmail to read mail. Type C-h m there for a list of commands.
43: ;;; C-u M-x mh-rmail to visit any folder.
44: ;;; M-x mh-smail to send mail. From within the mail reader, "m" works, too.
45: ;;; Your .emacs might benefit from these bindings:
46: ;;; (global-set-key "\C-xm" 'mh-smail)
47: ;;; (global-set-key "\C-x4m" 'mh-smail-other-window)
48: ;;; (global-set-key "\C-xr" 'mh-rmail) ;clobbers copy-rectangle-to-register
49:
50:
51:
52: ;;; Constants:
53:
54: ;;; Set for local environment:
55: ;;;* These are now in paths.el.
56: ;;;(defvar mh-progs "/usr/new/mh/" "Directory containing MH commands.")
57: ;;;(defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library.")
58:
59: (defvar mh-redist-full-contents nil
60: "Non-nil if the `dist' command needs whole letter for redistribution.
61: This is the case when `send' is compiled with the BERK option.")
62:
63:
64: ;;; Hooks:
65:
66: (defvar mh-folder-mode-hook nil
67: "Invoked in `mh-folder mode' on a new folder.")
68:
69: (defvar mh-letter-mode-hook nil
70: "Invoked in `mh-letter-mode' on a new letter.")
71:
72: (defvar mh-compose-letter-function nil
73: "Invoked in `mh-compose-and-send-mail' on a draft letter.
74: It is passed three arguments: TO recipients, SUBJECT, and CC recipients.")
75:
76: (defvar mh-before-send-letter-hook nil
77: "Invoked at the beginning of the \\[mh-send-letter] command.")
78:
79: (defvar mh-inc-folder-hook nil
80: "Invoked after incorporating mail into a folder with \\[mh-inc-folder].")
81:
82: (defvar mh-before-quit-hook nil
83: "Invoked by \\[mh-quit] before quitting mh-e. See also mh-quit-hook")
84:
85: (defvar mh-quit-hook nil
86: "Invoked after quitting mh-e by \\[mh-quit]. See also mh-before-quit-hook")
87:
88:
89: (defvar mh-ins-string nil
90: "Temporarily set by `mh-insert-prefix' prior to running `mh-yank-hooks'.")
91:
92: (defvar mh-yank-hooks
93: '(lambda ()
94: (save-excursion
95: (goto-char (point))
96: (or (bolp) (forward-line 1))
97: (while (< (point) (mark))
98: (insert mh-ins-string)
99: (forward-line 1))))
100: "Hook to run citation function.
101: Expects POINT and MARK to be set to the region to cite.")
102:
103:
104: ;;; Personal preferences:
105:
106: (defvar mh-clean-message-header nil
107: "*Non-nil means clean headers of messages that are displayed or inserted.
108: The variables `mh-visible-headers' and `mh-invisible-headers' control what
109: is removed.")
110:
111: (defvar mh-visible-headers nil
112: "*If non-nil, contains a regexp specifying the headers to keep when cleaning.
113: Only used if `mh-clean-message-header' is non-nil. Setting this variable
114: overrides `mh-invisible-headers'.")
115:
116: (defvar mhl-formfile nil
117: "*Name of format file to be used by mhl to show messages.
118: A value of T means use the default format file.
119: Nil means don't use mhl to format messages.")
120:
121: (defvar mh-lpr-command-format "lpr -p -J '%s'"
122: "*Format for Unix command that prints a message.
123: The string should be a Unix command line, with the string '%s' where
124: the job's name (folder and message number) should appear. The message text
125: is piped to this command.")
126:
127: (defvar mh-print-background nil
128: "*Print messages in the background if non-nil.
129: WARNING: do not delete the messages until printing is finished;
130: otherwise, your output may be truncated.")
131:
132: (defvar mh-summary-height 4
133: "*Number of lines in summary window (including the mode line).")
134:
135: (defvar mh-recenter-summary-p nil
136: "*Recenter summary window when the show window is toggled off if non-nil.")
137:
138: (defvar mh-ins-buf-prefix "> "
139: "*String to put before each non-blank line of a yanked or inserted message.
140: Used when the message is inserted in an outgoing letter.")
141:
142: (defvar mh-do-not-confirm nil
143: "*Non-nil means do not prompt for confirmation before some commands.
144: Only affects certain innocuous commands.")
145:
146: (defvar mh-bury-show-buffer t
147: "*Non-nil means that the displayed show buffer for a folder is buried.")
148:
149: (defvar mh-delete-yanked-msg-window nil
150: "*Controls window display when a message is yanked by \\[mh-yank-cur-msg].
151: If non-nil, yanking the current message into a draft letter deletes any
152: windows displaying the message.")
153:
154: (defvar mh-yank-from-start-of-msg t
155: "*Controls which part of a message is yanked by \\[mh-yank-cur-msg].
156: If non-nil, include the entire message. If the symbol `body', then yank the
157: message minus the header. If nil, yank only the portion of the message
158: following the point. If the show buffer has a region, this variable is
159: ignored.")
160:
161: (defvar mh-reply-default-reply-to nil
162: "*Sets the person or persons to whom a reply will be sent.
163: If nil, prompt for recipient. If non-nil, then \\[mh-reply] will use this
164: value and it should be one of \"from\", \"to\", or \"cc\".")
165:
166: (defvar mh-recursive-folders nil
167: "*If non-nil, then commands which operate on folders do so recursively.")
168:
169: (defvar mh-unshar-default-directory ""
170: "*Default for directory name prompted for by mh-unshar-msg.")
171:
172:
173: ;;; Parameterize mh-e to work with different scan formats. The defaults work
174: ;;; with the standard MH scan listings.
175:
176: (defvar mh-cmd-note 4
177: "Offset to insert notation.")
178:
179: (defvar mh-note-repl "-"
180: "String whose first character is used to notate replied to messages.")
181:
182: (defvar mh-note-forw "F"
183: "String whose first character is used to notate forwarded messages.")
184:
185: (defvar mh-note-dist "R"
186: "String whose first character is used to notate redistributed messages.")
187:
188: (defvar mh-good-msg-regexp "^....[^D^]"
189: "Regexp specifiying the scan lines that are 'good' messages.")
190:
191: (defvar mh-deleted-msg-regexp "^....D"
192: "Regexp matching scan lines of deleted messages.")
193:
194: (defvar mh-refiled-msg-regexp "^....\\^"
195: "Regexp matching scan lines of refiled messages.")
196:
197: (defvar mh-valid-scan-line "^ *[0-9]"
198: "Regexp matching scan lines for messages (not error messages).")
199:
200: (defvar mh-msg-number-regexp "^ *\\([0-9]+\\)"
201: "Regexp to find the number of a message in a scan line.
202: The message's number must be surrounded with \\( \\)")
203:
204: (defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]"
205: "Format string containing a regexp matching the scan listing for a message.
206: The desired message's number will be an argument to format.")
207:
208: (defvar mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%"
209: "Regexp matching flagged scan lines.
210: Matches lines marked as deleted, refiled, in a sequence, or the cur message.")
211:
212: (defvar mh-cur-scan-msg-regexp "^....\\+"
213: "Regexp matching scan line for the cur message.")
214:
215: (defvar mh-show-buffer-mode-line-buffer-id "{%%b} %s/%d"
216: "Format string to produce `mode-line-buffer-id' for show buffers.
217: First argument is folder name. Second is message number.")
218:
219: (defvar mh-partial-folder-mode-line-annotation "select"
220: "Annotation when displaying part of a folder.
221: The string is displayed after the folder's name. NIL for no annotation.")
222:
223:
224: ;;; Real constants:
225:
226: (defvar mh-invisible-headers
227: "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^In-Reply-To: \\|^Resent-"
228: "Regexp matching lines in a message header that are not to be shown.
229: If `mh-visible-headers' is non-nil, it is used instead to specify what
230: to keep.")
231:
232: (defvar mh-rejected-letter-start
233: (concat "^ ----- Unsent message follows -----$" ;from mail system
234: "\\|^------- Unsent Draft$" ;from MH itself
235: "\\|^ --- The unsent message follows ---$") ;from AIX mail system
236: "Regexp specifying the beginning of the wrapper around a returned letter.
237: This wrapper is generated by the mail system when rejecting a letter.")
238:
239: (defvar mh-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:")
240: (?b . "Bcc:") (?f . "Fcc:"))
241: "A-list of (character . field name) strings for mh-to-field.")
242:
243:
244: ;;; Global variables:
245:
246: (defvar mh-user-path ""
247: "User's mail folder.")
248:
249: (defvar mh-last-destination nil
250: "Destination of last refile or write command.")
251:
252: (defvar mh-folder-mode-map (make-keymap)
253: "Keymap for MH folders.")
254:
255: (defvar mh-letter-mode-map (copy-keymap text-mode-map)
256: "Keymap for composing mail.")
257:
258: (defvar mh-pick-mode-map (make-sparse-keymap)
259: "Keymap for searching folder.")
260:
261: (defvar mh-letter-mode-syntax-table nil
262: "Syntax table used while in mh-e letter mode.")
263:
264: (if mh-letter-mode-syntax-table
265: ()
266: (setq mh-letter-mode-syntax-table
267: (make-syntax-table text-mode-syntax-table))
268: (set-syntax-table mh-letter-mode-syntax-table)
269: (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
270:
271: (defvar mh-folder-list nil
272: "List of folder names for completion.")
273:
274: (defvar mh-draft-folder nil
275: "Name of folder containing draft messages.
276: NIL means do not use draft folder.")
277:
278: (defvar mh-unseen-seq nil
279: "Name of the unseen sequence.")
280:
281: (defvar mh-previous-window-config nil
282: "Window configuration before mh-e command.")
283:
284: (defvar mh-previous-seq nil
285: "Name of the sequence to which a message was last added.")
286:
287:
288: ;;; Macros and generic functions:
289:
290: (defmacro mh-push (v l)
291: (list 'setq l (list 'cons v l)))
292:
293:
294: (defmacro mh-when (pred &rest body)
295: (list 'cond (cons pred body)))
296:
297:
298: (defmacro with-mh-folder-updating (save-modification-flag-p &rest body)
299: ;; Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG-P) &body BODY).
300: ;; Execute BODY, which can modify the folder buffer without having to
301: ;; worry about file locking or the read-only flag, and return its result.
302: ;; If SAVE-MODIFICATION-FLAG-P is non-nil, the buffer's modification
303: ;; flag is unchanged, otherwise it is cleared.
304: (setq save-modification-flag-p (car save-modification-flag-p)) ; CL style
305: (` (let ((folder-updating-mod-flag (buffer-modified-p)))
306: (prog1
307: (let ((buffer-read-only nil)
308: (buffer-file-name nil)) ; don't let the buffer get locked
309: (,@ body))
310: (, (if save-modification-flag-p
311: '(mh-set-folder-modified-p folder-updating-mod-flag)
312: '(mh-set-folder-modified-p nil)))))))
313:
314:
315: (defun mh-mapc (func list)
316: (while list
317: (funcall func (car list))
318: (setq list (cdr list))))
319:
320:
321:
322: ;;; Entry points:
323:
324: ;;;###autoload
325: (defun mh-rmail (&optional arg)
326: "Inc(orporate) new mail (no arg) or scan a MH mail box (arg given).
327: This front end uses the MH mail system, which uses different conventions
328: from the usual mail system."
329: (interactive "P")
330: (mh-find-path)
331: (if arg
332: (call-interactively 'mh-visit-folder)
333: (mh-inc-folder)))
334:
335:
336: ;;;###autoload
337: (defun mh-smail ()
338: "Compose and send mail with the MH mail system."
339: (interactive)
340: (mh-find-path)
341: (call-interactively 'mh-send))
342:
343:
344: (defun mh-smail-other-window ()
345: "Compose and send mail in other window with the MH mail system."
346: (interactive)
347: (mh-find-path)
348: (call-interactively 'mh-send-other-window))
349:
350:
351:
352: ;;; User executable mh-e commands:
353:
354: (defun mh-burst-digest ()
355: "Burst apart the current message, which should be a digest.
356: The message is replaced by its table of contents and the letters from the
357: digest are inserted into the folder after that message."
358: (interactive)
359: (let ((digest (mh-get-msg-num t)))
360: (mh-process-or-undo-commands mh-current-folder)
361: (mh-set-folder-modified-p t) ; lock folder while bursting
362: (message "Bursting digest...")
363: (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
364: (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
365: (message "Bursting digest...done")))
366:
367:
368: (defun mh-copy-msg (prefix-provided msg-or-seq dest)
369: "Copy specified MESSAGE(s) to another FOLDER without deleting them.
370: Default is the displayed message. If optional prefix argument is
371: provided, then prompt for the message sequence."
372: (interactive (list current-prefix-arg
373: (if current-prefix-arg
374: (mh-read-seq-default "Copy" t)
375: (mh-get-msg-num t))
376: (mh-prompt-for-folder "Copy to" "" t)))
377: (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest)
378: (if prefix-provided
379: (mh-notate-seq msg-or-seq ?C mh-cmd-note)
380: (mh-notate msg-or-seq ?C mh-cmd-note)))
381:
382:
383: (defun mh-delete-msg (msg-or-seq)
384: "Mark the specified MESSAGE(s) for subsequent deletion and move to the next.
385: Default is the displayed message. If optional prefix argument is
386: given then prompt for the message sequence."
387: (interactive (list (if current-prefix-arg
388: (mh-read-seq-default "Delete" t)
389: (mh-get-msg-num t))))
390: (if (numberp msg-or-seq)
391: (mh-delete-a-msg msg-or-seq)
392: (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))
393: (mh-next-msg))
394:
395:
396: (defun mh-delete-msg-no-motion (msg-or-seq)
397: "Mark the specified MESSAGE(s) for subsequent deletion.
398: Default is the displayed message. If optional prefix argument is
399: provided, then prompt for the message sequence."
400: (interactive (list (if current-prefix-arg
401: (mh-read-seq-default "Delete" t)
402: (mh-get-msg-num t))))
403: (if (numberp msg-or-seq)
404: (mh-delete-a-msg msg-or-seq)
405: (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
406:
407:
408: (defun mh-delete-msg-from-seq (prefix-provided msg-or-seq &optional from-seq)
409: "Delete MESSAGE (default: displayed message) from SEQUENCE.
410: If optional prefix argument provided, then delete all messages
411: from a sequence."
412: (interactive (let ((argp current-prefix-arg))
413: (list argp
414: (if argp
415: (mh-read-seq-default "Delete" t)
416: (mh-get-msg-num t))
417: (if (not argp)
418: (mh-read-seq-default "Delete from" t)))))
419: (if prefix-provided
420: (mh-remove-seq msg-or-seq)
421: (mh-remove-msg-from-seq msg-or-seq from-seq)))
422:
423:
424: (defun mh-edit-again (msg)
425: "Clean-up a draft or a message previously sent and make it resendable."
426: (interactive (list (mh-get-msg-num t)))
427: (let* ((from-folder mh-current-folder)
428: (config (current-window-configuration))
429: (draft
430: (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
431: (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
432: (rename-buffer (format "draft-%d" msg))
433: (buffer-name))
434: (t
435: (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
436: (mh-clean-msg-header (point-min)
437: "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Delivery-Date:"
438: nil)
439: (goto-char (point-min))
440: (set-buffer-modified-p nil)
441: (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
442: config)))
443:
444:
445: (defun mh-execute-commands ()
446: "Process outstanding delete and refile requests."
447: (interactive)
448: (if mh-narrowed-to-seq (mh-widen))
449: (mh-process-commands mh-current-folder)
450: (mh-set-scan-mode)
451: (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
452: (mh-make-folder-mode-line)
453: t) ; return t for write-file-hooks
454:
455:
456: (defun mh-extract-rejected-mail (msg)
457: "Extract a letter returned by the mail system and make it resendable.
458: Default is the displayed message."
459: (interactive (list (mh-get-msg-num t)))
460: (let ((from-folder mh-current-folder)
461: (config (current-window-configuration))
462: (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
463: (goto-char (point-min))
464: (cond ((re-search-forward mh-rejected-letter-start nil t)
465: (forward-char 1)
466: (delete-region (point-min) (point))
467: (mh-clean-msg-header (point-min)
468: "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Return-Path:"
469: nil))
470: (t
471: (message "Does not appear to be a rejected letter.")))
472: (goto-char (point-min))
473: (set-buffer-modified-p nil)
474: (mh-compose-and-send-mail draft "" from-folder msg (mh-get-field "To")
475: (mh-get-field "From") (mh-get-field "cc")
476: nil nil config)))
477:
478:
479: (defun mh-first-msg ()
480: "Move to the first message."
481: (interactive)
482: (goto-char (point-min)))
483:
484:
485: (defun mh-forward (prefix-provided msg-or-seq to cc)
486: "Forward MESSAGE(s) (default: displayed message).
487: If optional prefix argument provided, then prompt for the message sequence."
488: (interactive (list current-prefix-arg
489: (if current-prefix-arg
490: (mh-read-seq-default "Forward" t)
491: (mh-get-msg-num t))
492: (read-string "To: ")
493: (read-string "Cc: ")))
494: (let* ((folder mh-current-folder)
495: (config (current-window-configuration))
496: ;; forw always leaves file in "draft" since it doesn't have -draft
497: (draft-name (expand-file-name "draft" mh-user-path))
498: (draft (cond ((or (not (file-exists-p draft-name))
499: (y-or-n-p "The file 'draft' exists. Discard it? "))
500: (mh-exec-cmd "forw"
501: "-build" mh-current-folder msg-or-seq)
502: (prog1
503: (mh-read-draft "" draft-name t)
504: (mh-insert-fields "To:" to "Cc:" cc)
505: (set-buffer-modified-p nil)))
506: (t
507: (mh-read-draft "" draft-name nil)))))
508: (goto-char (point-min))
509: (re-search-forward "^------- Forwarded Message")
510: (forward-line -1)
511: (narrow-to-region (point) (point-max))
512: (let* ((subject (save-excursion (mh-get-field "From:")))
513: (trim (string-match "<" subject))
514: (forw-subject (save-excursion (mh-get-field "Subject:"))))
515: (if trim
516: (setq subject (substring subject 0 (1- trim))))
517: (widen)
518: (save-excursion
519: (mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject)))
520: (delete-other-windows)
521: (if prefix-provided
522: (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)
523: (mh-add-msgs-to-seq msg-or-seq 'forwarded t))
524: (mh-compose-and-send-mail draft "" folder msg-or-seq
525: to subject cc
526: mh-note-forw "Forwarded:"
527: config))))
528:
529:
530: (defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
531: "Position the cursor at message NUMBER.
532: Non-nil second argument means do not signal an error if message does not exist.
533: Non-nil third argument means not to show the message.
534: Return non-nil if cursor is at message."
535: (interactive "NGoto message: ")
536: (let ((cur-msg (mh-get-msg-num nil))
537: (starting-place (point))
538: (msg-pattern (mh-msg-search-pat number)))
539: (cond ((cond ((and cur-msg (= cur-msg number)) t)
540: ((and cur-msg
541: (< cur-msg number)
542: (re-search-forward msg-pattern nil t)) t)
543: ((and cur-msg
544: (> cur-msg number)
545: (re-search-backward msg-pattern nil t)) t)
546: (t ; Do thorough search of buffer
547: (goto-char (point-max))
548: (re-search-backward msg-pattern nil t)))
549: (beginning-of-line)
550: (if (not dont-show) (mh-maybe-show number))
551: t)
552: (t
553: (goto-char starting-place)
554: (if (not no-error-if-no-message)
555: (error "No message %d" number))
556: nil))))
557:
558:
559: (defun mh-inc-folder (&optional maildrop-name)
560: "Inc(orporate) new mail into +inbox.
561: Optional prefix argument specifies an alternate maildrop from the default.
562: If this is given, incorporate mail into the current folder, rather
563: than +inbox. Run `mh-inc-folder-hook' after incorporating new mail."
564: (interactive (list (if current-prefix-arg
565: (expand-file-name
566: (read-file-name "inc mail from file: "
567: mh-user-path)))))
568: (let ((config (current-window-configuration)))
569: (if (not maildrop-name)
570: (cond ((not (get-buffer "+inbox"))
571: (mh-make-folder "+inbox")
572: (setq mh-previous-window-config config))
573: ((not (eq (current-buffer) (get-buffer "+inbox")))
574: (switch-to-buffer "+inbox")
575: (setq mh-previous-window-config config)))))
576: (mh-get-new-mail maildrop-name)
577: (run-hooks 'mh-inc-folder-hook))
578:
579:
580: (defun mh-kill-folder ()
581: "Remove the current folder."
582: (interactive)
583: (if (or mh-do-not-confirm
584: (yes-or-no-p (format "Remove folder %s? " mh-current-folder)))
585: (let ((folder mh-current-folder))
586: (mh-set-folder-modified-p t) ; lock folder to kill it
587: (mh-exec-cmd-daemon "rmf" folder)
588: (mh-remove-folder-from-folder-list folder)
589: (message "Folder %s removed" folder)
590: (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
591: (if (get-buffer mh-show-buffer)
592: (kill-buffer mh-show-buffer))
593: (kill-buffer folder))
594: (message "Folder not removed")))
595:
596:
597: (defun mh-last-msg ()
598: "Move to the last message."
599: (interactive)
600: (goto-char (point-max))
601: (while (and (not (bobp)) (looking-at "^$"))
602: (forward-line -1)))
603:
604:
605: (defun mh-list-folders ()
606: "List mail folders."
607: (interactive)
608: (with-output-to-temp-buffer " *mh-temp*"
609: (save-excursion
610: (switch-to-buffer " *mh-temp*")
611: (erase-buffer)
612: (message "Listing folders...")
613: (mh-exec-cmd-output "folders" t (if mh-recursive-folders
614: "-recurse"
615: "-norecurse"))
616: (goto-char (point-min))
617: (message "Listing folders...done"))))
618:
619:
620: (defun mh-msg-is-in-seq (msg)
621: "Display the sequences that contain MESSAGE (default: displayed message)."
622: (interactive (list (mh-get-msg-num t)))
623: (message "Message %d is in sequences: %s"
624: msg
625: (mapconcat 'concat
626: (mh-list-to-string (mh-seq-containing-msg msg))
627: " ")))
628:
629:
630: (defun mh-narrow-to-seq (seq)
631: "Restrict display of this folder to just messages in a sequence.
632: Reads which sequence. Use \\[mh-widen] to undo this command."
633: (interactive (list (mh-read-seq "Narrow to" t)))
634: (let ((eob (point-max)))
635: (with-mh-folder-updating (t)
636: (cond ((mh-seq-to-msgs seq)
637: (mh-copy-seq-to-point seq eob)
638: (narrow-to-region eob (point-max))
639: (mh-make-folder-mode-line (symbol-name seq))
640: (mh-recenter nil)
641: (setq mh-narrowed-to-seq seq))
642: (t
643: (error "No messages in sequence `%s'" (symbol-name seq)))))))
644:
645:
646: (defun mh-next-undeleted-msg (&optional arg)
647: "Move to next undeleted message in window."
648: (interactive "P")
649: (forward-line (prefix-numeric-value arg))
650: (setq mh-next-direction 'forward)
651: (cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
652: (beginning-of-line)
653: (mh-maybe-show))
654: (t
655: (forward-line -1)
656: (if (get-buffer mh-show-buffer)
657: (delete-windows-on mh-show-buffer)))))
658:
659:
660: (defun mh-pack-folder (range)
661: "Renumber the messages of a folder to be 1..n.
662: First, offer to execute any outstanding commands for the current folder.
663: If optional prefix argument provided, prompt for the range of messages
664: to display after packing. Otherwise, show the entire folder."
665: (interactive (list (if current-prefix-arg
666: (mh-read-msg-range
667: "Range to scan after packing [all]? ")
668: "all")))
669: (mh-pack-folder-1 range)
670: (mh-goto-cur-msg)
671: (message "Packing folder...done"))
672:
673:
674: (defun mh-pipe-msg (prefix-provided command)
675: "Pipe the current message through the given shell COMMAND.
676: If optional prefix argument is provided, send the entire message.
677: Otherwise just send the message's body."
678: (interactive
679: (list current-prefix-arg (read-string "Shell command on message: ")))
680: (save-excursion
681: (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer
682: (goto-char (point-min))
683: (if (not prefix-provided) (search-forward "\n\n"))
684: (shell-command-on-region (point) (point-max) command nil)))
685:
686:
687: (defun mh-refile-msg (prefix-provided msg-or-seq dest)
688: "Refile MESSAGE(s) (default: displayed message) in FOLDER.
689: If optional prefix argument provided, then prompt for message sequence."
690: (interactive
691: (list current-prefix-arg
692: (if current-prefix-arg
693: (mh-read-seq-default "Refile" t)
694: (mh-get-msg-num t))
695: (intern
696: (mh-prompt-for-folder "Destination"
697: (if (eq 'refile (car mh-last-destination))
698: (symbol-name (cdr mh-last-destination))
699: "")
700: t))))
701: (setq mh-last-destination (cons 'refile dest))
702: (if prefix-provided
703: (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest)
704: (mh-refile-a-msg msg-or-seq dest))
705: (mh-next-msg))
706:
707:
708: (defun mh-refile-or-write-again (msg)
709: "Re-execute the last refile or write command on the given MESSAGE.
710: Default is the displayed message. Use the same folder or file as the
711: previous refile or write command."
712: (interactive (list (mh-get-msg-num t)))
713: (if (null mh-last-destination)
714: (error "No previous refile or write"))
715: (cond ((eq (car mh-last-destination) 'refile)
716: (mh-refile-a-msg msg (cdr mh-last-destination))
717: (message "Destination folder: %s" (cdr mh-last-destination)))
718: (t
719: (mh-write-msg-to-file msg (cdr mh-last-destination))
720: (message "Destination: %s" (cdr mh-last-destination))))
721: (mh-next-msg))
722:
723:
724: (defun mh-reply (prefix-provided msg)
725: "Reply to a MESSAGE (default: displayed message).
726: If optional prefix argument provided, then include the message in the reply
727: using filter mhl.reply in your MH directory."
728: (interactive (list current-prefix-arg (mh-get-msg-num t)))
729: (let ((minibuffer-help-form
730: "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
731: (let ((reply-to (or mh-reply-default-reply-to
732: (completing-read "Reply to whom: "
733: '(("from") ("to") ("cc") ("all"))
734: nil
735: t)))
736: (folder mh-current-folder)
737: (show-buffer mh-show-buffer)
738: (config (current-window-configuration)))
739: (message "Composing a reply...")
740: (cond ((or (equal reply-to "from") (equal reply-to ""))
741: (apply 'mh-exec-cmd
742: "repl" "-build" "-noquery"
743: "-nodraftfolder" mh-current-folder
744: msg
745: "-nocc" "all"
746: (if prefix-provided
747: (list "-filter" "mhl.reply"))))
748: ((equal reply-to "to")
749: (apply 'mh-exec-cmd
750: "repl" "-build" "-noquery"
751: "-nodraftfolder" mh-current-folder
752: msg
753: "-cc" "to"
754: (if prefix-provided
755: (list "-filter" "mhl.reply"))))
756: ((or (equal reply-to "cc") (equal reply-to "all"))
757: (apply 'mh-exec-cmd
758: "repl" "-build" "-noquery"
759: "-nodraftfolder" mh-current-folder
760: msg
761: "-cc" "all" "-nocc" "me"
762: (if prefix-provided
763: (list "-filter" "mhl.reply")))))
764:
765: (let ((draft (mh-read-draft "reply"
766: (expand-file-name "reply" mh-user-path)
767: t)))
768: (delete-other-windows)
769: (set-buffer-modified-p nil)
770:
771: (let ((to (mh-get-field "To:"))
772: (subject (mh-get-field "Subject:"))
773: (cc (mh-get-field "Cc:")))
774: (goto-char (point-min))
775: (mh-goto-header-end 1)
776: (if (not prefix-provided)
777: (mh-display-msg msg folder))
778: (mh-add-msgs-to-seq msg 'answered t)
779: (message "Composing a reply...done")
780: (mh-compose-and-send-mail draft "" folder msg to subject cc
781: mh-note-repl "Replied:" config))))))
782:
783:
784: (defun mh-quit ()
785: "Quit mh-e.
786: Start by running mh-before-quit-hook. Restore the previous window
787: configuration, if one exists. Finish by running mh-quit-hook."
788: (interactive)
789: (run-hooks 'mh-before-quit-hook)
790: (if mh-previous-window-config
791: (set-window-configuration mh-previous-window-config))
792: (run-hooks 'mh-quit-hook))
793:
794:
795: (defun mh-page-digest ()
796: "Advance displayed message to next digested message."
797: (interactive)
798: (save-excursion
799: (mh-show-message-in-other-window)
800: ;; Go to top of screen (in case user moved point).
801: (move-to-window-line 0)
802: (let ((case-fold-search nil))
803: ;; Search for blank line and then for From:
804: (mh-when (not (and (search-forward "\n\n" nil t)
805: (search-forward "From:" nil t)))
806: (other-window -1)
807: (error "No more messages")))
808: ;; Go back to previous blank line, then forward to the first non-blank.
809: (search-backward "\n\n" nil t)
810: (forward-line 2)
811: (mh-recenter 0)
812: (other-window -1)))
813:
814:
815: (defun mh-page-digest-backwards ()
816: "Back up displayed message to previous digested message."
817: (interactive)
818: (save-excursion
819: (mh-show-message-in-other-window)
820: ;; Go to top of screen (in case user moved point).
821: (move-to-window-line 0)
822: (let ((case-fold-search nil))
823: (beginning-of-line)
824: (mh-when (not (and (search-backward "\n\n" nil t)
825: (search-backward "From:" nil t)))
826: (other-window -1)
827: (error "No more messages")))
828: ;; Go back to previous blank line, then forward to the first non-blank.
829: (search-backward "\n\n" nil t)
830: (forward-line 2)
831: (mh-recenter 0)
832: (other-window -1)))
833:
834:
835: (defun mh-page-msg (&optional arg)
836: "Page the displayed message forwards.
837: Scrolls ARG lines or a full screen if no argument is supplied."
838: (interactive "P")
839: (scroll-other-window arg))
840:
841:
842: (defun mh-previous-page (&optional arg)
843: "Page the displayed message backwards.
844: Scrolls ARG lines or a full screen if no argument is supplied."
845: (interactive "P")
846: (save-excursion
847: (mh-show-message-in-other-window)
848: (unwind-protect
849: (scroll-down arg)
850: (other-window -1))))
851:
852:
853: (defun mh-previous-undeleted-msg (&optional arg)
854: "Move to previous undeleted message in window."
855: (interactive "p")
856: (setq mh-next-direction 'backward)
857: (beginning-of-line)
858: (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
859: (mh-maybe-show))
860: (t
861: (if (get-buffer mh-show-buffer)
862: (delete-windows-on mh-show-buffer)))))
863:
864:
865: (defun mh-print-msg (prefix-provided msg-or-seq)
866: "Print MESSAGE(s) (default: displayed message) on a line printer.
867: If optional prefix argument provided, then prompt for the message sequence."
868: (interactive (list current-prefix-arg
869: (if current-prefix-arg
870: (reverse (mh-seq-to-msgs
871: (mh-read-seq-default "Print" t)))
872: (mh-get-msg-num t))))
873: (if prefix-provided
874: (message "Printing sequence...")
875: (message "Printing message..."))
876: (let ((print-command
877: (if prefix-provided
878: (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
879: (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
880: (expand-file-name "mhl" mh-lib)
881: (if (stringp mhl-formfile)
882: (format "-form %s" mhl-formfile)
883: "")
884: (mh-msg-filenames msg-or-seq)
885: (format mh-lpr-command-format
886: (if prefix-provided
887: (format "Sequence from %s" mh-current-folder)
888: (format "%s/%d" mh-current-folder
889: msg-or-seq))))
890: (format "%s -nobell -clear %s %s | %s"
891: (expand-file-name "mhl" mh-lib)
892: (mh-msg-filename msg-or-seq)
893: (if (stringp mhl-formfile)
894: (format "-form %s" mhl-formfile)
895: "")
896: (format mh-lpr-command-format
897: (if prefix-provided
898: (format "Sequence from %s" mh-current-folder)
899: (format "%s/%d" mh-current-folder
900: msg-or-seq)))))))
901: (if mh-print-background
902: (mh-exec-cmd-daemon shell-file-name "-c" print-command)
903: (call-process shell-file-name nil nil nil "-c" print-command))
904: (if prefix-provided
905: (mh-notate-seq msg-or-seq ?P mh-cmd-note)
906: (mh-notate msg-or-seq ?P mh-cmd-note))
907: (mh-add-msgs-to-seq msg-or-seq 'printed t)
908: (if prefix-provided
909: (message "Printing sequence...done")
910: (message "Printing message...done"))))
911:
912:
913: (defun mh-put-msg-in-seq (prefix-provided from to)
914: "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
915: If optional prefix argument provided, then prompt for the message sequence."
916: (interactive (list current-prefix-arg
917: (if current-prefix-arg
918: (mh-seq-to-msgs
919: (mh-read-seq-default "Add messages from" t))
920: (mh-get-msg-num t))
921: (mh-read-seq-default "Add to" nil)))
922: (setq mh-previous-seq to)
923: (mh-add-msgs-to-seq from to))
924:
925:
926: (defun mh-rescan-folder (&optional range)
927: "Rescan a folder after optionally processing the outstanding commands.
928: If optional prefix argument is provided, prompt for the range of
929: messages to display. Otherwise show the entire folder."
930: (interactive (list (if current-prefix-arg
931: (mh-read-msg-range "Range to scan [all]? ")
932: nil)))
933: (setq mh-next-direction 'forward)
934: (mh-scan-folder mh-current-folder (or range "all")))
935:
936:
937: (defun mh-redistribute (to cc msg)
938: "Redistribute a letter.
939: Depending on how your copy of MH was compiled, you may need to change the
940: setting of the variable mh-redist-full-contents. See its documentation."
941: (interactive (list (read-string "Redist-To: ")
942: (read-string "Redist-Cc: ")
943: (mh-get-msg-num t)))
944: (save-window-excursion
945: (let ((folder mh-current-folder)
946: (draft (mh-read-draft "redistribution"
947: (if mh-redist-full-contents
948: (mh-msg-filename msg)
949: nil)
950: nil)))
951: (mh-goto-header-end 0)
952: (insert "Resent-To: " to "\n")
953: (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
954: (mh-clean-msg-header (point-min)
955: "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
956: nil)
957: (save-buffer)
958: (message "Redistributing...")
959: (if mh-redist-full-contents
960: (call-process "/bin/sh" nil 0 nil "-c"
961: (format "mhdist=1 mhaltmsg=%s %s -push %s"
962: (buffer-file-name)
963: (expand-file-name "send" mh-progs)
964: (buffer-file-name)))
965: (call-process "/bin/sh" nil 0 nil "-c"
966: (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
967: (mh-msg-filename msg folder)
968: (expand-file-name "send" mh-progs)
969: (buffer-file-name))))
970: (mh-annotate-msg msg folder mh-note-dist
971: "-component" "Resent:"
972: "-text" (format "\"%s %s\"" to cc))
973: (kill-buffer draft)
974: (message "Redistributing...done"))))
975:
976:
977: (defun mh-write-msg-to-file (msg file)
978: "Append MESSAGE to the end of a FILE."
979: (interactive
980: (list (mh-get-msg-num t)
981: (let ((default-dir (if (eq 'write (car mh-last-destination))
982: (file-name-directory (cdr mh-last-destination))
983: default-directory)))
984: (read-file-name "Save message in file: " default-dir
985: (expand-file-name "mail.out" default-dir)))))
986: (let ((file-name (mh-msg-filename msg))
987: (output-file (mh-expand-file-name file)))
988: (setq mh-last-destination (cons 'write file))
989: (save-excursion
990: (set-buffer (get-buffer-create " *mh-temp*"))
991: (erase-buffer)
992: (insert-file-contents file-name)
993: (append-to-file (point-min) (point-max) output-file))))
994:
995:
996: (defun mh-search-folder (folder)
997: "Search FOLDER for messages matching a pattern."
998: (interactive (list (mh-prompt-for-folder "Search"
999: mh-current-folder
1000: t)))
1001: (switch-to-buffer-other-window "pick-pattern")
1002: (if (or (zerop (buffer-size))
1003: (not (y-or-n-p "Reuse pattern? ")))
1004: (mh-make-pick-template)
1005: (message ""))
1006: (setq mh-searching-folder folder))
1007:
1008:
1009: (defun mh-send (to cc subject)
1010: "Compose and send a letter.
1011: The letter is composed in mh-letter-mode; see its documentation for more
1012: details. If `mh-compose-letter-function' is defined, it is called on the
1013: draft and passed three arguments: to, subject, and cc."
1014: (interactive "sTo: \nsCc: \nsSubject: ")
1015: (let ((config (current-window-configuration)))
1016: (delete-other-windows)
1017: (mh-send-sub to cc subject config)))
1018:
1019:
1020: (defun mh-send-other-window (to cc subject)
1021: "Compose and send a letter in another window.."
1022: (interactive "sTo: \nsCc: \nsSubject: ")
1023: (let ((pop-up-windows t))
1024: (mh-send-sub to cc subject (current-window-configuration))))
1025:
1026:
1027: (defun mh-send-sub (to cc subject config)
1028: "Do the real work of composing and sending a letter.
1029: Expects the TO, CC, and SUBJECT fields as arguments.
1030: CONFIG is the window configuration before sending mail."
1031: (let ((folder mh-current-folder)
1032: (msg-num (mh-get-msg-num nil)))
1033: (message "Composing a message...")
1034: (let ((draft (mh-read-draft
1035: "message"
1036: (if (file-exists-p
1037: (expand-file-name "components" mh-user-path))
1038: (expand-file-name "components" mh-user-path)
1039: (if (file-exists-p
1040: (expand-file-name "components" mh-lib))
1041: (expand-file-name "components" mh-lib)
1042: (error "Can't find components file")))
1043: nil)))
1044: (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
1045: (set-buffer-modified-p nil)
1046: (goto-char (point-max))
1047: (message "Composing a message...done")
1048: (mh-compose-and-send-mail draft "" folder msg-num
1049: to subject cc
1050: nil nil config))))
1051:
1052:
1053: (defun mh-show (&optional msg)
1054: "Show MESSAGE (default: displayed message).
1055: Forces a two-window display with the folder window on top (size
1056: mh-summary-height) and the show buffer below it."
1057: (interactive)
1058: (if (not msg)
1059: (setq msg (mh-get-msg-num t)))
1060: (setq mh-showing t)
1061: (mh-set-mode-name "mh-e show")
1062: (if (not (eql (next-window (minibuffer-window)) (selected-window)))
1063: (delete-other-windows)) ; force ourself to the top window
1064: (let ((folder mh-current-folder))
1065: (mh-show-message-in-other-window)
1066: (mh-display-msg msg folder))
1067: (other-window -1)
1068: (if (not (= (1+ (window-height)) (screen-height))) ;not horizontally split
1069: (shrink-window (- (window-height) mh-summary-height)))
1070: (mh-recenter nil)
1071: (if (not (memq msg mh-seen-list)) (mh-push msg mh-seen-list)))
1072:
1073:
1074: (defun mh-sort-folder ()
1075: "Sort the messages in the current folder by date."
1076: (interactive)
1077: (mh-process-or-undo-commands mh-current-folder)
1078: (setq mh-next-direction 'forward)
1079: (mh-set-folder-modified-p t) ; lock folder while sorting
1080: (message "Sorting folder...")
1081: (mh-exec-cmd "sortm" mh-current-folder)
1082: (message "Sorting folder...done")
1083: (mh-scan-folder mh-current-folder "all"))
1084:
1085:
1086: (defun mh-toggle-showing ()
1087: "Toggle the scanning mode/showing mode of displaying messages."
1088: (interactive)
1089: (if mh-showing
1090: (mh-set-scan-mode)
1091: (mh-show)))
1092:
1093:
1094: (defun mh-undo (prefix-provided msg-or-seq)
1095: "Undo the deletion or refile of the specified MESSAGE(s).
1096: Default is the displayed message. If optional prefix argument is
1097: provided, then prompt for the message sequence."
1098: (interactive (list current-prefix-arg
1099: (if current-prefix-arg
1100: (mh-read-seq-default "Undo" t)
1101: (mh-get-msg-num t))))
1102: (cond (prefix-provided
1103: (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq)))
1104: (t
1105: (let ((original-position (point)))
1106: (beginning-of-line)
1107: (while (not (or (looking-at mh-deleted-msg-regexp)
1108: (looking-at mh-refiled-msg-regexp)
1109: (and (eq mh-next-direction 'forward) (bobp))
1110: (and (eq mh-next-direction 'backward)
1111: (save-excursion (forward-line) (eobp)))))
1112: (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1113: (if (or (looking-at mh-deleted-msg-regexp)
1114: (looking-at mh-refiled-msg-regexp))
1115: (progn
1116: (mh-undo-msg (mh-get-msg-num t))
1117: (mh-maybe-show))
1118: (goto-char original-position)
1119: (error "Nothing to undo")))))
1120: ;; update the mh-refile-list so mh-outstanding-commands-p will work
1121: (mh-mapc (function
1122: (lambda (elt)
1123: (if (not (mh-seq-to-msgs elt))
1124: (setq mh-refile-list (delq elt mh-refile-list)))))
1125: mh-refile-list)
1126: (if (not (mh-outstanding-commands-p))
1127: (mh-set-folder-modified-p nil)))
1128:
1129:
1130: (defun mh-undo-msg (msg)
1131: ;; Undo the deletion or refile of one MESSAGE.
1132: (cond ((memq msg mh-delete-list)
1133: (setq mh-delete-list (delq msg mh-delete-list))
1134: (mh-remove-msg-from-seq msg 'deleted t))
1135: (t
1136: (mh-mapc (function (lambda (dest)
1137: (mh-remove-msg-from-seq msg dest t)))
1138: mh-refile-list)))
1139: (mh-notate msg ? mh-cmd-note))
1140:
1141:
1142: (defun mh-undo-folder (&rest ignore)
1143: "Undo all commands in current folder."
1144: (interactive)
1145: (cond ((or mh-do-not-confirm
1146: (yes-or-no-p "Undo all commands in folder? "))
1147: (setq mh-delete-list nil
1148: mh-refile-list nil
1149: mh-seq-list nil
1150: mh-next-direction 'forward)
1151: (with-mh-folder-updating (nil)
1152: (mh-unmark-all-headers t)))
1153: (t
1154: (message "Commands not undone.")
1155: (sit-for 2))))
1156:
1157:
1158: (defun mh-unshar-msg (dir)
1159: "Unpack the shar file contained in the current message into directory DIR."
1160: (interactive (list (read-file-name "Unshar message in directory: "
1161: mh-unshar-default-directory
1162: mh-unshar-default-directory nil)))
1163: (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer
1164: (mh-unshar-buffer dir))
1165:
1166: (defun mh-unshar-buffer (dir)
1167: ;; Unpack the shar file contained in the current buffer into directory DIR.
1168: (goto-char (point-min))
1169: (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t)
1170: (and (re-search-forward "^[^a-z0-9\"]*cut here\b" nil t)
1171: (forward-line 1))
1172: (re-search-forward "^#" nil t)
1173: (re-search-forward "^: " nil t))
1174: (let ((default-directory (expand-file-name dir))
1175: (start (progn (beginning-of-line) (point)))
1176: (log-buffer (get-buffer-create "*Unshar Output*")))
1177: (save-excursion
1178: (set-buffer log-buffer)
1179: (setq default-directory (expand-file-name dir))
1180: (erase-buffer)
1181: (if (file-directory-p default-directory)
1182: (insert "cd " dir "\n")
1183: (insert "mkdir " dir "\n")
1184: (call-process "mkdir" nil log-buffer t default-directory)))
1185: (set-window-start (display-buffer log-buffer) 0) ;so can watch progress
1186: (call-process-region start (point-max) "sh" nil log-buffer t))
1187: (error "Cannot find start of shar.")))
1188:
1189:
1190: (defun mh-visit-folder (folder &optional range)
1191: "Visit FOLDER and display RANGE of messages.
1192: Assumes mh-e has already been initialized."
1193: (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t)
1194: (mh-read-msg-range "Range [all]? ")))
1195: (let ((config (current-window-configuration)))
1196: (mh-scan-folder folder (or range "all"))
1197: (setq mh-previous-window-config config))
1198: nil)
1199:
1200:
1201: (defun mh-widen ()
1202: "Remove restrictions from the current folder, thereby showing all messages."
1203: (interactive)
1204: (if mh-narrowed-to-seq
1205: (with-mh-folder-updating (t)
1206: (delete-region (point-min) (point-max))
1207: (widen)
1208: (mh-make-folder-mode-line)))
1209: (setq mh-narrowed-to-seq nil))
1210:
1211:
1212:
1213: ;;; Support routines.
1214:
1215: (defun mh-delete-a-msg (msg)
1216: ;; Delete the MESSAGE.
1217: (save-excursion
1218: (mh-goto-msg msg nil t)
1219: (if (looking-at mh-refiled-msg-regexp)
1220: (error "Message %d is refiled. Undo refile before deleting." msg))
1221: (if (looking-at mh-deleted-msg-regexp)
1222: nil
1223: (mh-set-folder-modified-p t)
1224: (mh-push msg mh-delete-list)
1225: (mh-add-msgs-to-seq msg 'deleted t)
1226: (mh-notate msg ?D mh-cmd-note))))
1227:
1228:
1229: (defun mh-refile-a-msg (msg destination)
1230: ;; Refile MESSAGE in FOLDER. FOLDER is a symbol, not a string.
1231: (save-excursion
1232: (mh-goto-msg msg nil t)
1233: (cond ((looking-at mh-deleted-msg-regexp)
1234: (error "Message %d is deleted. Undo delete before moving." msg))
1235: ((looking-at mh-refiled-msg-regexp)
1236: (if (y-or-n-p
1237: (format "Message %d already refiled. Copy to %s as well? "
1238: msg destination))
1239: (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1240: "-src" mh-current-folder
1241: (symbol-name destination))
1242: (message "Message not copied.")))
1243: (t
1244: (mh-set-folder-modified-p t)
1245: (if (not (memq destination mh-refile-list))
1246: (mh-push destination mh-refile-list))
1247: (if (not (memq msg (mh-seq-to-msgs destination)))
1248: (mh-add-msgs-to-seq msg destination t))
1249: (mh-notate msg ?^ mh-cmd-note)))))
1250:
1251:
1252: (defun mh-display-msg (msg-num folder)
1253: ;; Display message NUMBER of FOLDER.
1254: ;; Sets the current buffer to the show buffer.
1255: (set-buffer folder)
1256: ;; Bind variables in folder buffer in case they are local
1257: (let ((formfile mhl-formfile)
1258: (clean-message-header mh-clean-message-header)
1259: (invisible-headers mh-invisible-headers)
1260: (visible-headers mh-visible-headers)
1261: (msg-filename (mh-msg-filename msg-num))
1262: (show-buffer mh-show-buffer)
1263: (folder mh-current-folder))
1264: (if (not (file-exists-p msg-filename))
1265: (error "Message %d does not exist" msg-num))
1266: (switch-to-buffer show-buffer)
1267: (if mh-bury-show-buffer (bury-buffer (current-buffer)))
1268: (mh-when (not (equal msg-filename buffer-file-name))
1269: ;; Buffer does not yet contain message.
1270: (clear-visited-file-modtime)
1271: (unlock-buffer)
1272: (setq buffer-file-name nil) ; no locking during setup
1273: (erase-buffer)
1274: (if formfile
1275: (if (stringp formfile)
1276: (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
1277: "-form" formfile msg-filename)
1278: (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
1279: msg-filename))
1280: (insert-file-contents msg-filename))
1281: (goto-char (point-min))
1282: (cond (clean-message-header
1283: (mh-clean-msg-header (point-min)
1284: invisible-headers
1285: visible-headers)
1286: (goto-char (point-min)))
1287: (t
1288: (let ((case-fold-search t))
1289: (re-search-forward
1290: "^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
1291: (beginning-of-line)
1292: (mh-recenter 0))))
1293: (set-buffer-modified-p nil)
1294: (setq buffer-file-name msg-filename)
1295: (set-mark nil)
1296: (setq mode-line-buffer-identification
1297: (list (format mh-show-buffer-mode-line-buffer-id
1298: folder msg-num))))))
1299:
1300:
1301: (defun mh-invalidate-show-buffer ()
1302: ;; Invalidate the show buffer so we must update it to use it.
1303: (if (get-buffer mh-show-buffer)
1304: (save-excursion
1305: (set-buffer mh-show-buffer)
1306: (setq buffer-file-name nil))))
1307:
1308:
1309: (defun mh-show-message-in-other-window ()
1310: (switch-to-buffer-other-window mh-show-buffer)
1311: (if mh-bury-show-buffer (bury-buffer (current-buffer))))
1312:
1313:
1314: (defun mh-clean-msg-header (start invisible-headers visible-headers)
1315: ;; Flush extraneous lines in a message header, from the given POINT to the
1316: ;; end of the message header. If VISIBLE-HEADERS is non-nil, it contains a
1317: ;; regular expression specifying the lines to display, otherwise
1318: ;; INVISIBLE-HEADERS contains a regular expression specifying lines to
1319: ;; delete from the header.
1320: (let ((case-fold-search t))
1321: (save-restriction
1322: (goto-char start)
1323: (if (search-forward "\n\n" nil t)
1324: (backward-char 1))
1325: (narrow-to-region start (point))
1326: (goto-char (point-min))
1327: (if visible-headers
1328: (while (< (point) (point-max))
1329: (beginning-of-line)
1330: (cond ((looking-at visible-headers)
1331: (forward-line 1)
1332: (while (looking-at "^[ \t]+") (forward-line 1)))
1333: (t
1334: (mh-delete-line 1)
1335: (while (looking-at "^[ \t]+")
1336: (beginning-of-line)
1337: (mh-delete-line 1)))))
1338: (while (re-search-forward invisible-headers nil t)
1339: (beginning-of-line)
1340: (mh-delete-line 1)
1341: (while (looking-at "^[ \t]+")
1342: (beginning-of-line)
1343: (mh-delete-line 1))))
1344: (unlock-buffer))))
1345:
1346:
1347: (defun mh-delete-line (lines)
1348: ;; Delete version of kill-line.
1349: (delete-region (point) (save-excursion (forward-line lines) (point))))
1350:
1351:
1352: (defun mh-read-draft (use initial-contents delete-contents-file)
1353: ;; Read draft file into a draft buffer and make that buffer the current one.
1354: ;; USE is a message used for prompting about the intended use of the message.
1355: ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
1356: ;; if buffer should not be modified. Delete the initial-contents file if
1357: ;; DELETE-CONTENTS-FILE flag is set.
1358: ;; Returns the draft folder's name.
1359: ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
1360: ;; used each time and saved in the draft folder. The draft file can then be
1361: ;; reused.
1362: (cond (mh-draft-folder
1363: (let ((orig-default-dir default-directory))
1364: (pop-to-buffer (find-file-noselect (mh-new-draft-name)) t)
1365: (rename-buffer (format "draft-%s" (buffer-name)))
1366: (setq default-directory orig-default-dir)))
1367: (t
1368: (let ((draft-name (expand-file-name "draft" mh-user-path)))
1369: (pop-to-buffer "draft") ; Create if necessary
1370: (if (buffer-modified-p)
1371: (if (y-or-n-p "Draft has been modified; kill anyway? ")
1372: (set-buffer-modified-p nil)
1373: (error "Draft preserved")))
1374: (setq buffer-file-name draft-name)
1375: (clear-visited-file-modtime)
1376: (unlock-buffer)
1377: (mh-when (and (file-exists-p draft-name)
1378: (not (equal draft-name initial-contents)))
1379: (insert-file-contents draft-name)
1380: (delete-file draft-name)))))
1381: (mh-when (and initial-contents
1382: (or (zerop (buffer-size))
1383: (not (y-or-n-p
1384: (format "A draft exists. Use for %s? " use)))))
1385: (erase-buffer)
1386: (insert-file-contents initial-contents)
1387: (if delete-contents-file (delete-file initial-contents)))
1388: (auto-save-mode 1)
1389: (if mh-draft-folder
1390: (save-buffer)) ; Do not reuse draft name
1391: (buffer-name))
1392:
1393:
1394: (defun mh-new-draft-name ()
1395: ;; Returns the pathname of folder for draft messages.
1396: (save-excursion
1397: (set-buffer (get-buffer-create " *mh-temp*"))
1398: (erase-buffer)
1399: (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new")
1400: (buffer-substring (point) (1- (mark)))))
1401:
1402:
1403: (defun mh-next-msg ()
1404: ;; Move backward or forward to the next undeleted message in the buffer.
1405: (if (eq mh-next-direction 'forward)
1406: (mh-next-undeleted-msg 1)
1407: (mh-previous-undeleted-msg 1)))
1408:
1409:
1410: (defun mh-set-scan-mode ()
1411: ;; Display the scan listing buffer, but do not show a message.
1412: (if (get-buffer mh-show-buffer)
1413: (delete-windows-on mh-show-buffer))
1414: (mh-set-mode-name "mh-e scan")
1415: (setq mh-showing nil)
1416: (if mh-recenter-summary-p
1417: (mh-recenter nil)))
1418:
1419:
1420: (defun mh-maybe-show (&optional msg)
1421: ;; If in showing mode, then display the message pointed to by the cursor.
1422: (if mh-showing (mh-show msg)))
1423:
1424:
1425: (defun mh-set-mode-name (mode-name-string)
1426: ;; Set the mode-name and ensure that the mode line is updated.
1427: (setq mode-name mode-name-string)
1428: ;; Force redisplay of all buffers' mode lines to be considered.
1429: (save-excursion (set-buffer (other-buffer)))
1430: (set-buffer-modified-p (buffer-modified-p)))
1431:
1432:
1433:
1434: ;;; The folder data abstraction.
1435:
1436: (defvar mh-current-folder nil "Name of current folder, a string.")
1437: (defvar mh-show-buffer nil "Buffer that displays mesage for this folder.")
1438: (defvar mh-folder-filename nil "Full path of directory for this folder.")
1439: (defvar mh-showing nil "If non-nil, show the message in a separate window.")
1440: (defvar mh-next-seq-num nil "Index of free sequence id.")
1441: (defvar mh-delete-list nil "List of msg numbers to delete.")
1442: (defvar mh-refile-list nil "List of folder names in mh-seq-list.")
1443: (defvar mh-seq-list nil "Alist of (seq . msgs) numbers.")
1444: (defvar mh-seen-list nil "List of displayed messages.")
1445: (defvar mh-next-direction 'forward "Direction to move to next message.")
1446: (defvar mh-narrowed-to-seq nil "Sequence display is narrowed to.")
1447: (defvar mh-first-msg-num nil "Number of first msg in buffer.")
1448: (defvar mh-last-msg-num nil "Number of last msg in buffer.")
1449:
1450:
1451: (defun mh-make-folder (name)
1452: ;; Create and initialize a new mail folder called NAME and make it the
1453: ;; current folder.
1454: (switch-to-buffer name)
1455: (setq buffer-read-only nil)
1456: (erase-buffer)
1457: (setq buffer-read-only t)
1458: (mh-folder-mode)
1459: (mh-set-folder-modified-p nil)
1460: (setq buffer-file-name mh-folder-filename)
1461: (mh-set-mode-name "mh-e scan"))
1462:
1463:
1464: ;;; Don't use this mode when creating buffers if default-major-mode is nil.
1465: (put 'mh-folder-mode 'mode-class 'special)
1466:
1467: (defun mh-folder-mode ()
1468: "Major mode for \"editing\" an MH folder scan listing.
1469: Messages can be marked for refiling and deletion. However, both actions
1470: are deferred until you request execution with \\[mh-execute-commands].
1471: \\{mh-folder-mode-map}
1472: A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
1473: applies the action to a message sequence.
1474:
1475: Variables controlling mh-e operation are (defaults in parentheses):
1476:
1477: mh-bury-show-buffer (t)
1478: Non-nil means that the buffer used to display message is buried.
1479: It will never be offered as the default other buffer.
1480:
1481: mh-clean-message-header (nil)
1482: Non-nil means remove header lines matching the regular expression
1483: specified in mh-invisible-headers from messages.
1484:
1485: mh-visible-headers (nil)
1486: If non-nil, it contains a regexp specifying the headers that are shown in
1487: a message if mh-clean-message-header is non-nil. Setting this variable
1488: overrides mh-invisible-headers.
1489:
1490: mh-do-not-confirm (nil)
1491: Non-nil means do not prompt for confirmation before executing some
1492: non-recoverable commands such as mh-kill-folder and mh-undo-folder.
1493:
1494: mhl-formfile (nil)
1495: Name of format file to be used by mhl to show messages.
1496: A value of T means use the default format file.
1497: Nil means don't use mhl to format messages.
1498:
1499: mh-lpr-command-format (\"lpr -p -J '%s'\")
1500: Format for command used to print a message on a system printer.
1501:
1502: mh-recenter-summary-p (nil)
1503: If non-nil, then the scan listing is recentered when the window displaying
1504: a messages is toggled off.
1505:
1506: mh-summary-height (4)
1507: Number of lines in the summary window including the mode line.
1508:
1509: mh-ins-buf-prefix (\"> \")
1510: String to insert before each non-blank line of a message as it is
1511: inserted in a draft letter.
1512:
1513: The value of mh-folder-mode-hook is called when a new folder is set up."
1514:
1515: (kill-all-local-variables)
1516: (use-local-map mh-folder-mode-map)
1517: (setq major-mode 'mh-folder-mode)
1518: (mh-set-mode-name "mh-e folder")
1519: (make-local-vars
1520: 'mh-current-folder (buffer-name) ; Name of folder, a string
1521: 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
1522: 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
1523: (file-name-as-directory (mh-expand-file-name (buffer-name)))
1524: 'mh-showing nil ; Show message also?
1525: 'mh-next-seq-num 0 ; Index of free sequence id
1526: 'mh-delete-list nil ; List of msgs nums to delete
1527: 'mh-refile-list nil ; List of folder names in mh-seq-list
1528: 'mh-seq-list nil ; Alist of (seq . msgs) nums
1529: 'mh-seen-list nil ; List of displayed messages
1530: 'mh-next-direction 'forward ; Direction to move to next message
1531: 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
1532: 'mh-first-msg-num nil ; Number of first msg in buffer
1533: 'mh-last-msg-num nil ; Number of last msg in buffer
1534: 'mh-previous-window-config nil) ; Previous window configuration
1535: (setq truncate-lines t)
1536: (auto-save-mode -1)
1537: (setq buffer-offer-save t)
1538: (make-local-variable 'write-file-hooks)
1539: (setq write-file-hooks '(mh-execute-commands))
1540: (make-local-variable 'revert-buffer-function)
1541: (setq revert-buffer-function 'mh-undo-folder)
1542: (run-hooks 'mh-folder-mode-hook))
1543:
1544:
1545: (defun make-local-vars (&rest pairs)
1546: ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the
1547: ;; value.
1548: (while pairs
1549: (make-variable-buffer-local (car pairs))
1550: (set (car pairs) (car (cdr pairs)))
1551: (setq pairs (cdr (cdr pairs)))))
1552:
1553:
1554: (defun mh-scan-folder (folder range)
1555: ;; Scan the FOLDER over the RANGE. Return in the folder's buffer.
1556: (cond ((null (get-buffer folder))
1557: (mh-make-folder folder))
1558: (t
1559: (mh-process-or-undo-commands folder)
1560: (switch-to-buffer folder)))
1561: (mh-regenerate-headers range)
1562: (mh-when (zerop (buffer-size))
1563: (if (equal range "all")
1564: (message "Folder %s is empty" folder)
1565: (message "No messages in %s, range %s" folder range))
1566: (sit-for 5))
1567: (mh-goto-cur-msg))
1568:
1569:
1570: (defun mh-regenerate-headers (range)
1571: ;; Replace buffer with scan of its contents over range RANGE.
1572: (let ((folder mh-current-folder))
1573: (message "Scanning %s..." folder)
1574: (with-mh-folder-updating (nil)
1575: (erase-buffer)
1576: (mh-exec-cmd-output "scan" nil
1577: "-noclear" "-noheader"
1578: "-width" (window-width)
1579: folder range)
1580: (goto-char (point-min))
1581: (cond ((looking-at "scan: no messages in")
1582: (keep-lines mh-valid-scan-line)) ; Flush random scan lines
1583: ((looking-at "scan: ")) ; Keep error messages
1584: (t
1585: (keep-lines mh-valid-scan-line))) ; Flush random scan lines
1586: (mh-delete-seq-locally 'cur) ; To pick up new one
1587: (setq mh-seq-list (mh-read-folder-sequences folder nil))
1588: (mh-notate-user-sequences)
1589: (mh-make-folder-mode-line (if (equal range "all")
1590: nil
1591: mh-partial-folder-mode-line-annotation)))
1592: (message "Scanning %s...done" folder)))
1593:
1594:
1595: (defun mh-get-new-mail (maildrop-name)
1596: ;; Read new mail from a maildrop into the current buffer.
1597: ;; Return T if there was new mail, NIL otherwise. Return in the current
1598: ;; buffer.
1599: (let ((point-before-inc (point))
1600: (folder mh-current-folder)
1601: (return-value t))
1602: (with-mh-folder-updating (t)
1603: (message (if maildrop-name
1604: (format "inc %s -file %s..." folder maildrop-name)
1605: (format "inc %s..." folder)))
1606: (mh-unmark-all-headers nil)
1607: (setq mh-next-direction 'forward)
1608: (goto-char (point-max))
1609: (let ((start-of-inc (point)))
1610: (if maildrop-name
1611: (mh-exec-cmd-output "inc" nil folder
1612: "-file" (expand-file-name maildrop-name)
1613: "-width" (window-width)
1614: "-truncate")
1615: (mh-exec-cmd-output "inc" nil
1616: "-width" (window-width)))
1617: (message
1618: (if maildrop-name
1619: (format "inc %s -file %s...done" folder maildrop-name)
1620: (format "inc %s...done" folder)))
1621: (goto-char start-of-inc)
1622: (cond ((looking-at "inc: no mail")
1623: (keep-lines mh-valid-scan-line) ; Flush random scan lines
1624: (goto-char point-before-inc)
1625: (message "No new mail%s%s" (if maildrop-name " in " "")
1626: (if maildrop-name maildrop-name "")))
1627: ((re-search-forward "^inc:" nil t) ; Error messages
1628: (error "inc error"))
1629: (t
1630: (mh-delete-seq-locally 'cur) ; To pick up new one
1631: (setq mh-seq-list (mh-read-folder-sequences folder t))
1632: (mh-notate-user-sequences)
1633: (keep-lines mh-valid-scan-line)
1634: (mh-make-folder-mode-line)
1635: (mh-goto-cur-msg)
1636: (setq return-value t))))
1637: return-value)))
1638:
1639:
1640: (defun mh-make-folder-mode-line (&optional annotation)
1641: ;; Set the fields of the mode line for a folder buffer.
1642: ;; The optional ANNOTATION string is displayed after the folder's name.
1643: (save-excursion
1644: (mh-first-msg)
1645: (setq mh-first-msg-num (mh-get-msg-num nil))
1646: (mh-last-msg)
1647: (setq mh-last-msg-num (mh-get-msg-num nil))
1648: (let ((lines (count-lines (point-min) (point-max))))
1649: (setq mode-line-buffer-identification
1650: (list (format "{%%b%s} %d msg%s"
1651: (if annotation (format "/%s" annotation) "")
1652: lines
1653: (if (zerop lines)
1654: "s"
1655: (if (> lines 1)
1656: (format "s (%d-%d)" mh-first-msg-num
1657: mh-last-msg-num)
1658: (format " (%d)" mh-first-msg-num)))))))))
1659:
1660:
1661: (defun mh-unmark-all-headers (remove-all-flags)
1662: ;; Remove all '+' flags from the headers, and if called with a non-nil
1663: ;; argument, remove all 'D', '^' and '%' flags too.
1664: ;; Optimized for speed (i.e., no regular expressions).
1665: (save-excursion
1666: (let ((case-fold-search nil)
1667: (last-line (- (point-max) mh-cmd-note))
1668: char)
1669: (mh-first-msg)
1670: (while (<= (point) last-line)
1671: (forward-char mh-cmd-note)
1672: (setq char (following-char))
1673: (if (or (and remove-all-flags
1674: (or (eql char ?D)
1675: (eql char ?^)
1676: (eql char ?%)))
1677: (eql char ?+))
1678: (progn
1679: (delete-char 1)
1680: (insert " ")))
1681: (forward-line)))))
1682:
1683:
1684: (defun mh-goto-cur-msg ()
1685: ;; Position the cursor at the current message.
1686: (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1687: (cond ((and cur-msg
1688: (mh-goto-msg cur-msg t nil))
1689: (mh-notate nil ?+ mh-cmd-note)
1690: (mh-recenter 0)
1691: (mh-maybe-show cur-msg))
1692: (t
1693: (mh-last-msg)
1694: (message "No current message")))))
1695:
1696:
1697: (defun mh-pack-folder-1 (range)
1698: ;; Close and pack the current folder.
1699: (mh-process-or-undo-commands mh-current-folder)
1700: (message "Packing folder...")
1701: (mh-set-folder-modified-p t) ; lock folder while packing
1702: (save-excursion
1703: (mh-exec-cmd-quiet " *mh-temp*" "folder" mh-current-folder "-pack"))
1704: (mh-regenerate-headers range))
1705:
1706:
1707: (defun mh-process-or-undo-commands (folder)
1708: ;; If FOLDER has outstanding commands, then either process or discard them.
1709: (set-buffer folder)
1710: (if (mh-outstanding-commands-p)
1711: (if (or mh-do-not-confirm
1712: (y-or-n-p
1713: "Process outstanding deletes and refiles (or lose them)? "))
1714: (mh-process-commands folder)
1715: (mh-undo-folder))
1716: (mh-invalidate-show-buffer)))
1717:
1718:
1719: (defun mh-process-commands (folder)
1720: ;; Process outstanding commands for the folder FOLDER.
1721: (message "Processing deletes and refiles for %s..." folder)
1722: (set-buffer folder)
1723: (with-mh-folder-updating (nil)
1724: ;; Update the unseen sequence if it exists
1725: (if (and mh-seen-list (mh-seq-to-msgs mh-unseen-seq))
1726: (mh-undefine-sequence mh-unseen-seq mh-seen-list))
1727:
1728: ;; Then refile messages
1729: (mh-mapc
1730: (function
1731: (lambda (dest)
1732: (let ((msgs (mh-seq-to-msgs dest)))
1733: (mh-when msgs
1734: (apply 'mh-exec-cmd "refile"
1735: "-src" folder (symbol-name dest) msgs)
1736: (mh-delete-scan-msgs msgs)))))
1737: mh-refile-list)
1738:
1739: ;; Now delete messages
1740: (mh-when mh-delete-list
1741: (apply 'mh-exec-cmd "rmm" folder mh-delete-list)
1742: (mh-delete-scan-msgs mh-delete-list))
1743:
1744: ;; Don't need to remove sequences since delete and refile do so.
1745:
1746: ;; Mark cur message
1747: (if (> (buffer-size) 0)
1748: (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1749:
1750: (mh-invalidate-show-buffer)
1751:
1752: (setq mh-delete-list nil
1753: mh-refile-list nil
1754: mh-seq-list (mh-read-folder-sequences mh-current-folder nil)
1755: mh-seen-list nil)
1756: (mh-unmark-all-headers t)
1757: (mh-notate-user-sequences)
1758: (message "Processing deletes and refiles for %s...done" folder)))
1759:
1760:
1761: (defun mh-delete-scan-msgs (msgs)
1762: ;; Delete the scan listing lines for each of the msgs in the LIST.
1763: ;; Optimized for speed (i.e., no regular expressions).
1764: (setq msgs (sort msgs (function <))) ;okay to clobber msgs
1765: (save-excursion
1766: (mh-first-msg)
1767: (while (and msgs (< (point) (point-max)))
1768: (cond ((equal (mh-get-msg-num nil) (car msgs))
1769: (delete-region (point) (save-excursion (forward-line) (point)))
1770: (setq msgs (cdr msgs)))
1771: (t
1772: (forward-line))))))
1773:
1774:
1775: (defun mh-set-folder-modified-p (flag)
1776: "Mark current folder as modified or unmodified according to FLAG."
1777: (set-buffer-modified-p flag))
1778:
1779:
1780: (defun mh-outstanding-commands-p ()
1781: ;; Returns non-nil if there are outstanding deletes or refiles.
1782: (or mh-delete-list mh-refile-list))
1783:
1784:
1785:
1786: ;;; Mode for composing and sending a draft message.
1787:
1788: (defvar mh-sent-from-folder nil
1789: "Folder of msg associated with this letter.")
1790:
1791: (defvar mh-sent-from-msg nil
1792: "Number of msg associated with this letter.")
1793:
1794: (defvar mh-send-args nil
1795: "Extra arguments to pass to \"send\" command.")
1796:
1797: (defvar mh-annotate-char nil
1798: "Character to use to annotate mh-sent-from-msg.")
1799:
1800: (defvar mh-annotate-field nil
1801: "Field name for message annotation.")
1802:
1803: (defun mh-letter-mode ()
1804: "Mode for composing letters in mh-e.
1805: When you have finished composing, type \\[mh-send-letter] to send the letter.
1806:
1807: Variables controlling this mode (defaults in parentheses):
1808:
1809: mh-delete-yanked-msg-window (nil)
1810: If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
1811: the yanked message.
1812:
1813: mh-yank-from-start-of-msg (t)
1814: If non-nil, \\[mh-yank-cur-msg] will include the entire message.
1815: If `body', just yank the body (no header).
1816: If nil, only the portion of the message following the point will be yanked.
1817: If there is a region, this variable is ignored.
1818:
1819: Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are
1820: invoked with no args, if those values are non-nil.
1821:
1822: \\{mh-letter-mode-map}"
1823: (interactive)
1824: (kill-all-local-variables)
1825: (make-local-variable 'paragraph-start)
1826: (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
1827: (make-local-variable 'paragraph-separate)
1828: (setq paragraph-separate
1829: (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
1830: (make-local-variable 'mh-send-args)
1831: (make-local-variable 'mh-annotate-char)
1832: (make-local-variable 'mh-annotate-field)
1833: (make-local-variable 'mh-previous-window-config)
1834: (make-local-variable 'mh-sent-from-folder)
1835: (make-local-variable 'mh-sent-from-msg)
1836: (use-local-map mh-letter-mode-map)
1837: (setq major-mode 'mh-letter-mode)
1838: (mh-set-mode-name "mh-e letter")
1839: (set-syntax-table mh-letter-mode-syntax-table)
1840: (run-hooks 'text-mode-hook 'mh-letter-mode-hook)
1841: (mh-when auto-fill-hook
1842: (make-local-variable 'auto-fill-hook)
1843: (setq auto-fill-hook 'mh-auto-fill-for-letter)))
1844:
1845:
1846: (defun mh-auto-fill-for-letter ()
1847: ;; Auto-fill in letters treats the header specially by inserting a tab
1848: ;; before continuation line.
1849: (do-auto-fill)
1850: (if (mh-in-header-p)
1851: (save-excursion
1852: (beginning-of-line nil)
1853: (insert-char ?\t 1))))
1854:
1855:
1856: (defun mh-in-header-p ()
1857: ;; Return non-nil if the point is in the header of a draft message.
1858: (save-excursion
1859: (let ((cur-point (point)))
1860: (goto-char (dot-min))
1861: (re-search-forward "^--------" nil t)
1862: (< cur-point (point)))))
1863:
1864:
1865: (defun mh-to-field ()
1866: "Move point to the end of a specified header field.
1867: The field is indicated by the previous keystroke. Create the field if
1868: it does not exist. Set the mark to point before moving."
1869: (interactive)
1870: (expand-abbrev)
1871: (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices)))
1872: (case-fold-search t))
1873: (cond ((mh-position-on-field target t)
1874: (let ((eol (point)))
1875: (skip-chars-backward " \t")
1876: (delete-region (point) eol))
1877: (if (and (not (eq (logior last-input-char ?`) ?s))
1878: (save-excursion
1879: (backward-char 1)
1880: (not (looking-at "[:,]"))))
1881: (insert ", ")
1882: (insert " ")))
1883: (t
1884: (goto-char (dot-min))
1885: (re-search-forward "^To:")
1886: (forward-line 1)
1887: (while (looking-at "^[ \t]") (forward-line 1))
1888: (insert (format "%s \n" target))
1889: (backward-char 1)))))
1890:
1891:
1892: (defun mh-to-fcc ()
1893: "Insert an Fcc: field in the current message.
1894: Prompt for the field name with a completion list of the current folders."
1895: (interactive)
1896: (let ((last-input-char ?\C-f)
1897: (folder (mh-prompt-for-folder "Fcc" "" t)))
1898: (expand-abbrev)
1899: (save-excursion
1900: (mh-to-field)
1901: (insert (substring folder 1 nil)))))
1902:
1903:
1904: (defun mh-insert-signature ()
1905: "Insert the file ~/.signature at the current point."
1906: (interactive)
1907: (insert-file-contents "~/.signature")
1908: (set-buffer-modified-p (buffer-modified-p))) ; force mode line update
1909:
1910:
1911: (defun mh-check-whom ()
1912: "Verify recipients of the current letter."
1913: (interactive)
1914: (let ((file-name (buffer-file-name)))
1915: (set-buffer-modified-p t) ; Force writing of contents
1916: (save-buffer)
1917: (message "Checking recipients...")
1918: (switch-to-buffer-other-window "*Mail Recipients*")
1919: (bury-buffer (current-buffer))
1920: (erase-buffer)
1921: (mh-exec-cmd-output "whom" t file-name)
1922: (other-window -1)
1923: (message "Checking recipients...done")))
1924:
1925:
1926:
1927: ;;; Routines to make a search pattern and search for a message.
1928:
1929: (defvar mh-searching-folder nil "Folder this pick is searching.")
1930:
1931:
1932: (defun mh-make-pick-template ()
1933: ;; Initialize the current buffer with a template for a pick pattern.
1934: (erase-buffer)
1935: (kill-all-local-variables)
1936: (make-local-variable 'mh-searching-folder)
1937: (insert "From: \n"
1938: "To: \n"
1939: "Cc: \n"
1940: "Date: \n"
1941: "Subject: \n"
1942: "---------\n")
1943: (mh-letter-mode)
1944: (use-local-map mh-pick-mode-map)
1945: (goto-char (point-min))
1946: (end-of-line))
1947:
1948:
1949: (defun mh-do-pick-search ()
1950: "Find messages that match the qualifications in the current pattern buffer.
1951: Messages are searched for in the folder named in mh-searching-folder.
1952: Put messages found in a sequence named `search'."
1953: (interactive)
1954: (let ((pattern-buffer (buffer-name))
1955: (searching-buffer mh-searching-folder)
1956: (range)
1957: (pattern nil)
1958: (new-buffer nil))
1959: (save-excursion
1960: (cond ((get-buffer searching-buffer)
1961: (set-buffer searching-buffer)
1962: (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num)))
1963: (t
1964: (mh-make-folder searching-buffer)
1965: (setq range "all")
1966: (setq new-buffer t))))
1967: (message "Searching...")
1968: (goto-char (point-min))
1969: (while (setq pattern (mh-next-pick-field pattern-buffer))
1970: (setq msgs (mh-seq-from-command searching-buffer
1971: 'search
1972: (nconc (cons "pick" pattern)
1973: (list searching-buffer
1974: range
1975: "-sequence" "search"
1976: "-list"))))
1977: (setq range "search"))
1978: (message "Searching...done")
1979: (if new-buffer
1980: (mh-scan-folder searching-buffer msgs)
1981: (switch-to-buffer searching-buffer))
1982: (delete-other-windows)
1983: (mh-notate-seq 'search ?% (1+ mh-cmd-note))))
1984:
1985:
1986: (defun mh-next-pick-field (buffer)
1987: ;; Return the next piece of a pick argument that can be extracted from the
1988: ;; BUFFER. Returns nil if no pieces remain.
1989: (set-buffer buffer)
1990: (let ((case-fold-search t))
1991: (cond ((eobp)
1992: nil)
1993: ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
1994: (let* ((component
1995: (format "--%s"
1996: (downcase (buffer-substring (match-beginning 1)
1997: (match-end 1)))))
1998: (pat (buffer-substring (match-beginning 2) (match-end 2))))
1999: (forward-line 1)
2000: (list component pat)))
2001: ((re-search-forward "^-*$" nil t)
2002: (forward-char 1)
2003: (let ((body (buffer-substring (point) (point-max))))
2004: (if (and (> (length body) 0) (not (equal body "\n")))
2005: (list "-search" body)
2006: nil)))
2007: (t
2008: nil))))
2009:
2010:
2011:
2012: ;;; Routines to compose and send a letter.
2013:
2014: (defun mh-compose-and-send-mail (draft send-args
2015: sent-from-folder sent-from-msg
2016: to subject cc
2017: annotate-char annotate-field
2018: config)
2019: ;; Edit and compose a draft message in buffer DRAFT and send or save it.
2020: ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
2021: ;; nil if none exists.
2022: ;; SENT-FROM-MSG is the message number or sequence name or nil.
2023: ;; SEND-ARGS is an optional argument passed to the send command.
2024: ;; The TO, SUBJECT, and CC fields are passed to the
2025: ;; mh-compose-letter-function.
2026: ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
2027: ;; message. In that case, the ANNOTATE-FIELD is used to build a string
2028: ;; for mh-annotate-msg.
2029: ;; CONFIG is the window configuration to restore after sending the letter.
2030: (pop-to-buffer draft)
2031: (mh-letter-mode)
2032: (setq mh-sent-from-folder sent-from-folder)
2033: (setq mh-sent-from-msg sent-from-msg)
2034: (setq mh-send-args send-args)
2035: (setq mh-annotate-char annotate-char)
2036: (setq mh-annotate-field annotate-field)
2037: (setq mh-previous-window-config config)
2038: (setq mode-line-buffer-identification (list "{%b}"))
2039: (if (and (boundp 'mh-compose-letter-function)
2040: (symbol-value 'mh-compose-letter-function))
2041: ;; run-hooks will not pass arguments.
2042: (let ((value (symbol-value 'mh-compose-letter-function)))
2043: (if (and (listp value) (not (eq (car value) 'lambda)))
2044: (while value
2045: (funcall (car value) to subject cc)
2046: (setq value (cdr value)))
2047: (funcall mh-compose-letter-function to subject cc)))))
2048:
2049:
2050: (defun mh-send-letter (&optional arg)
2051: "Send the draft letter in the current buffer.
2052: If optional prefix argument is provided, monitor delivery.
2053: Run mh-before-send-letter-hook before doing anything."
2054: (interactive "P")
2055: (run-hooks 'mh-before-send-letter-hook)
2056: (set-buffer-modified-p t) ; Make sure buffer is written
2057: (save-buffer)
2058: (message "Sending...")
2059: (let ((draft-buffer (current-buffer))
2060: (file-name (buffer-file-name))
2061: (config mh-previous-window-config))
2062: (cond (arg
2063: (pop-to-buffer "MH mail delivery")
2064: (erase-buffer)
2065: (if mh-send-args
2066: (mh-exec-cmd-output "send" t "-watch" "-nopush"
2067: "-nodraftfolder" mh-send-args file-name)
2068: (mh-exec-cmd-output "send" t "-watch" "-nopush"
2069: "-nodraftfolder" file-name))
2070: (goto-char (point-max)) ; show the interesting part
2071: (recenter -1)
2072: (set-buffer draft-buffer)) ; for annotation below
2073: (mh-send-args
2074: (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose"
2075: mh-send-args file-name))
2076: (t
2077: (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose"
2078: file-name)))
2079:
2080: (if mh-annotate-char
2081: (mh-annotate-msg mh-sent-from-msg
2082: mh-sent-from-folder
2083: mh-annotate-char
2084: "-component" mh-annotate-field
2085: "-text" (format "\"%s %s\""
2086: (mh-get-field "To:")
2087: (mh-get-field "Cc:"))))
2088:
2089: (mh-when (or (not arg)
2090: (y-or-n-p "Kill draft buffer? "))
2091: (kill-buffer draft-buffer)
2092: (if config
2093: (set-window-configuration config)))
2094: (message "Sending...done")))
2095:
2096:
2097: (defun mh-insert-letter (prefix-provided folder msg)
2098: "Insert a message from any folder into the current letter.
2099: Removes the message's headers using mh-invisible-headers.
2100: Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \").
2101: If optional prefix argument provided, do not indent and do not delete
2102: headers. Leaves the mark before the letter and point after it."
2103: (interactive
2104: (list current-prefix-arg
2105: (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
2106: (read-input (format "Message number%s: "
2107: (if mh-sent-from-msg
2108: (format " [%d]" mh-sent-from-msg)
2109: "")))))
2110: (save-restriction
2111: (narrow-to-region (point) (point))
2112: (let ((start (point-min)))
2113: (if (equal msg "") (setq msg (int-to-string mh-sent-from-msg)))
2114: (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
2115: (expand-file-name msg
2116: (mh-expand-file-name folder)))
2117: (mh-when (not prefix-provided)
2118: (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
2119: (set-mark start) ; since mh-clean-msg-header moves it
2120: (mh-insert-prefix-string mh-ins-buf-prefix)))))
2121:
2122:
2123: (defun mh-yank-cur-msg ()
2124: "Insert the current message into the draft buffer.
2125: Prefix each non-blank line in the message with the string in
2126: `mh-ins-buf-prefix'. If a region is set in the message's buffer, then
2127: only the region will be inserted. Otherwise, the entire message will
2128: be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
2129: is nil, the portion of the message following the point will be yanked.
2130: If `mh-delete-yanked-msg-window' is non-nil, any window displaying the
2131: yanked message will be deleted."
2132: (interactive)
2133: (if (and mh-sent-from-folder mh-sent-from-msg)
2134: (let ((to-point (point))
2135: (to-buffer (current-buffer)))
2136: (set-buffer mh-sent-from-folder)
2137: (if mh-delete-yanked-msg-window
2138: (delete-windows-on mh-show-buffer))
2139: (set-buffer mh-show-buffer) ; Find displayed message
2140: (let ((mh-ins-str (cond ((mark)
2141: (buffer-substring (region-beginning)
2142: (region-end)))
2143: ((eq 'body mh-yank-from-start-of-msg)
2144: (buffer-substring
2145: (save-excursion
2146: (goto-char (point-min))
2147: (mh-goto-header-end 1)
2148: (point))
2149: (point-max)))
2150: (mh-yank-from-start-of-msg
2151: (buffer-substring (point-min) (point-max)))
2152: (t
2153: (buffer-substring (point) (point-max))))))
2154: (set-buffer to-buffer)
2155: (narrow-to-region to-point to-point)
2156: (push-mark)
2157: (insert mh-ins-str)
2158: (mh-insert-prefix-string mh-ins-buf-prefix)
2159: (insert "\n")
2160: (widen)))
2161: (error "There is no current message")))
2162:
2163:
2164: (defun mh-insert-prefix-string (mh-ins-string)
2165: ;; Run MH-YANK-HOOK to insert a prefix string before each line in the buffer.
2166: ;; Generality for supercite users.
2167: (save-excursion
2168: (set-mark (point-max))
2169: (goto-char (point-min))
2170: (run-hooks 'mh-yank-hooks)))
2171:
2172:
2173: (defun mh-fully-kill-draft ()
2174: "Kill the draft message file and the draft message buffer.
2175: Use \\[kill-buffer] if you don't want to delete the draft message file."
2176: (interactive)
2177: (if (y-or-n-p "Kill draft message? ")
2178: (let ((config mh-previous-window-config))
2179: (if (file-exists-p (buffer-file-name))
2180: (delete-file (buffer-file-name)))
2181: (set-buffer-modified-p nil)
2182: (kill-buffer (buffer-name))
2183: (message "")
2184: (if config
2185: (set-window-configuration config)))
2186: (error "Message not killed")))
2187:
2188:
2189: (defun mh-recenter (arg)
2190: ;; Like recenter but with two improvements: nil arg means recenter,
2191: ;; and only does anything if the current buffer is in the selected
2192: ;; window. (Commands like save-some-buffers can make this false.)
2193: (if (eql (get-buffer-window (current-buffer))
2194: (selected-window))
2195: (recenter (if arg arg '(t)))))
2196:
2197:
2198:
2199: ;;; Commands to manipulate sequences. Sequences are stored in an alist
2200: ;;; of the form:
2201: ;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
2202:
2203: (defun mh-make-seq (name msgs) (cons name msgs))
2204:
2205: (defmacro mh-seq-name (pair) (list 'car pair))
2206:
2207: (defmacro mh-seq-msgs (pair) (list 'cdr pair))
2208:
2209: (defun mh-find-seq (name) (assoc name mh-seq-list))
2210:
2211:
2212: (defun mh-seq-to-msgs (seq)
2213: "Return a list of the messages in SEQUENCE."
2214: (mh-seq-msgs (mh-find-seq seq)))
2215:
2216:
2217: (defun mh-seq-containing-msg (msg)
2218: ;; Return a list of the sequences containing MESSAGE.
2219: (let ((l mh-seq-list)
2220: (seqs ()))
2221: (while l
2222: (if (memq msg (mh-seq-msgs (car l)))
2223: (mh-push (mh-seq-name (car l)) seqs))
2224: (setq l (cdr l)))
2225: seqs))
2226:
2227:
2228: (defun mh-msg-to-seq (msg)
2229: ;; Given a MESSAGE number, return the first sequence in which it occurs.
2230: (car (mh-seq-containing-msg msg)))
2231:
2232:
2233: (defun mh-read-seq-default (prompt not-empty)
2234: ;; Read and return sequence name with default narrowed or previous sequence.
2235: (mh-read-seq prompt not-empty (or mh-narrowed-to-seq mh-previous-seq)))
2236:
2237:
2238: (defun mh-read-seq (prompt not-empty &optional default)
2239: ;; Read and return a sequence name. Prompt with PROMPT, raise an error
2240: ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
2241: ;; an optional DEFAULT sequence.
2242: ;; A reply of '%' defaults to the first sequence containing the current
2243: ;; message.
2244: (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
2245: (if default
2246: (format "[%s] " default)
2247: ""))
2248: (mh-seq-names mh-seq-list)))
2249: (seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t)))
2250: ((equal input "") default)
2251: (t (intern input))))
2252: (msgs (mh-seq-to-msgs seq)))
2253: (if (and (null msgs) not-empty)
2254: (error (format "No messages in sequence `%s'" seq)))
2255: seq))
2256:
2257:
2258: (defun mh-read-folder-sequences (folder define-sequences)
2259: ;; Read and return the predefined sequences for a FOLDER. If
2260: ;; DEFINE-SEQUENCES is non-nil, then define mh-e's sequences before
2261: ;; reading MH's sequences.
2262: (let ((seqs ()))
2263: (mh-when define-sequences
2264: (mh-define-sequences mh-seq-list)
2265: (mh-mapc (function (lambda (seq) ; Save the internal sequences
2266: (if (mh-folder-name-p (mh-seq-name seq))
2267: (mh-push seq seqs))))
2268: mh-seq-list))
2269: (save-excursion
2270: (mh-exec-cmd-quiet " *mh-temp*" "mark" folder "-list")
2271: (goto-char (point-min))
2272: ;; look for name in line of form "cur: 4" or "myseq (private): 23"
2273: (while (re-search-forward "^[^: ]+" nil t)
2274: (mh-push (mh-make-seq (intern (buffer-substring (match-beginning 0)
2275: (match-end 0)))
2276: (mh-read-msg-list))
2277: seqs))
2278: (delete-region (point-min) (point))) ; avoid race with mh-process-daemon
2279: seqs))
2280:
2281:
2282: (defun mh-seq-names (seq-list)
2283: ;; Return an alist containing the names of the SEQUENCES.
2284: (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
2285: seq-list))
2286:
2287:
2288: (defun mh-seq-from-command (folder seq seq-command)
2289: ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
2290: ;; COMMAND is a list. The first element is a program name
2291: ;; and the subsequent elements are its arguments, all strings.
2292: (let ((msg)
2293: (msgs ())
2294: (case-fold-search t))
2295: (save-excursion
2296: (save-window-excursion
2297: (apply 'mh-exec-cmd-quiet " *mh-temp*" seq-command)
2298: (goto-char (point-min))
2299: (while (setq msg (car (mh-read-msg-list)))
2300: (mh-push msg msgs)
2301: (forward-line 1)))
2302: (set-buffer folder)
2303: (setq msgs (nreverse msgs)) ; Put in ascending order
2304: (mh-push (mh-make-seq seq msgs) mh-seq-list)
2305: msgs)))
2306:
2307:
2308: (defun mh-read-msg-list ()
2309: ;; Return a list of message numbers from the current point to the end of
2310: ;; the line.
2311: (let ((msgs ())
2312: (end-of-line (save-excursion (end-of-line) (point)))
2313: num)
2314: (while (re-search-forward "[0-9]+" end-of-line t)
2315: (setq num (string-to-int (buffer-substring (match-beginning 0)
2316: (match-end 0))))
2317: (cond ((looking-at "-") ; Message range
2318: (forward-char 1)
2319: (re-search-forward "[0-9]+" end-of-line t)
2320: (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
2321: (match-end 0)))))
2322: (if (< num2 num)
2323: (error "Bad message range: %d-%d" num num2))
2324: (while (<= num num2)
2325: (mh-push num msgs)
2326: (setq num (1+ num)))))
2327: ((not (zerop num)) (mh-push num msgs))))
2328: msgs))
2329:
2330:
2331: (defun mh-remove-seq (seq)
2332: ;; Delete the SEQUENCE.
2333: (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ? (1+ mh-cmd-note) seq)
2334: (mh-undefine-sequence seq (list "all"))
2335: (mh-delete-seq-locally seq))
2336:
2337:
2338: (defun mh-delete-seq-locally (seq)
2339: ;; Remove mh-e's record of SEQUENCE.
2340: (let ((entry (mh-find-seq seq)))
2341: (setq mh-seq-list (delq entry mh-seq-list))))
2342:
2343:
2344: (defun mh-remove-msg-from-seq (msg seq &optional internal-flag)
2345: ;; Remove MESSAGE from the SEQUENCE. If optional FLAG is non-nil, do not
2346: ;; inform MH of the change.
2347: (let ((entry (mh-find-seq seq)))
2348: (mh-when entry
2349: (mh-notate-if-in-one-seq msg ? (1+ mh-cmd-note) (mh-seq-name entry))
2350: (if (not internal-flag)
2351: (mh-undefine-sequence seq (list msg)))
2352: (setcdr entry (delq msg (mh-seq-msgs entry))))))
2353:
2354:
2355: (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
2356: ;; Add MESSAGE(s) to the SEQUENCE. If optional FLAG is non-nil, do not mark
2357: ;; the message in the scan listing or inform MH of the addition.
2358: (let ((entry (mh-find-seq seq)))
2359: (if (and msgs (atom msgs)) (setq msgs (list msgs)))
2360: (if (null entry)
2361: (mh-push (mh-make-seq seq msgs) mh-seq-list)
2362: (if msgs (setcdr entry (append msgs (cdr entry)))))
2363: (mh-when (not internal-flag)
2364: (mh-add-to-sequence seq msgs)
2365: (mh-notate-seq seq ?% (1+ mh-cmd-note)))))
2366:
2367:
2368: (defun mh-rename-seq (seq new-name)
2369: "Rename a SEQUENCE to have a new NAME."
2370: (interactive "SOld sequence name: \nSNew name: ")
2371: (let ((old-seq (mh-find-seq seq)))
2372: (if old-seq
2373: (rplaca old-seq new-name)
2374: (error "Sequence %s does not exists" seq))
2375: (mh-undefine-sequence seq (mh-seq-msgs old-seq))
2376: (mh-define-sequence new-name (mh-seq-msgs old-seq))))
2377:
2378:
2379: (defun mh-notate-user-sequences ()
2380: ;; Mark the scan listing of all messages in user-defined sequences.
2381: (let ((seqs mh-seq-list)
2382: name)
2383: (while seqs
2384: (setq name (mh-seq-name (car seqs)))
2385: (if (not (mh-internal-seq name))
2386: (mh-notate-seq name ?% (1+ mh-cmd-note)))
2387: (setq seqs (cdr seqs)))))
2388:
2389:
2390: (defun mh-internal-seq (name)
2391: ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
2392: (or (memq name '(answered cur deleted forwarded printed))
2393: (eq name mh-unseen-seq)
2394: (mh-folder-name-p name)))
2395:
2396:
2397: (defun mh-folder-name-p (name)
2398: ;; Return non-NIL if NAME is possibly the name of a folder.
2399: ;; A name (a string or symbol) can be a folder name if it begins with "+".
2400: (if (symbolp name)
2401: (eql (aref (symbol-name name) 0) ?+)
2402: (eql (aref name 0) ?+)))
2403:
2404:
2405: (defun mh-notate-seq (seq notation offset)
2406: ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
2407: ;; at the given OFFSET from the beginning of the listing line.
2408: (mh-map-to-seq-msgs 'mh-notate seq notation offset))
2409:
2410:
2411: (defun mh-notate-if-in-one-seq (msg notation offset seq)
2412: ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
2413: ;; message with the CHARACTER at the given OFFSET from the beginning of the
2414: ;; listing line.
2415: (let ((in-seqs (mh-seq-containing-msg msg)))
2416: (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
2417: (mh-notate msg notation offset))))
2418:
2419:
2420: (defun mh-map-to-seq-msgs (func seq &rest args)
2421: ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
2422: ;; remaining ARGS as arguments.
2423: (save-excursion
2424: (let ((msgs (mh-seq-to-msgs seq)))
2425: (while msgs
2426: (if (mh-goto-msg (car msgs) t t)
2427: (apply func (car msgs) args))
2428: (setq msgs (cdr msgs))))))
2429:
2430:
2431: (defun mh-map-over-seqs (func seq-list)
2432: ;; Apply the FUNCTION to each element in the list of SEQUENCES,
2433: ;; passing the sequence name and the list of messages as arguments.
2434: (while seq-list
2435: (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
2436: (setq seq-list (cdr seq-list))))
2437:
2438:
2439: (defun mh-define-sequences (seq-list)
2440: ;; Define the sequences in SEQ-LIST.
2441: (mh-map-over-seqs 'mh-define-sequence seq-list))
2442:
2443:
2444: (defun mh-add-to-sequence (seq msgs)
2445: ;; Add to a SEQUENCE each message the list of MSGS.
2446: (if (not (mh-folder-name-p seq))
2447: (if msgs
2448: (apply 'mh-exec-cmd "mark" mh-current-folder
2449: "-sequence" (symbol-name seq)
2450: "-add" msgs))))
2451:
2452:
2453: (defun mh-define-sequence (seq msgs)
2454: ;; Define the SEQUENCE to contain the list of MSGS. Do not mark
2455: ;; pseudo-sequences or empty sequences.
2456: (if (and msgs
2457: (not (mh-folder-name-p seq)))
2458: (save-excursion
2459: (apply 'mh-exec-cmd "mark" mh-current-folder
2460: "-sequence" (symbol-name seq)
2461: "-add" "-zero" (mh-list-to-string msgs)))))
2462:
2463:
2464: (defun mh-undefine-sequence (seq msgs)
2465: ;; Remove from the SEQUENCE the list of MSGS.
2466: (apply 'mh-exec-cmd "mark" mh-current-folder
2467: "-sequence" (symbol-name seq)
2468: "-delete" msgs))
2469:
2470:
2471: (defun mh-copy-seq-to-point (seq location)
2472: ;; Copy the scan listing of the messages in SEQUENCE to after the point
2473: ;; LOCATION in the current buffer.
2474: (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
2475:
2476:
2477: (defun mh-copy-line-to-point (msg location)
2478: ;; Copy the current line to the LOCATION in the current buffer.
2479: (beginning-of-line)
2480: (let ((beginning-of-line (point)))
2481: (forward-line 1)
2482: (copy-region-as-kill beginning-of-line (point))
2483: (goto-char location)
2484: (yank)
2485: (goto-char beginning-of-line)))
2486:
2487:
2488:
2489: ;;; Issue commands to MH.
2490:
2491: (defun mh-exec-cmd (command &rest args)
2492: ;; Execute MH command COMMAND with ARGS.
2493: ;; Any output is assumed to be an error and is shown to the user.
2494: (save-excursion
2495: (set-buffer " *mh-temp*")
2496: (erase-buffer)
2497: (apply 'call-process
2498: (expand-file-name command mh-progs) nil t nil
2499: (mh-list-to-string args))
2500: (if (> (buffer-size) 0)
2501: (save-window-excursion
2502: (switch-to-buffer-other-window " *mh-temp*")
2503: (sit-for 5)))))
2504:
2505:
2506: (defun mh-exec-cmd-quiet (buffer command &rest args)
2507: ;; In BUFFER, execute MH command COMMAND with ARGS.
2508: ;; ARGS is a list of strings. Return in BUFFER, if one exists.
2509: (mh-when (stringp buffer)
2510: (set-buffer buffer)
2511: (erase-buffer))
2512: (apply 'call-process
2513: (expand-file-name command mh-progs) nil buffer nil
2514: args))
2515:
2516:
2517: (defun mh-exec-cmd-output (command display &rest args)
2518: ;; Execute MH command COMMAND with DISPLAY flag and ARGS putting the output
2519: ;; into buffer after point. Set mark after inserted text.
2520: (push-mark (point) t)
2521: (apply 'call-process
2522: (expand-file-name command mh-progs) nil t display
2523: (mh-list-to-string args))
2524: (exchange-point-and-mark))
2525:
2526:
2527: (defun mh-exec-cmd-daemon (command &rest args)
2528: ;; Execute MH command COMMAND with ARGS. Any output from command is
2529: ;; displayed in an asynchronous pop-up window.
2530: (save-excursion
2531: (set-buffer (get-buffer-create " *mh-temp*"))
2532: (erase-buffer))
2533: (let* ((process-connection-type nil)
2534: (process (apply 'start-process
2535: command nil
2536: (expand-file-name command mh-progs)
2537: (mh-list-to-string args))))
2538: (set-process-filter process 'mh-process-daemon)))
2539:
2540:
2541: (defun mh-process-daemon (process output)
2542: ;; Process daemon that puts output into a temporary buffer.
2543: (set-buffer (get-buffer-create " *mh-temp*"))
2544: (insert-before-markers output)
2545: (display-buffer " *mh-temp*"))
2546:
2547:
2548: (defun mh-exec-lib-cmd-output (command &rest args)
2549: ;; Execute MH library command COMMAND with ARGS.
2550: ;; Put the output into buffer after point. Set mark after inserted text.
2551: (push-mark (point) t)
2552: (apply 'call-process
2553: (expand-file-name command mh-lib) nil t nil
2554: (mh-list-to-string args))
2555: (exchange-point-and-mark))
2556:
2557:
2558: (defun mh-list-to-string (l)
2559: ;; Flattens the list L and makes every element of the new list into a string.
2560: (let ((new-list nil))
2561: (while l
2562: (cond ((null (car l)))
2563: ((symbolp (car l)) (mh-push (symbol-name (car l)) new-list))
2564: ((numberp (car l)) (mh-push (int-to-string (car l)) new-list))
2565: ((equal (car l) ""))
2566: ((stringp (car l)) (mh-push (car l) new-list))
2567: ((listp (car l))
2568: (setq new-list (nconc (nreverse (mh-list-to-string (car l)))
2569: new-list)))
2570: (t (error "Bad element in mh-list-to-string: %s" (car l))))
2571: (setq l (cdr l)))
2572: (nreverse new-list)))
2573:
2574:
2575:
2576: ;;; Commands to annotate a message.
2577:
2578: (defun mh-annotate-msg (msg buffer note &rest args)
2579: ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
2580: ;; the saved message with ARGS.
2581: (apply 'mh-exec-cmd "anno" buffer msg args)
2582: (save-excursion
2583: (cond ((get-buffer buffer) ; Buffer may be deleted
2584: (set-buffer buffer)
2585: (if (symbolp msg)
2586: (mh-notate-seq msg note (1+ mh-cmd-note))
2587: (mh-notate msg note (1+ mh-cmd-note)))))))
2588:
2589:
2590: (defun mh-notate (msg notation offset)
2591: ;; Marks MESSAGE with the character NOTATION at position OFFSET.
2592: ;; Null MESSAGE means the message that the cursor points to.
2593: (save-excursion
2594: (if (or (null msg)
2595: (mh-goto-msg msg t t))
2596: (with-mh-folder-updating (t)
2597: (beginning-of-line)
2598: (forward-char offset)
2599: (delete-char 1)
2600: (insert notation)))))
2601:
2602:
2603:
2604: ;;; User prompting commands.
2605:
2606: (defun mh-prompt-for-folder (prompt default can-create)
2607: ;; Prompt for a folder name with PROMPT. Returns the folder's name as a
2608: ;; string. DEFAULT is used if the folder exists and the user types return.
2609: ;; If the CAN-CREATE flag is t, then a non-existent folder is made.
2610: (let* ((prompt (format "%s folder%s" prompt
2611: (if (equal "" default)
2612: "? "
2613: (format " [%s]? " default))))
2614: name)
2615: (if (null mh-folder-list)
2616: (mh-set-folder-list))
2617: (while (and (setq name (completing-read prompt mh-folder-list
2618: nil nil "+"))
2619: (equal name "")
2620: (equal default "")))
2621: (cond ((or (equal name "") (equal name "+"))
2622: (setq name default))
2623: ((not (mh-folder-name-p name))
2624: (setq name (format "+%s" name))))
2625: (let ((new-file-p (not (file-exists-p (mh-expand-file-name name)))))
2626: (cond ((and new-file-p
2627: (y-or-n-p
2628: (format "Folder %s does not exist. Create it? " name)))
2629: (message "Creating %s" name)
2630: (call-process "mkdir" nil nil nil (mh-expand-file-name name))
2631: (message "Creating %s...done" name)
2632: (mh-push (list name) mh-folder-list))
2633: (new-file-p
2634: (error "Folder %s is not created" name))
2635: (t
2636: (mh-when (null (assoc name mh-folder-list))
2637: (mh-push (list name) mh-folder-list)))))
2638: name))
2639:
2640:
2641: (defun mh-set-folder-list ()
2642: "Sets mh-folder-list correctly.
2643: A useful function for the command line or for when you need to sync by hand."
2644: (setq mh-folder-list (mh-make-folder-list)))
2645:
2646:
2647: (defun mh-make-folder-list ()
2648: "Return a list of the user's folders.
2649: Result is in a form suitable for completing read."
2650: (interactive)
2651: (message "Collecting folder names...")
2652: (save-window-excursion
2653: (mh-exec-cmd-quiet " *mh-temp*" "folders" "-fast"
2654: (if mh-recursive-folders
2655: "-recurse"
2656: "-norecurse"))
2657: (goto-char (point-min))
2658: (let ((list nil)
2659: start)
2660: (while (not (eobp))
2661: (setq start (point))
2662: (forward-line 1)
2663: (mh-push (list (format "+%s" (buffer-substring start (1- (point)))))
2664: list))
2665: (message "Collecting folder names...done")
2666: list)))
2667:
2668:
2669: (defun mh-remove-folder-from-folder-list (folder)
2670: ;; Remove FOLDER from the list of folders.
2671: (setq mh-folder-list
2672: (delq (assoc folder mh-folder-list) mh-folder-list)))
2673:
2674:
2675: (defun mh-read-msg-range (prompt)
2676: ;; Read a list of blank-separated items.
2677: (let* ((buf (read-string prompt))
2678: (buf-size (length buf))
2679: (start 0)
2680: (input ()))
2681: (while (< start buf-size)
2682: (let ((next (read-from-string buf start buf-size)))
2683: (mh-push (car next) input)
2684: (setq start (cdr next))))
2685: (nreverse input)))
2686:
2687:
2688:
2689: ;;; Misc. functions.
2690:
2691: (defun mh-get-msg-num (error-if-no-message)
2692: ;; Return the message number of the displayed message. If the argument
2693: ;; ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not
2694: ;; pointing to a message.
2695: (save-excursion
2696: (beginning-of-line)
2697: (cond ((looking-at mh-msg-number-regexp)
2698: (string-to-int (buffer-substring (match-beginning 1)
2699: (match-end 1))))
2700: (error-if-no-message
2701: (error "Cursor not pointing to message"))
2702: (t nil))))
2703:
2704:
2705: (defun mh-msg-search-pat (n)
2706: ;; Return a search pattern for message N in the scan listing.
2707: (format mh-msg-search-regexp n))
2708:
2709:
2710: (defun mh-msg-filename (msg &optional folder)
2711: ;; Return the file name of MESSAGE in FOLDER (default current folder).
2712: (expand-file-name (int-to-string msg)
2713: (if folder
2714: (mh-expand-file-name folder)
2715: mh-folder-filename)))
2716:
2717:
2718: (defun mh-msg-filenames (msgs &optional folder)
2719: ;; Return a list of file names for MSGS in FOLDER (default current folder).
2720: (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
2721:
2722:
2723: (defun mh-expand-file-name (filename &optional default)
2724: "Just like `expand-file-name', but also handles MH folder names.
2725: Assumes that any filename that starts with '+' is a folder name."
2726: (if (mh-folder-name-p filename)
2727: (expand-file-name (substring filename 1) mh-user-path)
2728: (expand-file-name filename default)))
2729:
2730:
2731: (defun mh-find-path ()
2732: ;; Set mh-user-path, mh-draft-folder, and mh-unseen-seq from profile file.
2733: (save-excursion
2734: ;; Be sure profile is fully expanded before switching buffers
2735: (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
2736: (if (not (file-exists-p profile))
2737: (error "Cannot find MH profile %s" profile))
2738: (set-buffer (get-buffer-create " *mh-temp*"))
2739: (erase-buffer)
2740: (insert-file-contents profile)
2741: (setq mh-draft-folder (mh-get-field "Draft-Folder:"))
2742: (cond ((equal mh-draft-folder "")
2743: (setq mh-draft-folder nil))
2744: ((not (mh-folder-name-p mh-draft-folder))
2745: (setq mh-draft-folder (format "+%s" mh-draft-folder))))
2746: (setq mh-user-path (mh-get-field "Path:"))
2747: (if (equal mh-user-path "")
2748: (setq mh-user-path "Mail"))
2749: (setq mh-user-path
2750: (file-name-as-directory
2751: (expand-file-name mh-user-path (expand-file-name "~"))))
2752: (if (and mh-draft-folder
2753: (not (file-exists-p (mh-expand-file-name mh-draft-folder))))
2754: (error "Draft folder %s does not exist. Create it and try again."
2755: mh-draft-folder))
2756: (setq mh-unseen-seq (mh-get-field "Unseen-Sequence:"))
2757: (if (equal mh-unseen-seq "")
2758: (setq mh-unseen-seq 'unseen)
2759: (setq mh-unseen-seq (intern mh-unseen-seq))))))
2760:
2761:
2762: (defun mh-get-field (field)
2763: ;; Find and return the value of field FIELD in the current buffer.
2764: ;; Returns the empty string if the field is not in the message.
2765: (let ((case-fold-search t))
2766: (goto-char (point-min))
2767: (cond ((not (re-search-forward (format "^%s" field) nil t)) "")
2768: ((looking-at "[\t ]*$") "")
2769: (t
2770: (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
2771: (let ((start (match-beginning 1)))
2772: (forward-line 1)
2773: (while (looking-at "[ \t]")
2774: (forward-line 1))
2775: (buffer-substring start (1- (point))))))))
2776:
2777:
2778: (defun mh-insert-fields (&rest name-values)
2779: ;; Insert the NAME-VALUE pairs in the current buffer.
2780: ;; Do not insert any pairs whose value is the empty string.
2781: (let ((case-fold-search t))
2782: (while name-values
2783: (let ((field-name (car name-values))
2784: (value (car (cdr name-values))))
2785: (mh-when (not (equal value ""))
2786: (goto-char (point-min))
2787: (cond ((not (re-search-forward (format "^%s" field-name) nil t))
2788: (mh-goto-header-end 0)
2789: (insert field-name " " value "\n"))
2790: (t
2791: (end-of-line)
2792: (insert " " value))))
2793: (setq name-values (cdr (cdr name-values)))))))
2794:
2795:
2796: (defun mh-position-on-field (field set-mark)
2797: ;; Set point to the end of the line beginning with FIELD.
2798: ;; Set the mark to the old value of point, if SET-MARK is non-nil.
2799: ;; Returns non-nil iff the field was found.
2800: (let ((case-fold-search t))
2801: (if set-mark (push-mark))
2802: (goto-char (point-min))
2803: (mh-goto-header-end 0)
2804: (if (re-search-backward (format "^%s" field) nil t)
2805: (progn (end-of-line) t)
2806: nil)))
2807:
2808:
2809: (defun mh-goto-header-end (arg)
2810: ;; Find the end of the message header in the current buffer and position
2811: ;; the cursor at the ARG'th newline after the header.
2812: (if (re-search-forward "^$\\|^-+$" nil nil)
2813: (forward-line arg)))
2814:
2815:
2816:
2817: ;;; Build the folder-mode keymap:
2818:
2819: (suppress-keymap mh-folder-mode-map)
2820: (define-key mh-folder-mode-map "q" 'mh-quit)
2821: (define-key mh-folder-mode-map "b" 'mh-quit)
2822: (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
2823: (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
2824: (define-key mh-folder-mode-map "|" 'mh-pipe-msg)
2825: (define-key mh-folder-mode-map "\ea" 'mh-edit-again)
2826: (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
2827: (define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq)
2828: (define-key mh-folder-mode-map "\C-xw" 'mh-widen)
2829: (define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
2830: (define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
2831: (define-key mh-folder-mode-map "\e " 'mh-page-digest)
2832: (define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
2833: (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
2834: (define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
2835: (define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
2836: (define-key mh-folder-mode-map "\el" 'mh-list-folders)
2837: (define-key mh-folder-mode-map "\eo" 'mh-write-msg-to-file)
2838: (define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
2839: (define-key mh-folder-mode-map "\es" 'mh-search-folder)
2840: (define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
2841: (define-key mh-folder-mode-map "l" 'mh-print-msg)
2842: (define-key mh-folder-mode-map "t" 'mh-toggle-showing)
2843: (define-key mh-folder-mode-map "c" 'mh-copy-msg)
2844: (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
2845: (define-key mh-folder-mode-map "i" 'mh-inc-folder)
2846: (define-key mh-folder-mode-map "x" 'mh-execute-commands)
2847: (define-key mh-folder-mode-map "e" 'mh-execute-commands)
2848: (define-key mh-folder-mode-map "r" 'mh-redistribute)
2849: (define-key mh-folder-mode-map "f" 'mh-forward)
2850: (define-key mh-folder-mode-map "s" 'mh-send)
2851: (define-key mh-folder-mode-map "m" 'mh-send)
2852: (define-key mh-folder-mode-map "a" 'mh-reply)
2853: (define-key mh-folder-mode-map "j" 'mh-goto-msg)
2854: (define-key mh-folder-mode-map "<" 'mh-first-msg)
2855: (define-key mh-folder-mode-map "g" 'mh-goto-msg)
2856: (define-key mh-folder-mode-map "\177" 'mh-previous-page)
2857: (define-key mh-folder-mode-map " " 'mh-page-msg)
2858: (define-key mh-folder-mode-map "." 'mh-show)
2859: (define-key mh-folder-mode-map "u" 'mh-undo)
2860: (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
2861: (define-key mh-folder-mode-map "^" 'mh-refile-msg)
2862: (define-key mh-folder-mode-map "d" 'mh-delete-msg)
2863: (define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion)
2864: (define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
2865: (define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
2866: (define-key mh-folder-mode-map "o" 'mh-refile-msg)
2867:
2868:
2869: ;;; Build the letter-mode keymap:
2870:
2871: (define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field)
2872: (define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field)
2873: (define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc)
2874: (define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field)
2875: (define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field)
2876: (define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field)
2877: (define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field)
2878: (define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc)
2879: (define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field)
2880: (define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field)
2881: (define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft)
2882: (define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom)
2883: (define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter)
2884: (define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg)
2885: (define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature)
2886: (define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter)
2887:
2888:
2889: ;;; Build the pick-mode keymap:
2890:
2891: (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
2892: (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
2893: (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
2894: (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
2895: (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
2896: (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
2897: (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
2898: (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
2899: (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
2900: (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
2901: (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)
2902: (define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom)
2903:
2904:
2905:
2906: ;;; For Gnu Emacs.
2907: ;;; Local Variables: ***
2908: ;;; eval: (put 'mh-when 'lisp-indent-hook 1) ***
2909: ;;; eval: (put 'with-mh-folder-updating 'lisp-indent-hook 1) ***
2910: ;;; End: ***
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.