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