![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mh-e.ml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / mh-e|
Return to mh-e.ml CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / mh-e |
1.1 root 1: ;;; mh-e.el (Version: 3.1a for GNU Emacs Version 17)
2:
3: ;;; Copyright (C) James Larus ([email protected], ucbvax!larus), 1985
4: ;;; Please send suggestions and corrections to the above address.
5: ;;;
6: ;;; This file contains mh-e, a GNU Emacs front end to the MH mail system.
7:
8:
9: ;; GNU Emacs is distributed in the hope that it will be useful,
10: ;; but without any warranty. No author or distributor
11: ;; accepts responsibility to anyone for the consequences of using it
12: ;; or for whether it serves any particular purpose or works at all,
13: ;; unless he says so in writing.
14:
15: ;; Everyone is granted permission to copy, modify and redistribute
16: ;; GNU Emacs, but only under the conditions described in the
17: ;; document "GNU Emacs copying permission notice". An exact copy
18: ;; of the document is supposed to have been given to you along with
19: ;; GNU Emacs so that you can know how you may redistribute it all.
20: ;; It should be in a file named COPYING. Among other things, the
21: ;; copyright notice and this notice must be preserved on all copies.
22:
23:
24: ;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
25: ;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
26: ;;; Rewritten for GNU Emacs, James Larus 1985.
27:
28:
29: ;;; NB MH must have been compiled with the MHE compiler flag or several
30: ;;; features necessary to this program will be missing.
31:
32:
33:
34: ;;; Constants:
35:
36: ;;; Set for local environment:
37: ;;;* These are now in paths.el.
38: (defvar mh-progs "/usr/new/mh/" "Directory containing MH commands")
39: (defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library")
40:
41:
42: ;;; Mode hooks:
43:
44: (defvar mh-folder-mode-hook nil
45: "*Invoked in mh-folder-mode on a new folder.")
46: (defvar mh-letter-mode-hook nil
47: "*Invoked in mh-letter-mode on a new letter.")
48: (defvar mh-compose-letter-hook nil
49: "*Invoked in mh-compose-and-send-mail on an outgoing letter. It is passed
50: three arguments: TO recipients, SUBJECT, and CC recipients.")
51:
52:
53: ;;; Personal preferences:
54:
55: (defvar mh-auto-fill-letters t
56: "*Non-nil means invoke auto-fill-mode in draft messages.")
57: (defvar mh-clean-message-header nil
58: "*Non-nil means remove invisible header lines in messages.")
59: (defvar mh-use-mhl nil
60: "*Non-nil means use mhl to format messages.")
61: (defvar mh-lpr-command-format "lpr -p -J '%s'"
62: "*Format for Unix command line to print a message. The format should be
63: a unix command line, with the string \"%s\" where the folder and message
64: number should appear.")
65: (defvar mh-summary-height 4
66: "*Number of lines in summary window.")
67: (defvar mh-ins-buf-prefix ">> "
68: "*String to put before each non-blank line of the the current message
69: as it is inserted in an outgoing letter.")
70:
71:
72: ;;; Real constants:
73:
74: (defvar mh-cmd-note 4 "Offset to insert notation")
75: (defvar mh-invisible-headers
76: "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|\^Return-Path: \\|^In-Reply-To: \\|^Resent-"
77: "Regexp specifying headers that are not to be shown.")
78:
79:
80: ;;; Global variables:
81:
82: (defvar mh-user-path "" "User's mail folder.")
83: (defvar mh-last-destination nil "Destination of last "move" command.")
84: (defvar mh-folder-mode-map (make-sparse-keymap) "Keymap for MH folders.")
85: (defvar mh-letter-mode-map (make-sparse-keymap) "Keymap for composing mail.")
86: (defvar mh-pick-mode-map (make-sparse-keymap) "Keymap for searching folder.")
87: (defvar mh-folder-list nil "List of folder names for completion.")
88:
89: ;;; Macros:
90:
91: (defmacro push (v l)
92: (list 'setq l (list 'cons v l)))
93:
94: (defmacro caar (l)
95: (list 'car (list 'car l)))
96:
97: (defmacro cadr (l)
98: (list 'car (list 'cdr l)))
99:
100: (defmacro cdar (l)
101: (list 'cdr (list 'car l)))
102:
103: (defmacro cddr (l)
104: (list 'cdr (list 'cdr l)))
105:
106: (defmacro when (pred &rest body)
107: (list 'cond (cons pred body)))
108:
109:
110:
111: ;;; Entry points:
112:
113: (defun mh-rmail (&optional arg)
114: "Inc(orporate) new mail if optional ARG omitted, or scan a MH mail box
115: if arg is present. This front end uses the MH mail system, which uses
116: different conventions from the usual mail system."
117: (interactive "P")
118: (mh-find-path)
119: (if (null mh-folder-list)
120: (setq mh-folder-list (mh-make-folder-list)))
121: (cond (arg
122: (let ((folder (mh-get-folder-name "mh" "+inbox" t))
123: (range (read-string "Range [all]? ")))
124: (mh-scan-folder folder (if (equal range "") "all" range))
125: (delete-other-windows)))
126: (t
127: (mh-inc-folder))))
128:
129:
130: (defun mh-smail ()
131: "Send mail using the MH mail system."
132: (interactive)
133: (mh-find-path)
134: (call-interactively 'mh-send))
135:
136:
137:
138: ;;; User executable mh-e commands:
139:
140: (defun mh-answer (&optional arg)
141: "Answer a letter. If given an argument, then include the current message
142: in the reply."
143: (interactive "P")
144: (let ((msg-filename (mh-msg-filename))
145: (msg (mh-get-msg-num t))
146: (minibuffer-help-form "from => Sender\n to => Sender and primary recipients\n cc => Sender and all recipients")
147: (folder mh-current-folder))
148: (let ((reply-to (completing-read "Reply to whom: "
149: '(("from") ("to") ("cc"))
150: nil t)))
151: (message "Composing a reply...")
152: (cond ((or (equal reply-to "from") (equal reply-to ""))
153: (apply 'mh-exec-cmd
154: (nconc
155: (list "repl" "-build" mh-current-folder msg "-nocc" "all")
156: (if arg (list "-filter" "mhl.reply")))))
157: ((equal reply-to "to")
158: (apply 'mh-exec-cmd
159: (nconc
160: (list "repl" "-build" mh-current-folder msg "-cc" "to"
161: "-nocc" "me")
162: (if arg (list "-filter" "mhl.reply")))))
163: ((equal reply-to "cc")
164: (apply 'mh-exec-cmd
165: (nconc
166: (list "repl" "-build" mh-current-folder msg "-cc" "all")
167: (if arg (list "-filter" "mhl.reply"))))))
168:
169: (mh-read-draft)
170: (delete-other-windows)
171: (when (or (zerop (buffer-size))
172: (not (y-or-n-p "The file 'draft' exists. Use for reply? ")))
173: (erase-buffer)
174: (insert-file-contents (format "%sreply" mh-user-path))
175: (delete-file (format "%sreply" mh-user-path)))
176: (set-buffer-modified-p nil)
177:
178: (let ((to (mh-get-field "To:"))
179: (subject (mh-get-field "Subject:"))
180: (cc (mh-get-field "Cc:")))
181: (goto-char (point-min))
182: (re-search-forward "^$" (point-max) nil)
183: (when (not arg)
184: (switch-to-buffer-other-window "*message*")
185: (erase-buffer)
186: (if (file-exists-p msg-filename)
187: (insert-file-contents msg-filename)
188: (error "File %s does not exist" msg-filename))
189: (set-buffer-modified-p nil)
190: (goto-char (point-min))
191: (re-search-forward "^$\\|^-*$")
192: (recenter 0))
193: (message "Composing a reply...done")
194: (mh-compose-and-send-mail "" folder to subject cc "-" "Replied:")))))
195:
196:
197: (defun mh-copy-msg (&optional arg)
198: "Copy specified message(s) to another folder without deleting them."
199: (interactive "P")
200: (let ((msgs (if arg
201: (mh-seq-to-msgs (mh-read-seq "Copy"))
202: (mh-get-msg-num t))))
203: (mh-exec-cmd-no-wait "refile" msgs "-link" "-src"
204: mh-current-folder
205: (mh-get-folder-name "Copy to" "" t))
206: (if arg
207: (mh-notate-seq msgs ?C mh-cmd-note)
208: (mh-notate ?C mh-cmd-note))))
209:
210:
211: (defun mh-delete-msg (&optional arg)
212: "Marks the specified message(s) for later deletion."
213: (interactive "P")
214: (if arg
215: (mh-apply-to-seq (mh-read-seq "Delete") 'mh-delete-one-msg)
216: (mh-delete-one-msg))
217: (mh-next-message))
218:
219:
220: (defun mh-execute-commands ()
221: "Process outstanding delete and move commands."
222: (interactive)
223: (save-excursion
224: (mh-process-commands mh-current-folder))
225: (delete-other-windows)
226: (setq mh-summarize t)
227: (setq mode-name "Mh-Summary")
228: (setq mode-line-format (mh-make-mode-line)))
229:
230:
231: (defun mh-forward (to cc subject)
232: "Forward a letter."
233: (interactive "sTo: \nsCc: \nsSubject: ")
234: (let ((msg-filename (mh-msg-filename))
235: (msg (mh-get-msg-num t))
236: (folder mh-current-folder))
237: (cond ((or (not (file-exists-p (format "%sdraft" mh-user-path)))
238: (y-or-n-p "The file 'draft' exists. Discard it? "))
239: (mh-exec-cmd "forw" "-build" mh-current-folder msg)
240: (mh-read-draft)
241: (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc))
242: (t
243: (mh-read-draft)))
244:
245: (goto-char (point-min))
246: (delete-other-windows)
247: (mh-compose-and-send-mail "" folder to subject cc "F" "Forwarded-To:")))
248:
249:
250: (defun mh-goto (number &optional no-error-if-no-message)
251: "Position the cursor at message NUMBER. Do not signal an error if optional
252: ARG is t. Return non-nil if cursor is at message."
253: (interactive "nMessage number? ")
254: (let ((starting-place (point)))
255: (goto-char (point-min))
256: (cond ((not (re-search-forward (mh-msg-search-pat number) nil t))
257: (goto-char starting-place)
258: (if (not no-error-if-no-message) (error "No message %d " number))
259: nil)
260: (t
261: (beginning-of-line)
262: (mh-maybe-show)
263: t))))
264:
265:
266: (defun mh-inc-folder ()
267: "inc(orporate) new mail into inbox."
268: (interactive)
269: (switch-to-buffer-other-window "+inbox")
270: (if (or (not (boundp 'mh-current-folder)) (null mh-current-folder))
271: (mh-make-folder "+inbox"))
272: (if (mh-get-new-mail)
273: (mh-show)))
274:
275:
276: (defun mh-indicate-seq (&optional arg)
277: "Add the specified message(s) to a sequence."
278: (interactive "P")
279: (let ((new-seq (mh-letter-to-seq last-input-char))
280: (old-seq (if (looking-at "^[0-9a-z]")
281: (mh-letter-to-seq (char-after (point))))))
282: (if old-seq
283: (if arg
284: (mh-remove-seq old-seq)
285: (mh-remove-msg-from-seq (mh-get-msg-num t) old-seq)))
286: (if (and (not arg)
287: (or (not old-seq) (not (equal new-seq old-seq))))
288: (mh-add-msg-to-seq (mh-get-msg-num t) new-seq)))
289: (mh-next-message))
290:
291:
292: (defun mh-kill-folder ()
293: "Removes the current folder."
294: (interactive)
295: (if (yes-or-no-p (format "Remove folder %s? " mh-current-folder))
296: (let ((buffer mh-current-folder))
297: (switch-to-buffer-other-window " *mh-temp*")
298: (mh-exec-cmd "rmf" buffer)
299: (mh-remove-folder-from-folder-list buffer)
300: (message "Folder removed")
301: (kill-buffer buffer))
302: (message "Folder not removed")))
303:
304:
305: (defun mh-list-folders ()
306: "List mail folders."
307: (interactive)
308: (message "listing folders...")
309: (switch-to-buffer-other-window " *mh-temp*")
310: (erase-buffer)
311: (mh-exec-cmd-output "folders")
312: (goto-char (point-min))
313: (message "listing folders...done"))
314:
315:
316: (defun mh-move-msg (&optional arg)
317: "Move specified message(s) to another folder."
318: (interactive "P")
319: (setq mh-last-destination (mh-get-folder-name "Destination" "" t))
320: (if arg
321: (mh-apply-to-seq (mh-read-seq "Move") 'mh-move-one-msg)
322: (mh-move-one-msg))
323: (mh-next-message))
324:
325:
326: (defun mh-next-line (&optional arg)
327: "Move to next undeleted message in window and display body if summary
328: flag set."
329: (interactive "p")
330: (forward-line (if arg arg 1))
331: (setq mh-next-direction 'forward)
332: (cond ((re-search-forward "^....[^D^]" nil 0 arg)
333: (beginning-of-line)
334: (mh-maybe-show))
335: (t
336: (forward-line -1)
337: (message "No more messages"))))
338:
339:
340: (defun mh-renumber-folder ()
341: "Renumber messages in folder to be 1..N."
342: (interactive)
343: (message "packing buffer...")
344: (mh-pack-folder)
345: (mh-unmark-all-headers nil)
346: (mh-position-to-current)
347: (message "packing buffer...done"))
348:
349:
350: (defun mh-page-digest ()
351: "Advance displayed message to next digested message."
352: (interactive)
353: (save-excursion
354: (switch-to-buffer-other-window mh-show-buffer)
355: (move-to-window-line nil)
356: (let ((case-fold-search nil))
357: (when (not (search-forward "\nFrom:" nil t))
358: (other-window -1)
359: (error "No more messages")))
360: (recenter 0)
361: (other-window -1)))
362:
363:
364: (defun mh-page-msg (&optional arg)
365: (interactive "P")
366: (scroll-other-window arg))
367:
368:
369: (defun mh-previous-line (&optional arg)
370: "Move to previous message in window and display body if summary flag set."
371: (interactive "p")
372: (setq mh-next-direction 'backward)
373: (if (not (re-search-backward "^....[^D^]" nil 0 arg))
374: (message "Beginning of messages")
375: (mh-maybe-show)))
376:
377:
378: (defun mh-previous-page ()
379: "Page the displayed message backwards."
380: (interactive)
381: (save-excursion
382: (switch-to-buffer-other-window mh-show-buffer)
383: (scroll-down nil)
384: (other-window -1)))
385:
386:
387: (defun mh-print-msg (&optional arg)
388: "Print specified message(s) on a line printer."
389: (interactive "P")
390: (let ((msgs (if arg
391: (reverse (mh-seq-to-msgs (mh-read-seq "Print")))
392: (list (mh-get-msg-num t)))))
393: (message "printing message...")
394: (call-process "/bin/sh" nil 0 nil "-c"
395: (format "%smhl -nobell -clear %s | %s" mh-lib
396: (mh-msg-filenames msgs mh-folder-filename)
397: (format mh-lpr-command-format
398: (if arg
399: "Mail"
400: (format "%s/%d" mh-current-folder
401: (mh-get-msg-num t))))))
402: (message "printing message...done")))
403:
404:
405: (defun mh-rescan-folder (&optional arg)
406: "Optionally process commands in current folder and (re)scan it."
407: (interactive "P")
408: (if (and (or mh-delete-list mh-move-list)
409: (y-or-n-p "Process commands? "))
410: (mh-process-commands mh-current-folder))
411: (setq mh-next-direction 'forward)
412: (mh-scan-folder mh-current-folder
413: (if arg (read-string "Range [all]? ") "all")))
414:
415:
416: (defun mh-redistribute (to cc)
417: "Redistribute a letter."
418: (interactive "sTo: \nsCc: ")
419: (let ((msg-filename (mh-msg-filename))
420: (msg (mh-get-msg-num t))
421: (folder mh-current-folder))
422: (mh-read-draft)
423: (delete-other-windows)
424: (when (or (zerop (buffer-size))
425: (not (y-or-n-p
426: "The file 'draft' exists. Redistribute old version? ")))
427: (erase-buffer)
428: (insert-file-contents msg-filename)
429: (goto-char (point-min))
430: (insert "Resent-To: " to "\n")
431: (if (not (equal cc ""))
432: (insert "Resent-cc: " cc "\n")))
433: (mh-compose-and-send-mail "-dist" folder to (mh-get-field "Subject:") cc
434: "F" "Distributed-to:")))
435:
436:
437: (defun mh-re-move ()
438: "Move specified message to same folder as last move."
439: (interactive)
440: (if (null mh-last-destination)
441: (error "No previous move"))
442: (mh-move-one-msg)
443: (mh-next-message))
444:
445:
446: (defun mh-save-message (file)
447: "Append the current message to the end of a file."
448: (interactive "FSave message in file: ")
449: (let ((msg-filename (mh-msg-filename)))
450: (call-process "/bin/csh" nil 0 nil "-c"
451: (format "cat %s >> %s " msg-filename file))))
452:
453:
454: (defun mh-search-folder ()
455: "Search the current folder for messages matching a pattern."
456: (interactive)
457: (let ((folder mh-current-folder))
458: (switch-to-buffer-other-window "pick-pattern")
459: (if (or (zerop (buffer-size))
460: (not (y-or-n-p "Reuse pattern? ")))
461: (mh-make-pick-template)
462: (message ""))
463: (setq mh-searching-folder folder)))
464:
465:
466: (defun mh-send (to cc subject)
467: "Compose and send a letter."
468: (interactive "sTo: \nsCc: \nsSubject: ")
469: (let ((folder (if (boundp 'mh-current-folder) mh-current-folder)))
470: (message "Composing a message...")
471: (mh-read-draft)
472: (delete-other-windows)
473: (when (or (zerop (buffer-size))
474: (not (y-or-n-p "The file 'draft' exists. Use it? ")))
475: (erase-buffer)
476: (if (file-exists-p (format "%scomponents" mh-user-path))
477: (insert-file-contents (format "%scomponents" mh-user-path))
478: (if (file-exists-p (format "%scomponents" mh-lib))
479: (insert-file-contents (format "%scomponents" mh-lib))
480: (error "Can't find components")))
481: (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
482: (goto-char (point-max))
483: (message "Composing a message...done"))
484: (mh-compose-and-send-mail "" folder to subject cc)))
485:
486:
487: (defun mh-show ()
488: "Show message indicated by cursor in scan buffer."
489: (interactive)
490: (setq mh-summarize nil)
491: (setq mode-name "Mh-Show")
492: (let ((msgn (mh-get-msg-num t))
493: (msg-filename (mh-msg-filename))
494: (folder mh-current-folder))
495: (if (not (file-exists-p msg-filename))
496: (error "Message %d does not exist." msgn))
497: (switch-to-buffer mh-show-buffer)
498: (erase-buffer)
499: (if mh-use-mhl
500: (mh-exec-lib-cmd-output "mhl" "-nobell" msg-filename)
501: (insert-file-contents msg-filename))
502: (setq buffer-file-name msg-filename)
503: (goto-char (point-min))
504: (cond (mh-clean-message-header
505: (mh-clean-message-header (point-min))
506: (goto-char (point-min)))
507: (t
508: (let ((case-fold-search t))
509: (re-search-forward "^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
510: (beginning-of-line)
511: (recenter 0))))
512: (set-buffer-modified-p nil)
513: (setq mode-line-format
514: (concat "{%b} %[%p of " folder "/" msgn "%] %M"))
515: ;; These contortions are to force the summary line to be the top window.
516: (switch-to-buffer-other-window folder)
517: (delete-other-windows)
518: (switch-to-buffer-other-window mh-show-buffer)
519: (switch-to-buffer-other-window folder)
520: (shrink-window (- (window-height) mh-summary-height))
521: (recenter 1)
522: ;; Remove from unseen seq.
523: (mh-exec-cmd-no-wait "mark" mh-current-folder msgn "-seq" "unseen"
524: "-delete" "-nolist")))
525:
526:
527: (defun mh-sort-folder (&optional arg)
528: "Sort the messages in the current folder by date."
529: (interactive "P")
530: (mh-process-commands mh-current-folder)
531: (setq mh-next-direction 'forward)
532: (message "sorting folder...")
533: (mh-exec-cmd "sortm" mh-current-folder)
534: (message "sorting folder...done")
535: (mh-scan-folder mh-current-folder "all"))
536:
537:
538: (defun mh-summary ()
539: "Show a summary of mh-e commands."
540: (interactive)
541: (message
542: "Next Prev Go Del ^ ! Copy Undo . Toggle Ans Forw Redist Send List Execute")
543: (sit-for 5))
544:
545:
546: (defun mh-toggle-summarize ()
547: "Turn the summary mode of displaying messages on or off."
548: (interactive)
549: (setq mh-summarize (not mh-summarize))
550: (cond (mh-summarize
551: (delete-other-windows)
552: (setq mode-name "Mh-Summarize")
553: (recenter))
554: (t
555: (setq mode-name "Mh-Show")
556: (mh-show))))
557:
558:
559: (defun mh-undo (&optional arg)
560: "Undo the deletion or move of the specified message(s)."
561: (interactive "P")
562: (cond ((looking-at "^....D")
563: (let ((msgs (if arg (mh-read-seq "Undelete") (mh-get-msg-num t))))
564: (setq mh-delete-list (delq msgs mh-delete-list))
565: (if arg
566: (mh-notate-seq msgs ? mh-cmd-note)
567: (mh-notate ? mh-cmd-note))))
568:
569: ((looking-at "^....^")
570: (let ((msgs (if arg (mh-read-seq "Unmove") (mh-get-msg-num t))))
571: (mapcar
572: (function (lambda (move) (setcdr move (delq msgs (cdr move)))))
573: mh-move-list)
574: (if arg
575: (mh-notate-seq msgs ? mh-cmd-note)
576: (mh-notate ? mh-cmd-note))))
577:
578: (t nil)))
579:
580:
581: (defun mh-visit-folder (&optional arg)
582: "Visit a new folder."
583: (interactive "p")
584: (let ((folder (mh-get-folder-name "Visit" "" t))
585: (range (if arg (read-string "Range [all]? ") "all")))
586: (mh-scan-folder folder (if (equal range "") "all" range))
587: (delete-other-windows)))
588:
589:
590:
591: ;;; Support routines.
592:
593: (defun mh-delete-one-msg ()
594: "Delete the message pointed to by the cursor."
595: (if (looking-at "....^")
596: (error "Message %d already moved. Undo move before deleting."
597: (mh-get-msg-num t)))
598: (push (mh-get-msg-num t) mh-delete-list)
599: (mh-notate ?D mh-cmd-note))
600:
601:
602: (defun mh-move-one-msg ()
603: "Move the message pointed to by the cursor."
604: (if (looking-at "....D")
605: (error "Message %d is already deleted. Undo delete before moving."
606: (mh-get-msg-num nil))
607: (let ((others (assoc mh-last-destination mh-move-list))
608: (msg (mh-get-msg-num t)))
609: (if others
610: (setcdr others (cons msg (cdr others)))
611: (push (cons mh-last-destination (list msg)) mh-move-list))
612: (mh-notate ?^ mh-cmd-note))))
613:
614:
615: (defun mh-clean-message-header (start)
616: "Flush extraneous lines in a message header. The variable
617: mh-invisible-headers contains a regular expression specifying these lines."
618: (save-restriction
619: (goto-char start)
620: (search-forward "\n\n" nil t)
621: (narrow-to-region start (point))
622: (goto-char (point-min))
623: (while (re-search-forward mh-invisible-headers nil t)
624: (beginning-of-line)
625: (kill-line 1)
626: (while (looking-at "^[ \t]+")
627: (beginning-of-line)
628: (kill-line 1)))))
629:
630:
631: (defun mh-read-draft ()
632: "Read draft file into buffer draft. No errors if disk file has been
633: modified."
634: (switch-to-buffer "draft")
635: (set-buffer-modified-p nil)
636: (kill-buffer "draft")
637: (switch-to-buffer-other-window
638: (find-file-noselect (format "%sdraft" mh-user-path))))
639:
640:
641: (defun mh-next-message ()
642: "Move backward or forward to the next message in the buffer."
643: (if (eq mh-next-direction 'forward)
644: (mh-next-line 1)
645: (mh-previous-line 1)))
646:
647:
648: (defun mh-maybe-show ()
649: "If the scan listing is not summarized, show the message pointed to
650: by the cursor."
651: (if (not mh-summarize) (mh-show)))
652:
653:
654:
655: ;;; The folder data abstraction.
656:
657: (defun mh-make-folder (name)
658: "Create and initialize a new mail folder called NAME and make
659: it the current folder."
660: (switch-to-buffer name)
661: (kill-all-local-variables)
662: (setq buffer-read-only nil)
663: (erase-buffer)
664: (make-local-variable 'mh-current-folder) ; Name of folder
665: (setq mh-current-folder name)
666: (make-local-variable 'mh-show-buffer) ; Buffer that displays messages
667: (setq mh-show-buffer (format "show-%s" mh-current-folder))
668: (make-local-variable 'mh-folder-filename) ; e.g. /usr/foobar/Mail/inbox/
669: (setq mh-folder-filename (format "%s%s/" mh-user-path (substring name 1)))
670: (make-local-variable 'mh-summarize) ; Show scan list only?
671: (setq mh-summarize t)
672: (make-local-variable 'mh-next-seq-num) ; Index of free sequence id
673: (setq mh-next-seq-num 0)
674: (make-local-variable 'mh-delete-list) ; List of msgs nums to delete
675: (setq mh-delete-list nil)
676: (make-local-variable 'mh-move-list) ; Alist of dest . msgs nums
677: (setq mh-move-list nil)
678: (make-local-variable 'mh-seq-list) ; Alist of seq . msgs nums
679: (setq mh-seq-list nil)
680: (make-local-variable 'mh-next-direction) ; Direction to move to next message
681: (setq mh-next-direction 'forward)
682: (mh-folder-mode)
683: (setq buffer-read-only t)
684: (setq mode-name "Mh-Summarize"))
685:
686:
687: (defun mh-folder-mode ()
688: " \\[mh-next-line]: next message \\[mh-previous-line]: previous message
689: \\[mh-delete-msg]: delete (mark for deletion) \\[mh-move-msg]: put (mark for moving)
690: \\[mh-undo]: undo last delete or mark \\[mh-re-move]: repeat last ^ command
691: \\[mh-copy-msg]: copy message to another folder
692: \\[mh-show]: type message \\[mh-toggle-summarize]: toggle summarize mode
693: \\[mh-page-msg] page message \\[mh-previous-page]: page message backwards
694: \\[mh-print-msg]: print message \\[mh-goto]: goto a message
695: \\[mh-execute-commands]: execute pending delete and move commands
696: \\[mh-send]: send a message \\[mh-redistribute]: redistribute a message
697: \\[mh-answer]: answer a message \\[mh-forward]: forward a message
698: \\[mh-visit-folder]: visit folder \\[mh-inc-folder]: inc mail
699: \\[mh-kill-folder]: kill folder \\[mh-list-folders]: list folders
700: \\[mh-renumber-folder]: pack folder \\[mh-rescan-folder]: rescan folder
701: \\[mh-search-folder]: search folder \\[mh-sort-folder]: sorts the letters in the folder
702:
703: 0..9 Add a message to a numbered sequence
704:
705: A prefix argument to delete, move, list, or undo applies to a sequence.
706:
707: Edit the scan list, marking messages. Moving and deleting messages is
708: deferred until you type \\[mh-execute-commands]."
709: (use-local-map mh-folder-mode-map)
710: (setq major-mode 'mh-folder-mode)
711: (setq mode-name "mh-folder")
712: (if (and (boundp 'mh-folder-mode-hook) mh-folder-mode-hook)
713: (funcall mh-folder-mode-hook)))
714:
715:
716: (defun mh-scan-folder (folder range)
717: "Scan the folder FOLDER over the range RANGE. Return in the folder."
718: (if (null (get-buffer folder))
719: (mh-make-folder folder)
720: (switch-to-buffer-other-window folder))
721: (mh-regenerate-headers range)
722: (when (looking-at "scan: no messages ")
723: (let ((buffer-read-only nil))
724: (erase-buffer))
725: (if (equal range "all")
726: (message "Folder %s is empty" folder)
727: (message "No messages in %s, range %s" folder range))
728: (sit-for 5))
729: (setq mode-line-format (mh-make-mode-line))
730: (mh-unmark-all-headers nil)
731: (mh-position-to-current))
732:
733:
734: (defun mh-regenerate-headers (range)
735: "Replace buffer with scan of its contents over range RANGE."
736: (let ((buffer-read-only nil))
737: (message (format "scanning %s..." (buffer-name)))
738: (delete-other-windows)
739: (erase-buffer)
740: (mh-exec-cmd-output "scan" (buffer-name) range)
741: (goto-char (point-min))
742: (message (format "scanning %s...done" (buffer-name)))
743: ))
744:
745:
746: (defun mh-get-new-mail ()
747: "Read new mail into the current buffer. Return t if there was new mail,
748: nil otherwise. Return in the current buffer."
749: (let ((buffer-read-only nil))
750: (message (format "inc %s..." (buffer-name)))
751: (mh-unmark-all-headers nil)
752: (setq mh-next-direction 'forward)
753: (goto-char (point-max))
754: (let ((start-of-inc (point)))
755: (mh-exec-cmd-output "inc")
756: (message (format "inc %s...done" (buffer-name)))
757: (goto-char start-of-inc)
758: (cond ((looking-at "inc: no mail")
759: (kill-line 1)
760: (setq mode-line-format (mh-make-mode-line))
761: (previous-line 1)
762: (message "No new mail")
763: (sit-for 5)
764: nil)
765: (t
766: (kill-line 2)
767: (setq mode-line-format (mh-make-mode-line))
768: t)))))
769:
770:
771: (defun mh-make-mode-line ()
772: "Returns a string for mode-line-format."
773: (save-excursion
774: (let ((lines (count-lines (point-min) (point-max))))
775: (goto-char (point-min))
776: (let* ((first (mh-get-msg-num nil))
777: (case-fold-search nil)
778: (current (and (re-search-forward "....\\+" nil t)
779: (mh-get-msg-num nil))))
780: (goto-char (point-max))
781: (previous-line 1)
782: (let ((last (mh-get-msg-num nil)))
783: (concat "{%b} %[" lines " messages"
784: (if (> lines 0)
785: (format " (%d - %d)" first last)
786: "")
787: (if current
788: (format " cur = %d" current)
789: "")
790: "%] (%p%% - %m)"))))))
791:
792:
793: (defun mh-unmark-all-headers (remove-all-flags)
794: "This function removes all + flags from the headers, and if called
795: with a non-nil argument, removes all D and ^ flags too."
796: (let ((buffer-read-only nil)
797: (case-fold-search nil))
798: (goto-char (point-min))
799: (while (if remove-all-flags
800: (re-search-forward "^....\\D\\|^....\\^\\|^....\\+" nil t)
801: (re-search-forward "^....\\+" nil t))
802: (delete-backward-char 1)
803: (insert " "))))
804:
805:
806: (defun mh-position-to-current ()
807: "Position the cursor at the current message."
808: (let ((curmsg (mh-get-cur-msg mh-folder-filename)))
809: (cond ((or (zerop curmsg) (mh-goto curmsg t))
810: (goto-char (point-max))
811: (forward-line -1)
812: (mh-maybe-show)
813: (message "No current message"))
814: (t
815: (mh-notate ?+ 4)
816: (recenter 0)))))
817:
818:
819: (defun mh-pack-folder ()
820: "Closes and packs the current folder."
821: (let ((buffer-read-only nil))
822: (message "closing folder...")
823: (mh-process-commands mh-current-folder)
824: (message "packing folder...")
825: (mh-exec-cmd-quiet "folder" mh-current-folder "-pack")
826: (mh-regenerate-headers "all")
827: (message "packing done"))
828: (setq mode-line-format (mh-make-mode-line)))
829:
830:
831: (defun mh-apply-to-message-list (func list)
832: "Apply function FUNC to each item in a message-list LIST,
833: passing the name and list of messages as arguments."
834: (mapcar (function (lambda (l) (apply func (list (car l) (cdr l))))) list))
835:
836:
837: (defun mh-process-commands (buffer)
838: "Process outstanding commands for the buffer BUFFER."
839: (message "Processing deletes and moves...")
840: (switch-to-buffer buffer)
841: (let ((buffer-read-only nil))
842: ;; Sequences must be first
843: (mh-process-seq-commands mh-seq-list)
844:
845: ;; Then refile messages
846: (mh-apply-to-message-list
847: (function (lambda (dest msgs)
848: (apply 'mh-exec-cmd
849: (nconc (cons "refile" msgs)
850: (list "-src" (format "%s" buffer) dest)))))
851: mh-move-list)
852:
853: ;; Now delete messages
854: (if mh-delete-list
855: (apply 'mh-exec-cmd
856: (nconc (list "rmm" (format "%s" buffer)) mh-delete-list)))
857:
858: ;; Mark as cur message.
859: (if (mh-get-msg-num nil)
860: (mh-exec-cmd-no-wait "mark" mh-current-folder (mh-get-msg-num nil)
861: "-seq" "cur" "-add" "-zero" "-nolist")
862: (mh-exec-cmd-no-wait "mark" mh-current-folder "-seq" "cur" "-delete"
863: "all" "-nolist"))
864:
865: (switch-to-buffer buffer)
866: (goto-char (point-min))
867: (flush-lines "^....D")
868: (goto-char (point-min))
869: (flush-lines "^....^")
870: (setq mh-delete-list nil
871: mh-move-list nil
872: mh-seq-list nil))
873: (message "Processing deletes and moves...done"))
874:
875:
876:
877: ;;; A mode for composing and sending a message.
878:
879: (defun mh-letter-mode ()
880: "Mode for composing letters in mh-e.
881: Like text-mode, but with these additional commands:
882: \\[mh-send-letter]: sends the message.
883: \\[mh-insert-letter]: inserts a message into the current letter.
884: \\[mh-to-to]: move to the To: field \\[mh-to-subject]: move to the Subject: field
885: \\[mh-to-cc]: move to the Cc: field \\[mh-to-bcc]: move to the Bcc: field
886: \\[mh-to-fcc]: move to the Fcc: field
887: \\[mh-check-whom]: report who a message will go to
888: \\[kill-buffer]: quit draft and delete it."
889: (text-mode)
890: (if mh-auto-fill-letters
891: (auto-fill-mode 1))
892: (make-local-variable 'paragraph-start)
893: (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
894: (make-local-variable 'paragraph-separate)
895: (setq paragraph-separate
896: (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
897: (use-local-map mh-letter-mode-map)
898: (setq major-mode 'mh-letter-mode)
899: (setq mode-name "mh-letter")
900: (if (and (boundp 'mh-letter-mode-hook) mh-letter-mode-hook)
901: (funcall mh-letter-mode-hook)))
902:
903:
904: (defun mh-to-to ()
905: "Move point to end of To: field."
906: (interactive)
907: (expand-abbrev)
908: (mh-position-on-field "To:" t))
909:
910:
911: (defun mh-to-subject ()
912: "Move point to end of Subject: field."
913: (interactive)
914: (expand-abbrev)
915: (mh-position-on-field "Subject:" t))
916:
917:
918: (defun mh-to-cc ()
919: "Move point to end of Cc: field. Creates the field if necessary"
920: (interactive)
921: (expand-abbrev)
922: (when (not (mh-position-on-field "Cc:" t))
923: (mh-position-on-field "To:" nil)
924: (insert-string "\nCc: ")))
925:
926:
927: (defun mh-to-bcc ()
928: "Move point to end of Bcc: field. Creates the field if necessary"
929: (interactive)
930: (expand-abbrev)
931: (when (not (mh-position-on-field "Bcc:" t))
932: (mh-position-on-field "To:" nil)
933: (insert-string "\nBcc: ")))
934:
935:
936: (defun mh-to-fcc ()
937: "Move point to end of Fcc: field. Creates the field if necessary"
938: (interactive)
939: (expand-abbrev)
940: (when (not (mh-position-on-field "Fcc:" t))
941: (mh-position-on-field "To:" nil)
942: (insert-string "\nFcc: ")))
943:
944:
945: (defun mh-check-whom ()
946: "List recipients of the current message."
947: (interactive)
948: (let ((file-name (buffer-file-name)))
949: (save-buffer)
950: (message "Checking recipients...")
951: (switch-to-buffer-other-window "*Mail Recipients*")
952: (erase-buffer)
953: (mh-exec-cmd-output "whom" file-name)
954: (previous-window)))
955:
956:
957:
958: ;;; Routines to make a search pattern and search for a message.
959:
960: (defun mh-make-pick-template ()
961: "Initialize a buffer with a template for a pick pattern."
962: (erase-buffer)
963: (kill-all-local-variables)
964: (make-local-variable 'mh-searching-folder)
965: (insert "From: \n"
966: "To: \n"
967: "Cc: \n"
968: "Date: \n"
969: "Subject: \n"
970: "---------\n")
971: (mh-letter-mode)
972: (use-local-map mh-pick-mode-map)
973: (setq mode-line-format "{%b}\tPick Pattern\t(^C^C to do search)")
974: (goto-char (point-min))
975: (end-of-line))
976:
977:
978: (defun mh-do-pick-search ()
979: "Search for the messages in the current folder meeting the qualification
980: in the current buffer and make them into a sequence."
981: (interactive)
982: (let* ((pattern-buffer (buffer-name))
983: (searching-buffer mh-searching-folder)
984: (range "all")
985: (seq (mh-new-seq mh-searching-folder))
986: (pattern nil))
987: (message "Searching...")
988: (goto-char (point-min))
989: (while (setq pattern (mh-next-pick-field pattern-buffer))
990: (setq msgs
991: (mh-seq-from-command searching-buffer
992: seq
993: (nconc (cons "pick" pattern)
994: (list searching-buffer
995: range
996: "-sequence" seq "-list"))))
997: (setq range seq))
998: (message "Searching...done")
999: (switch-to-buffer searching-buffer)
1000: (mh-notate-seq seq (mh-seq-to-notation seq) 0)))
1001:
1002:
1003: (defun mh-next-pick-field (buffer)
1004: "Return the next piece of a pick argument that can be extracted from the
1005: BUFFER. Returns nil if no pieces remain."
1006: (switch-to-buffer buffer)
1007: (let ((case-fold-search t))
1008: (cond ((eobp)
1009: nil)
1010: ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
1011: (let* ((component
1012: (format "-%s"
1013: (downcase (buffer-substring (match-beginning 1)
1014: (match-end 1)))))
1015: (pat (buffer-substring (match-beginning 2) (match-end 2))))
1016: (forward-line 1)
1017: (list component pat)))
1018: ((re-search-forward "^-*$" nil t)
1019: (forward-char 1)
1020: (let ((body (buffer-substring (point) (point-max))))
1021: (if (and (> (length body) 0) (not (equal body "\n")))
1022: (list "-search" body)
1023: nil)))
1024: (t
1025: nil))))
1026:
1027:
1028:
1029: ;;; Routines compose and send a letter.
1030:
1031: (defun mh-compose-and-send-mail (send-args sent-from-folder to subject cc
1032: &optional annotate-char
1033: annotate-field)
1034: "Edit and compose a draft message and send or save it.
1035: SENT-FROM-FOLDER is buffer containing summary of current folder, if any.
1036: SEND-ARGS is an optional argument passed to the send command.
1037: The TO, SUBJECT, and CC fields are passed to the mh-compose-letter-hook.
1038: If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
1039: current message. In that case, the ANNOTATE-FIELD is used to build a string
1040: for mh-annotate-msg."
1041: (let ((sent-from-msg))
1042: (save-window-excursion
1043: (when sent-from-folder
1044: (switch-to-buffer sent-from-folder)
1045: (setq sent-from-msg (mh-get-msg-num nil))))
1046: (pop-to-buffer "draft")
1047: (mh-letter-mode)
1048: (make-local-variable 'mh-send-args)
1049: (setq mh-send-args send-args)
1050: (make-local-variable 'mh-sent-from-folder)
1051: (setq mh-sent-from-folder sent-from-folder)
1052: (make-local-variable 'mh-sent-from-msg)
1053: (setq mh-sent-from-msg sent-from-msg)
1054: (make-local-variable 'mh-annotate-field)
1055: (setq mh-annotate-field annotate-field)
1056: (make-local-variable 'mh-annotate-char)
1057: (setq mh-annotate-char annotate-char)
1058: (setq mode-line-format "{%b} %[Mail/draft%] (%p - %m) (^C^C to send) %M")
1059: (if (and (boundp 'mh-compose-letter-hook) mh-compose-letter-hook)
1060: (funcall mh-compose-letter-hook to subject cc))))
1061:
1062:
1063: (defun mh-send-letter ()
1064: "Send the letter in the current buffer."
1065: (interactive)
1066: (save-buffer)
1067: (message "Sending...")
1068: (if mh-send-args
1069: (mh-exec-cmd-no-wait "send" "-push" "-unique" mh-send-args
1070: (buffer-file-name))
1071: (mh-exec-cmd-no-wait "send" "-push" "-unique" (buffer-file-name)))
1072: (if mh-annotate-char
1073: (mh-annotate-msg mh-sent-from-msg mh-sent-from-folder
1074: mh-annotate-char
1075: "-component" mh-annotate-field
1076: "-text" (format "\"%s %s\"" (mh-get-field "To:")
1077: (mh-get-field "Cc:"))))
1078: (message "Sending...done")
1079: (kill-buffer (buffer-name)))
1080:
1081:
1082: (defun mh-insert-letter (&optional arg)
1083: "Insert a message in the current letter, asking for folder and number.
1084: Removes headers using mh-invisible-headers.
1085: Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \").
1086: Just \\[universal-argument] means do not indent and do not delete any
1087: header fields. Leaves point before the text and mark after it."
1088: (interactive "p")
1089: (let ((folder (mh-get-folder-name "Message from" mh-sent-from-folder nil))
1090: (message (read-input (format "Message number%s: "
1091: (if mh-sent-from-msg
1092: (format " [%d]" mh-sent-from-msg)
1093: ""))))
1094: (start (point)))
1095: (if (equal message "") (setq message (format "%d" mh-sent-from-msg)))
1096: (mh-exec-lib-cmd-output "mhl" "-nobell"
1097: (format "%s%s/%s" mh-user-path
1098: (substring folder 1) message))
1099: (when (not (equal arg 4))
1100: (mh-clean-message-header start)
1101: (narrow-to-region start (mark))
1102: (mh-insert-prefix-string mh-ins-buf-prefix)
1103: (widen))
1104: (exchange-point-and-mark)))
1105:
1106:
1107: (defun mh-insert-cur-message ()
1108: "Inserts the currently visible message into the current buffer.
1109: Prefixes the string mh-ins-buf-prefix to each non-blank line
1110: of the inserted text. If there is a region set in the
1111: currently visible message's buffer, only the region will be grabbed.
1112: Otherwise, the region from (point) to the end will be grabbed."
1113: (interactive)
1114: (let ((to-point (point))
1115: (to-buffer (current-buffer)))
1116: (set-buffer "*message*")
1117: (let ((mh-ins-str (if (mark)
1118: (buffer-substring (point) (mark))
1119: (buffer-substring (point) (point-max)))))
1120: (set-buffer to-buffer)
1121: (narrow-to-region to-point to-point)
1122: (insert-string mh-ins-str)
1123: (mh-insert-prefix-string mh-ins-buf-prefix)
1124: (widen))))
1125:
1126:
1127: (defun mh-insert-prefix-string (ins-string)
1128: "Preface each line in the current buffer with STRING."
1129: (goto-char (point-min))
1130: (replace-regexp "^.." (concat ins-string "\\&") nil)
1131: (goto-char (point-min)))
1132:
1133:
1134:
1135: ;;; Commands to manipulate sequences.
1136:
1137: (defmacro mh-seq-name (pair)
1138: (list 'car pair))
1139:
1140: (defmacro mh-seq-msgs (pair)
1141: (list 'cdr pair))
1142:
1143:
1144: (defun mh-seq-to-msgs (seq)
1145: "Returns the list of messages in sequence SEQ."
1146: (mh-seq-msgs (assoc seq mh-seq-list)))
1147:
1148:
1149: (defun mh-read-seq (prompt)
1150: "Prompt the user with PROMPT and read a sequence name."
1151: (mh-letter-to-seq
1152: (string-to-char (read-string (format "%s %s" prompt "sequence: ")))))
1153:
1154:
1155: (defun mh-seq-from-command (folder seq command)
1156: "In FOLDER, make a sequence named SEQ by executing COMMAND."
1157: (let ((msgs ())
1158: (case-fold-search t))
1159: (save-excursion
1160: (save-window-excursion
1161: (apply 'mh-exec-cmd-quiet command)
1162: (switch-to-buffer " *mh-temp*")
1163: (goto-char (point-min))
1164: (while (re-search-forward "\\([0-9]+\\)" nil t)
1165: (let ((num (string-to-int (buffer-substring (match-beginning 1)
1166: (match-end 1)))))
1167: (if (not (zerop num))
1168: (push num msgs)))))
1169: (switch-to-buffer folder)
1170: (push (cons seq msgs) mh-seq-list)
1171: msgs)))
1172:
1173:
1174: (defun mh-remove-seq (seq)
1175: "Delete the sequence SEQ."
1176: (let ((entry (assoc seq mh-seq-list)))
1177: (setq mh-seq-list (delq (car entry) mh-seq-list))
1178: (mh-notate-seq (mh-seq-msgs (car entry)) ? 0)))
1179:
1180:
1181: (defun mh-remove-msg-from-seq (msg-num seq)
1182: "Remove a message MSG-NUM from the sequence SEQ."
1183: (let ((seq (assoc seq mh-seq-list)))
1184: (if seq
1185: (setcdr seq (delq msg-num (mh-seq-msgs seq)))))
1186: (mh-notate ? 0))
1187:
1188:
1189: (defun mh-add-msg-to-seq (msg-num seq)
1190: "Add a message MSG-NUM to a sequence SEQ."
1191: (let ((seq-list (assoc seq mh-seq-list)))
1192: (mh-notate (mh-seq-to-notation seq) 0)
1193: (if (null seq-list)
1194: (push (cons seq (list msg-num)) mh-seq-list)
1195: (setcdr seq-list (cons msg-num (cdr seq-list))))))
1196:
1197:
1198:
1199: (defun mh-new-seq (folder)
1200: "Return a new sequence name for FOLDER."
1201: (save-excursion
1202: (switch-to-buffer folder)
1203: (if (= mh-next-seq-num 10)
1204: (error "No more sequences"))
1205: (setq mh-next-seq-num (+ mh-next-seq-num 1))
1206: (mh-letter-to-seq (+ (1- mh-next-seq-num) ?a))))
1207:
1208:
1209: (defun mh-letter-to-seq (letter)
1210: "Given a LETTER, return a string that is a valid sequence name."
1211: (cond ((and (>= letter ?0) (<= letter ?9))
1212: (intern (format "mhe%c" letter)))
1213: ((and (>= letter ?a) (<= letter ?z))
1214: (intern (format "mhe%c" letter)))
1215: (t
1216: (error "A sequence is named 0...9"))))
1217:
1218:
1219: (defun mh-seq-to-notation (seq)
1220: "Return the string used to indicate sequence SEQ in a scan listing."
1221: (string-to-char (substring (symbol-name seq) 3 4)))
1222:
1223:
1224: (defun mh-notate-seq (seq notation offset)
1225: "Mark all messages in the sequence SEQ with the NOTATION at character
1226: OFFSET."
1227: (mh-apply-to-seq seq 'mh-notate notation offset))
1228:
1229:
1230: (defun mh-apply-to-seq (seq function &rest args)
1231: "For each message in sequence SEQ, evaluate the FUNCTION with ARGS."
1232: (mapcar (function (lambda (msg) (mh-goto msg) (apply function args)))
1233: (mh-seq-to-msgs seq)))
1234:
1235:
1236: (defun mh-process-seq-commands (seq-list)
1237: "Process outstanding sequence commands for the sequences in SEQ-LIST."
1238: (mh-apply-to-message-list
1239: (function (lambda (seq msgs)
1240: (apply 'mh-exec-cmd-quiet
1241: (nconc (list "mark" "-zero" "-seq" (format "%s" seq)
1242: "-add" "-nolist")
1243: msgs))))
1244: seq-list))
1245:
1246:
1247:
1248: ;;; Issue commands to mh.
1249:
1250: (defun mh-exec-cmd (command &rest args)
1251: "Execute MH command COMMAND with ARGS. Any output is shown to the user."
1252: (save-excursion
1253: (switch-to-buffer-other-window " *mh-temp*")
1254: (erase-buffer)
1255: (apply 'call-process (nconc (list (format "%s%s" mh-progs command)
1256: nil t nil)
1257: (mh-list-to-string args)))
1258: (if (> (buffer-size) 0)
1259: (sit-for 5))))
1260:
1261:
1262: (defun mh-exec-cmd-quiet (command &rest args)
1263: "Execute MH command COMMAND with ARGS. Output is collected, but not shown
1264: to the user."
1265: (save-excursion
1266: (switch-to-buffer " *mh-temp*")
1267: (erase-buffer)
1268: (apply 'call-process (nconc (list (format "%s%s" mh-progs command)
1269: nil t nil)
1270: (mh-list-to-string args)))))
1271:
1272:
1273: (defun mh-exec-cmd-output (command &rest args)
1274: "Execute MH command COMMAND with ARGS putting the output into buffer after
1275: point. Set mark after inserted text."
1276: (set-mark (point))
1277: (apply 'call-process (nconc (list (format "%s%s" mh-progs command) nil t nil)
1278: (mh-list-to-string args)))
1279: (exchange-point-and-mark))
1280:
1281:
1282: (defun mh-exec-cmd-no-wait (command &rest args)
1283: "Execute MH command COMMAND with ARGS and do not wait until it finishes."
1284: (apply 'call-process (nconc (list (format "%s%s" mh-progs command) nil 0 nil)
1285: (mh-list-to-string args))))
1286:
1287:
1288:
1289: (defun mh-exec-lib-cmd-output (command &rest args)
1290: "Execute MH library command COMMAND with ARGS. Put the output into
1291: buffer after point. Set mark after inserted text."
1292: (set-mark (point))
1293: (apply 'call-process (nconc (list (format "%s%s" mh-lib command) nil t nil)
1294: (mh-list-to-string args)))
1295: (exchange-point-and-mark))
1296:
1297:
1298: (defun mh-list-to-string (l)
1299: "Flattens the list L and makes every element a string."
1300: (let ((new-list nil))
1301: (while l
1302: (cond ((symbolp (car l)) (push (format "%s" (car l)) new-list))
1303: ((numberp (car l)) (push (format "%d" (car l)) new-list))
1304: ((equal (car l) ""))
1305: ((stringp (car l)) (push (car l) new-list))
1306: ((null (car l)))
1307: ((listp (car l)) (setq new-list
1308: (nconc (mh-list-to-string (car l))
1309: new-list)))
1310: (t (error "Bad argument %s" (car l))))
1311: (setq l (cdr l)))
1312: (nreverse new-list)))
1313:
1314:
1315:
1316: ;;; Commands to annotate a message.
1317:
1318: (defun mh-annotate-msg (msg buffer note &rest args)
1319: "Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
1320: the saved message with ARGS."
1321: ;; Wait for annotation to finish, to avoid race condition with reading msg.
1322: (apply 'mh-exec-cmd (cons "anno" (nconc (list buffer msg) args)))
1323: (save-excursion
1324: (switch-to-buffer buffer)
1325: (if (mh-goto msg t)
1326: (mh-notate note 5))))
1327:
1328:
1329: (defun mh-notate (notation offset)
1330: "Marks the current message with the character NOTATION at position OFFSET."
1331: (let ((buffer-read-only nil))
1332: (beginning-of-line)
1333: (goto-char (+ (point) offset))
1334: (delete-char 1)
1335: (insert notation)
1336: (beginning-of-line)))
1337:
1338:
1339:
1340: ;;; User prompting commands.
1341:
1342: (defun mh-get-folder-name (prompt default can-create)
1343: "Prompt for a folder name with PROMPT. DEFAULT is used if the folder
1344: exists and the user types CR. If the CAN-CREATE flag is t,
1345: then a non-existant folder is made."
1346: (let* ((prompt (format "%s folder%s" prompt
1347: (if (equal "" default)
1348: "? "
1349: (format " [%s]? " default))))
1350: name)
1351: (while (and (setq name (completing-read prompt mh-folder-list
1352: nil (not can-create)))
1353: (equal name "")
1354: (equal default "")))
1355: (cond ((equal name "")
1356: (setq name default))
1357: ((not (equal (substring name 0 1) "+"))
1358: (setq name (format "+%s" name))))
1359: (let ((new-file-p
1360: (not
1361: (file-exists-p (format "%s%s" mh-user-path (substring name 1))))))
1362: (cond ((and new-file-p
1363: (y-or-n-p
1364: (format "Folder %s does not exist. Create it? " name)))
1365: (message "Creating %s" name)
1366: (call-process "mkdir" nil nil nil
1367: (format "%s%s" mh-user-path (substring name 1)))
1368: (message "Creating %s...done" name)
1369: (push (list name) mh-folder-list)
1370: (push (list (substring name 1 nil)) mh-folder-list))
1371: (new-file-p
1372: (error ""))
1373: (t
1374: (when (null (assoc name mh-folder-list))
1375: (push (list name) mh-folder-list)
1376: (push (list (substring name 1 nil)) mh-folder-list)))))
1377: name))
1378:
1379:
1380: (defun mh-make-folder-list ()
1381: "Returns a list of the user's folders in a form suitable for completing
1382: read."
1383: (interactive)
1384: (save-window-excursion
1385: (mh-exec-cmd-quiet "folders" "-fast" "-norecurse")
1386: (switch-to-buffer " *mh-temp*")
1387: (goto-char (point-min))
1388: (let ((list nil))
1389: (while (not (eobp))
1390: (let ((start (point)))
1391: (search-forward "\n" nil t)
1392: (let ((folder (buffer-substring start (- (point) 1))))
1393: (push (list folder) list)
1394: (push (list (format "+%s" folder)) list))))
1395: list)))
1396:
1397:
1398: (defun mh-remove-folder-from-folder-list (folder)
1399: "Remove FOLDER from the list of folders."
1400: (setq mh-folder-list
1401: (delq (assoc (substring folder 1 nil) mh-folder-list)
1402: mh-folder-list)))
1403:
1404:
1405:
1406: ;;; Misc. functions.
1407:
1408: (defun mh-get-msg-num (error-if-no-message)
1409: "Returns the message number of the current message. If the argument
1410: ERROR-IF-NO-MESSAGE is t, then complain if the cursor is not pointing to a
1411: message."
1412: (save-excursion
1413: (beginning-of-line)
1414: (cond ((looking-at "^[0-9a-z]?[ ]+\\([0-9]+\\)")
1415: (string-to-int (buffer-substring (match-beginning 1)
1416: (match-end 1))))
1417: ((looking-at "^\\([0-9]+\\)")
1418: (string-to-int (buffer-substring (match-beginning 1)
1419: (match-end 1))))
1420: (error-if-no-message
1421: (error "Cursor not pointing to message"))
1422: (t nil))))
1423:
1424:
1425: (defun mh-msg-search-pat (n)
1426: "Returns a search pattern for message N in the scan listing."
1427: (cond ((< n 10) (format "^...%d" n))
1428: ((< n 100) (format "^..%d" n))
1429: ((< n 1000) (format "^.%d" n))
1430: (t (format "^%d" n))))
1431:
1432:
1433: (defun mh-msg-filename ()
1434: "Returns a string containing the pathname for the file containing the
1435: current message."
1436: (format "%s%d" mh-folder-filename (mh-get-msg-num t)))
1437:
1438:
1439: (defun mh-msg-filenames (msgs folder)
1440: "Returns a string of filenames specifying MSGS in FOLDER."
1441: (if msgs
1442: (let ((args ""))
1443: (while (cdr msgs)
1444: (setq args (format "%s%s%d " args folder (car msgs)))
1445: (setq msgs (cdr msgs)))
1446: (format "%s%s%d" args folder (car msgs)))
1447: ""))
1448:
1449:
1450: (defun mh-find-path ()
1451: "Set mh_path from ~/.mh_profile."
1452: (save-window-excursion
1453: (if (not (file-exists-p "~/.mh_profile"))
1454: (error "Cannot find .mh_profile file."))
1455: (switch-to-buffer " *mh_profile*")
1456: (erase-buffer)
1457: (insert-file-contents "~/.mh_profile")
1458: (if (equal (setq mh-user-path (mh-get-field "Path:")) "")
1459: (setq mh-user-path "Mail/")
1460: (setq mh-user-path (format "%s/" mh-user-path)))
1461: (if (not (equal (substring mh-user-path 0 1) "/"))
1462: (setq mh-user-path (format "%s/%s" (getenv "HOME") mh-user-path)))))
1463:
1464:
1465: (defun mh-get-cur-msg (folder)
1466: "Returns the number of the 'cur' message in FOLDER."
1467: (save-excursion
1468: (switch-to-buffer " *mh_temp*")
1469: (erase-buffer)
1470: (mh-exec-cmd-output "pick" folder "cur")
1471: (string-to-int (buffer-substring (point-min) (point)))))
1472:
1473:
1474: (defun mh-get-field (field)
1475: "Find and return the value of field FIELD in the current buffer.
1476: Returns the empty string if the field is not in the message."
1477: (let ((case-fold-search t))
1478: (goto-char (point-min))
1479: (cond ((not (search-forward field nil t)) "")
1480: ((looking-at "[\t ]*$") "")
1481: (t
1482: (re-search-forward "[\t ]*\\([a-zA-z0-9/].*\\)$" nil t)
1483: (let ((field (buffer-substring (match-beginning 1)
1484: (match-end 1)))
1485: (end-of-match (point)))
1486: (forward-line)
1487: (while (looking-at "[ \t]") (forward-line 1))
1488: (backward-char 1)
1489: (format "%s%s" field (buffer-substring end-of-match (point))))))))
1490:
1491:
1492: (defun mh-insert-fields (&rest name-values)
1493: "Insert the NAME-VALUE pairs in the current buffer."
1494: (let ((case-fold-search t))
1495: (while name-values
1496: (let ((field-name (car name-values))
1497: (value (cadr name-values)))
1498: (goto-char (point-min))
1499: (cond ((not (re-search-forward (format "^%s" field-name) nil t))
1500: (re-search-forward "^---\\|^$")
1501: (beginning-of-line)
1502: (insert field-name " " value "\n"))
1503: (t
1504: (end-of-line)
1505: (insert " " value)))
1506: (setq name-values (cddr name-values))))))
1507:
1508:
1509: (defun mh-position-on-field (field set-mark)
1510: "Set point to the end of the line beginning with FIELD. Sets the mark
1511: to the point, if SET-MARK is non-nil."
1512: (if set-mark (set-mark (point)))
1513: (goto-char (point-min))
1514: (if (re-search-forward (format "^%s" field) nil t)
1515: (progn (end-of-line) t)
1516: nil))
1517:
1518:
1519:
1520: ;;; Build the folder-mode keymap:
1521:
1522: (define-key mh-folder-mode-map " " 'mh-page-msg)
1523: (define-key mh-folder-mode-map "!" 'mh-re-move)
1524: (define-key mh-folder-mode-map "." 'mh-show)
1525: (define-key mh-folder-mode-map "0" 'mh-indicate-seq)
1526: (define-key mh-folder-mode-map "1" 'mh-indicate-seq)
1527: (define-key mh-folder-mode-map "2" 'mh-indicate-seq)
1528: (define-key mh-folder-mode-map "3" 'mh-indicate-seq)
1529: (define-key mh-folder-mode-map "4" 'mh-indicate-seq)
1530: (define-key mh-folder-mode-map "5" 'mh-indicate-seq)
1531: (define-key mh-folder-mode-map "6" 'mh-indicate-seq)
1532: (define-key mh-folder-mode-map "7" 'mh-indicate-seq)
1533: (define-key mh-folder-mode-map "8" 'mh-indicate-seq)
1534: (define-key mh-folder-mode-map "9" 'mh-indicate-seq)
1535: (define-key mh-folder-mode-map ">" 'mh-save-message)
1536: (define-key mh-folder-mode-map "?" 'mh-summary)
1537: (define-key mh-folder-mode-map "\177" 'mh-previous-page)
1538: (define-key mh-folder-mode-map "\e " 'mh-page-digest)
1539: (define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
1540: (define-key mh-folder-mode-map "\ei" 'mh-inc-folder)
1541: (define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
1542: (define-key mh-folder-mode-map "\el" 'mh-list-folders)
1543: (define-key mh-folder-mode-map "\ep" 'mh-renumber-folder)
1544: (define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
1545: (define-key mh-folder-mode-map "\es" 'mh-search-folder)
1546: (define-key mh-folder-mode-map "^" 'mh-move-msg)
1547: (define-key mh-folder-mode-map "a" 'mh-answer)
1548: (define-key mh-folder-mode-map "c" 'mh-copy-msg)
1549: (define-key mh-folder-mode-map "d" 'mh-delete-msg)
1550: (define-key mh-folder-mode-map "e" 'mh-execute-commands)
1551: (define-key mh-folder-mode-map "f" 'mh-forward)
1552: (define-key mh-folder-mode-map "g" 'mh-goto)
1553: (define-key mh-folder-mode-map "l" 'mh-print-msg)
1554: (define-key mh-folder-mode-map "n" 'mh-next-line)
1555: (define-key mh-folder-mode-map "p" 'mh-previous-line)
1556: (define-key mh-folder-mode-map "r" 'mh-redistribute)
1557: (define-key mh-folder-mode-map "s" 'mh-send)
1558: (define-key mh-folder-mode-map "t" 'mh-toggle-summarize)
1559: (define-key mh-folder-mode-map "u" 'mh-undo)
1560: (define-key mh-folder-mode-map "x" 'mh-execute-commands)
1561:
1562: ;;; Build the letter-mode keymap:
1563:
1564: (define-key mh-letter-mode-map "\^C\^C" 'mh-send-letter)
1565: (define-key mh-letter-mode-map "\^C\^Y" 'mh-insert-letter)
1566: (define-key mh-letter-mode-map "\^Cb" 'mh-to-bcc)
1567: (define-key mh-letter-mode-map "\^Cc" 'mh-to-cc)
1568: (define-key mh-letter-mode-map "\^Cf" 'mh-to-fcc)
1569: (define-key mh-letter-mode-map "\^Cq" 'kill-buffer)
1570: (define-key mh-letter-mode-map "\^Cs" 'mh-to-subject)
1571: (define-key mh-letter-mode-map "\^Ct" 'mh-to-to)
1572: (define-key mh-letter-mode-map "\^Cw" 'mh-check-whom)
1573: (define-key mh-letter-mode-map "\^Cy" 'mh-insert-cur-message)
1574:
1575: ;;; Build the pick-mode keymap:
1576:
1577: (define-key mh-pick-mode-map "\^C\^C" 'mh-do-pick-search)
1578: (define-key mh-pick-mode-map "\^Cb" 'mh-to-bcc)
1579: (define-key mh-pick-mode-map "\^Cc" 'mh-to-cc)
1580: (define-key mh-pick-mode-map "\^Cf" 'mh-to-fcc)
1581: (define-key mh-pick-mode-map "\^Cs" 'mh-to-subject)
1582: (define-key mh-pick-mode-map "\^Ct" 'mh-to-to)
1583: (define-key mh-pick-mode-map "\^Cw" 'mh-check-whom)
1584:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.