![[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: 2.7)
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:
38: (defvar mh-progs "/usr/local/mh/" "Directory containing MH commands")
39: (defvar mh-lib "/usr/local/lib/mh/" "Directory of MH library")
40:
41:
42: ;;; Mode hooks:
43:
44: (defvar mh-folder-mode-hook nil "Invoked in mh-folder-mode")
45: (defvar mh-letter-mode-hook nil "Invoked in mh-letter-mode")
46:
47:
48: ;;; Personal preferences:
49:
50: (defvar mh-auto-fill-letters t "Invoke auto-fill-mode in letters")
51: (defvar mh-clean-message-header nil
52: "Remove invisible header lines in messages")
53: (defvar mh-lpr-command-format "lpr -p -J '%s'"
54: "Format for Unix command line to print a message. The format should be
55: a unix command line, with the string "%s" where the folder and message
56: number should appear.")
57: (defvar mh-summary-height 4 "Number of lines in summary window")
58:
59: ;;; Real constants:
60:
61: (defvar mh-cmd-note 4 "Offset to insert notation")
62: (defvar mh-invisible-headers
63: "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|\^Return-
64: Path: \\|^In-Reply-To: \\|^Resent-"
65: "Regexp specifying headers that are not to be shown.")
66:
67:
68: ;;; Global variables:
69:
70: (defvar mh-user-path "" "User's mail folder")
71: (defvar mh-last-folder "inbox" "Last folder read by mh-rmail")
72: (defvar mh-last-destination nil "Destination of last "move" command")
73: (defvar mh-current-folder nil "Currently active folder")
74: (defvar mh-folder-buffer nil "Buffer name of currently active folder")
75: (defvar mh-show-buffer nil "Name of buffer that displays messages")
76: (defvar mh-letter-mode-map nil "Command map for composing mail")
77:
78: ;;; Macros:
79:
80: (defmacro push (v l)
81: (list 'setq l (list 'cons v l)))
82:
83: (defmacro caar (l)
84: (list 'car (list 'car l)))
85:
86: (defmacro cadr (l)
87: (list 'car (list 'cdr l)))
88:
89: (defmacro cdar (l)
90: (list 'cdr (list 'car l)))
91:
92: (defmacro cddr (l)
93: (list 'cdr (list 'cdr l)))
94:
95: (defmacro when (pred &rest body)
96: (list 'cond (cons pred body)))
97:
98:
99:
100: ;;; Entry points:
101:
102: (defun mh-rmail (&optional arg)
103: "Inc(orporate) new mail if optional ARG omitted, or scan a MH mail box
104: if arg is present. This front end uses the MH mail system, which uses
105: different conventions from the usual mail system."
106: (interactive "P")
107: (let ((make-backup-files nil)
108: (pop-up-windows t)
109: mh-current-folder
110: mh-folder-buffer)
111:
112: (mh-find-path)
113: (save-window-excursion
114: (cond (arg
115: (let ((folder (mh-get-folder-name "mh" mh-last-folder t))
116: (range (read-string "range [all]? ")))
117: (mh-scan-folder folder (if (string= range "") "all" range))))
118: (t
119: (mh-make-folder "inbox")
120: (mh-inc-folder)))
121:
122: (let ((mh-show-buffer (concat "show-" mh-current-folder)))
123: (pop-to-buffer mh-show-buffer)
124: (unwind-protect
125: (mh-command-loop)
126: (kill-buffer mh-folder-buffer)
127: (kill-buffer mh-show-buffer)
128: (setq mh-last-folder mh-current-folder))))))
129:
130:
131: (defun mh-smail ()
132: "Send mail using the MH mail system."
133: (interactive)
134: (let ((make-backup-files nil)
135: (pop-up-windows t))
136: (mh-find-path)
137: (call-interactively 'mh-send)))
138:
139:
140:
141: ;;; User executable mh-e commands:
142:
143: (defun mh-answer ()
144: "Answer a letter."
145: (interactive)
146: (save-window-excursion
147: (let ((msg-filename (mh-msg-filename))
148: (msg (mh-get-msg-num t))
149: (reply-to
150: (mh-get-response
151: "Reply to (f, t, c, ?): "
152: '(?f ?t ?c)
153: "Reply to F(rom), T(o + From), C(c + To + From): ")))
154: (message "Composing a reply...")
155: (cond ((equal reply-to ?f)
156: (mh-exec-cmd "repl" "-build" mh-folder-buffer msg "-nocc" "all"))
157: ((equal reply-to ?t)
158: (mh-exec-cmd "repl" "-build" mh-folder-buffer msg "-cc" "to"
159: "-nocc" "me"))
160: ((equal reply-to ?c)
161: (mh-exec-cmd "repl" "-build" mh-folder-buffer msg "-cc" "all"
162: "-nocc" "me")))
163:
164: (mh-read-file (concat mh-user-path "draft") "draft")
165: (delete-other-windows)
166: (when (or (zerop (buffer-size))
167: (not (y-or-n-p "The file 'draft' exists. Use for reply? ")))
168: (erase-buffer)
169: (insert-file-contents (concat mh-user-path "reply"))
170: (delete-file (concat mh-user-path "reply")))
171:
172: (let ((to-names (mh-get-field "To:"))
173: (cc-names (mh-get-field "Cc:")))
174: (goto-char (dot-max))
175: (pop-to-buffer "*message*")
176: (erase-buffer)
177: (if (file-exists-p msg-filename)
178: (insert-file-contents msg-filename)
179: (error "File %s does not exist" msg-filename))
180: (goto-char (dot-min))
181: (let ((case-fold-search nil))
182: (re-search-forward "^$\\|^-*$"))
183: (recenter 0)
184: (message "Composing a reply...done")
185: (if (mh-compose-and-send-mail "")
186: (mh-annotate "R" mh-folder-buffer msg
187: "-component" "Replied-To:"
188: "-text" (concat to-names
189: (if (string= cc-names "")
190: ""
191: (concat ", " cc-names)))))))))
192:
193:
194: (defun mh-close-folder ()
195: "Process the outstanding delete and move commands in the current folder."
196: (interactive)
197: (message "closing folder...")
198: (mh-process-commands mh-folder-buffer)
199: (mh-unmark-all-headers t)
200: (mh-regenerate-headers "all")
201: (setq mode-line-format (mh-make-mode-line))
202: (message "closing folder...done"))
203:
204:
205: (defun mh-copy-msg (&optional arg)
206: "Copy specified message(s) to another folder without deleting them."
207: (interactive "P")
208: (let ((msgs (if arg
209: (mh-seq-to-msgs (mh-read-seq "Copy"))
210: (mh-get-msg-num t))))
211: (mh-exec-cmd-no-wait "refile" msgs "-link" "-src"
212: mh-folder-buffer
213: (format "+%s" (mh-get-folder-name "Copy to" "" t)))))
214:
215:
216: (defun mh-delete-msg (&optional arg)
217: "Marks the specified message(s) for later deletion."
218: (interactive "P")
219: (let ((msgs (if arg (mh-read-seq "Delete") (mh-get-msg-num t))))
220: (push msgs mh-delete-list)
221: (if arg
222: (mh-notate-seq msgs ?D mh-cmd-note)
223: (mh-notate ?D mh-cmd-note))
224: (mh-next-line 1)))
225:
226:
227: (defun mh-exit ()
228: "Exit mh-e and process outstanding delete and move commands."
229: (interactive)
230: (cond ((not (or mh-delete-list mh-move-list))
231: (throw 'exit nil))
232: ((yes-or-no-p "Exit? ")
233: (mh-process-commands mh-folder-buffer)
234: (throw 'exit nil))))
235:
236:
237: (defun mh-forward (to subject cc)
238: "Forward a letter."
239: (interactive "sTo: \nsSubject: \nsCc: ")
240: (save-window-excursion
241: (let ((msg-filename (mh-msg-filename))
242: (msg (mh-get-msg-num t)))
243: (cond ((or (not (file-exists-p (concat mh-user-path "draft")))
244: (y-or-n-p "The file 'draft' exists. Discard it? "))
245: (mh-exec-cmd "forw" "-build" mh-folder-buffer msg)
246: (mh-read-file (concat mh-user-path "draft") "draft")
247: (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc))
248: (t
249: (mh-read-file (concat mh-user-path "draft") "draft")))
250:
251: (goto-char (dot-min))
252: (delete-other-windows)
253: (if (mh-compose-and-send-mail "")
254: (mh-annotate "F" mh-folder-buffer msg
255: "-component" "Forwared-To:"
256: "-text" (concat to
257: (if (string= cc "")
258: ""
259: (concat ", " cc))))))))
260:
261:
262: (defun mh-goto (number &optional no-error-if-no-message)
263: "Position the cursor at a particular message."
264: (interactive "nMessage number? ")
265: (pop-to-buffer mh-folder-buffer)
266: (let ((starting-place (dot)))
267: (goto-char (dot-min))
268: (cond ((not (re-search-forward (concat "^\+?[0-9a-z]*[ ]*" number) nil t))
269: (goto-char starting-place)
270: (if (not no-error-if-no-message) (error "No message %d " number)))
271: (t
272: (beginning-of-line)
273: (if (not mh-summarize) (mh-show))))))
274:
275:
276: (defun mh-inc-folder ()
277: "inc(orporate) new mail in the current folder."
278: (interactive)
279: (mh-get-new-mail))
280:
281:
282: (defun mh-indicate-seq (&optional arg)
283: "Add the specified message(s) to a sequence."
284: (interactive "P")
285: (let ((seq (mh-letter-to-seq last-input-char)))
286: (if (looking-at "^[0-9a-j]")
287: (if arg
288: (mh-remove-seq seq)
289: (mh-remove-msg-from-seq (mh-get-msg-num t) seq))
290: (mh-add-msg-to-seq (mh-get-msg-num t) seq))))
291:
292:
293: (defun mh-kill-folder ()
294: "Removes the current folder."
295: (interactive)
296: (cond ((yes-or-no-p "Remove current folder ")
297: (pop-to-buffer " *mh-temp*")
298: (mh-exec-cmd "rmf" (buffer-name))
299: (message "Folder removed")
300: (throw 'exit nil))
301: (t
302: (message "Folder not removed"))))
303:
304:
305: (defun mh-list-folders ()
306: "List mail folders."
307: (interactive)
308: (message "listing folders...")
309: (pop-to-buffer " *mh-temp*")
310: (erase-buffer)
311: (mh-exec-cmd-output "folders")
312: (goto-char (dot-min))
313: (message "listing folders...done"))
314:
315:
316: (defun mh-print-msg (&optional arg)
317: "Print specified message(s) on a line printer."
318: (interactive "P")
319: (let ((msgs (if arg
320: (reverse (mh-seq-to-msgs (mh-read-seq "Print")))
321: (list (mh-get-msg-num t)))))
322: (message "printing message...")
323: (shell-command
324: (concat mh-lib "mhl -noclear -nobell "
325: (mh-msg-filenames msgs mh-folder-filename) " | "
326: (format mh-lpr-command-format
327: (if arg
328: "Mail"
329: (concat mh-current-folder "/" (mh-get-msg-num t))))))
330: (message "printing message...done")))
331:
332:
333: (defun mh-move-msg (&optional arg)
334: "Move specified message(s) to another folder."
335: (interactive "P")
336: (let ((msgs (if arg (mh-read-seq "Move") (mh-get-msg-num t))))
337: (setq mh-last-destination (mh-get-folder-name "Destination" "" t))
338: (mh-refile msgs mh-last-destination)
339: (mh-next-line 1)))
340:
341:
342: (defun mh-next-line (&optional arg)
343: "Move to next undeleted message in window and display body if summary
344: flag set."
345: (interactive "p")
346: (pop-to-buffer mh-folder-buffer)
347: (forward-line (if arg arg 1))
348: (if (not (re-search-forward "^....[^D^]" nil 0 arg))
349: (progn
350: (forward-line -1)
351: (message "No more messages"))
352: (beginning-of-line))
353: (if (not mh-summarize) (mh-show)))
354:
355:
356: (defun mh-renumber-folder ()
357: "Renumber messages in folder to be 1..N."
358: (interactive)
359: (message "packing buffer...")
360: (pop-to-buffer mh-folder-buffer)
361: (mh-pack-folder)
362: (mh-unmark-all-headers nil)
363: (mh-position-to-current)
364: (message "packing buffer...done"))
365:
366:
367: (defun mh-page-digest ()
368: "Advance displayed message to next digested message."
369: (interactive)
370: (save-excursion
371: (pop-to-buffer mh-show-buffer)
372: (move-to-window-line nil)
373: (let ((case-fold-search nil))
374: (when (not (search-forward "\nFrom:" nil t))
375: (other-window -1)
376: (error "No more messages")))
377: (recenter 0)
378: (other-window -1)))
379:
380:
381: (defun mh-previous-line (&optional arg)
382: "Move to previous message in window and display body if summary flag set."
383: (interactive "p")
384: (pop-to-buffer mh-folder-buffer)
385: (forward-line (- (if arg arg 1)))
386: (if (not (re-search-backward "^....[^D^]" nil 0 arg))
387: (message "Beginning of messages")
388: (if (not mh-summarize) (mh-show))))
389:
390:
391: (defun mh-previous-page ()
392: "Page the displayed message backwards."
393: (interactive)
394: (save-excursion
395: (pop-to-buffer mh-show-buffer)
396: (scroll-down nil)
397: (other-window -1)))
398:
399:
400: (defun mh-quit ()
401: "Quit mh-e without processing outstanding delete and move commands."
402: (interactive)
403: (if (and (or mh-delete-list mh-move-list)
404: (not (yes-or-no-p "Quit without processing? ")))
405: (mh-process-commands mh-folder-buffer))
406: (throw 'exit nil))
407:
408:
409: (defun mh-rescan-folder (&optional arg)
410: "Optionally process commands in current folder and (re)scan it."
411: (interactive "P")
412: (pop-to-buffer mh-folder-buffer)
413: (if (and (or mh-delete-list mh-move-list)
414: (y-or-n-p "Process commands? "))
415: (mh-process-commands mh-folder-buffer))
416: (mh-regenerate-headers (if arg (read-string "Range? ") "all"))
417: (setq mode-line-format (mh-make-mode-line))
418: (mh-unmark-all-headers nil)
419: (mh-position-to-current))
420:
421:
422: (defun mh-redistribute (to cc)
423: "Redistribute a letter."
424: (interactive "sTo: \nsCc: ")
425: (save-window-excursion
426: (let ((msg-filename (mh-msg-filename))
427: (msg (mh-get-msg-num t)))
428: (mh-read-file (concat mh-user-path "draft") "draft")
429: (delete-other-windows)
430: (when (or (zerop (buffer-size))
431: (not (y-or-n-p "The file 'draft' exists. Redistribute? ")))
432: (erase-buffer)
433: (insert-file-contents msg-filename)
434: (goto-char (dot-min))
435: (insert "Resent-To: " to "\n")
436: (if (not (string= cc ""))
437: (insert "Resent-cc: " cc "\n")))
438:
439: (if (mh-compose-and-send-mail "-dist")
440: (mh-annotate "F" mh-folder-buffer msg
441: "-component" "Distributed-to:"
442: "-text" (concat to
443: (if (string= cc "")
444: ""
445: (concat ", " cc))))))))
446:
447:
448: (defun mh-re-move ()
449: "Move specified message to same folder as last move."
450: (interactive)
451: (if (null mh-last-destination)
452: (error "No previous move")
453: (mh-refile (mh-get-msg-num t) mh-last-destination)))
454:
455:
456: (defun mh-search-folder ()
457: "Search folder for letters matching a pattern."
458: (interactive)
459: (let* ((range "all")
460: (seq (mh-new-seq))
461: (pattern nil))
462: (mh-get-pick-pattern " *pattern*")
463: (while (setq pattern (mh-next-pick-field " *pattern*"))
464: (setq msgs
465: (mh-seq-from-command seq
466: (nconc (cons "pick" pattern)
467: (list (concat "+" mh-current-folder)
468: range
469: "-sequence" seq "-list"))))
470: (setq range seq))
471: (mh-apply-to-seq seq 'mh-notate (mh-seq-to-notation seq) 0)))
472:
473:
474: (defun mh-send (to subject cc)
475: "Compose and send a letter."
476: (interactive "sTo: \nsSubject: \nsCc: ")
477: (message "Composing a message...")
478: (save-window-excursion
479: (mh-read-file (concat mh-user-path "draft") "draft")
480: (delete-other-windows)
481: (when (or (zerop (buffer-size))
482: (not (y-or-n-p "The file 'draft' exists. Use it? ")))
483: (erase-buffer)
484: (if (file-exists-p (concat mh-user-path "components"))
485: (insert-file-contents (concat mh-user-path "components"))
486: (if (file-exists-p (concat mh-lib "components"))
487: (insert-file-contents (concat mh-lib "components"))
488: (error "Can't find components")))
489: (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
490: (goto-char (dot-max))
491: (message "Composing a message...done"))
492: (mh-compose-and-send-mail "")))
493:
494:
495: (defun mh-show ()
496: "Show message indicated by cursor in scan buffer."
497: (interactive)
498: (setq mh-summarize nil)
499: (pop-to-buffer mh-folder-buffer)
500: (let ((msgn (mh-get-msg-num t))
501: (msg-filename (mh-msg-filename))
502: (folder mh-current-folder))
503: (if (not (file-exists-p msg-filename))
504: (error "Message %d does not exist." msgn))
505: (push msgn mh-shown-msgs)
506: (switch-to-buffer mh-show-buffer)
507: (erase-buffer)
508: (insert-file-contents msg-filename)
509: (setq buffer-file-name msg-filename)
510: (mh-letter-mode)
511: (cond (mh-clean-message-header
512: (mh-clean-message-header)
513: (goto-char (dot-min)))
514: (t
515: (let ((case-fold-search nil))
516: (re-search-forward "^To:\\|^From:\\|^Subject:" nil t)
517: (beginning-of-line)
518: (recenter 0))))
519: (set-buffer-modified-p nil)
520: (setq mode-line-format
521: (concat "{%b} %[%p of +" folder "/" msgn "%] %M"))
522: ;; These contortions are to force the summary line to be the top window.
523: (pop-to-buffer mh-folder-buffer)
524: (delete-other-windows)
525: (pop-to-buffer mh-show-buffer)
526: (pop-to-buffer mh-folder-buffer)
527: (shrink-window (- (window-height) mh-summary-height))
528: (recenter 1)))
529:
530:
531: (defun mh-summary ()
532: "Show a summary of mh-e commands."
533: (interactive)
534: (message
535: "Next Prev Go Del ^ ! Copy Undo . Toggle Ans Forw Redist Send List Quit Exit")
536: (sit-for 5))
537:
538:
539: (defun mh-toggle-summarize ()
540: "Turn the summary mode of displaying messages on or off."
541: (interactive)
542: (setq mh-summarize (not mh-summarize))
543: (if (not mh-summarize)
544: (mh-show)
545: (delete-other-windows)))
546:
547:
548: (defun mh-undo (&optional arg)
549: "Undo the deletion or move of the specified message(s)."
550: (interactive "P")
551: (cond ((looking-at "^....D")
552: (let ((msgs (if arg (mh-read-seq "undelete") (mh-get-msg-num t))))
553: (setq mh-delete-list (delq msgs mh-delete-list))
554: (if arg
555: (mh-notate-seq msgs ? mh-cmd-note)
556: (mh-notate ? mh-cmd-note))))
557:
558: ((looking-at "^....^")
559: (let ((msgs (if arg (mh-read-seq "unmove") (mh-get-msg-num t))))
560: (mapcar
561: (function (lambda (move) (setcdr msgs (delq msgs (cdr move)))))
562: mh-move-list)
563: (if arg
564: (mh-notate-seq msgs ? mh-cmd-note)
565: (mh-notate ? mh-cmd-note))))
566:
567: (t nil)))
568:
569:
570: (defun mh-visit-folder (&optional arg)
571: "Visit a new folder."
572: (interactive "p")
573: (let* (mh-current-folder
574: mh-folder-buffer
575: (folder (mh-get-folder-name "visit" "" t))
576: (mh-show-buffer (concat "show-" folder)))
577: (save-window-excursion
578: (switch-to-buffer (concat "+" folder))
579: (if (> (buffer-size) 0)
580: (error "folder +%s is open. close it before revisiting." folder))
581: (mh-scan-folder folder (if arg (read-string "range? ") "all"))
582: (pop-to-buffer mh-show-buffer)
583: (unwind-protect
584: (mh-command-loop)
585: (kill-buffer mh-show-buffer)
586: (kill-buffer mh-folder-buffer)))))
587:
588:
589:
590: ;;; Support routines.
591:
592: (defun mh-command-loop ()
593: "Read and execute mh commands."
594: (pop-to-buffer mh-folder-buffer)
595: (delete-other-windows)
596: (recursive-edit))
597:
598:
599: (defun mh-refile (msgs destination)
600: "Refile the msgs in the folder called destination."
601: (let ((others (assoc destination mh-move-list)))
602: (if others
603: (setcdr others (cons msgs (cdr others)))
604: (push (cons destination (list msgs)) mh-move-list))
605: (if (integerp msgs)
606: (mh-notate ?^ mh-cmd-note)
607: (mh-notate-seq msgs ?^ mh-cmd-note))))
608:
609:
610: (defun mh-clean-message-header ()
611: "Flush extraneous lines in a message header. The variable
612: mh-invisible-headers contains a regular expression specifying these lines."
613: (save-restriction
614: (goto-char (dot-min))
615: (search-forward "\n\n" nil t)
616: (narrow-to-region (dot-min) (dot))
617: (goto-char (dot-min))
618: (while (re-search-forward mh-invisible-headers nil t)
619: (beginning-of-line)
620: (kill-line 1)
621: (while (looking-at "^[ \t]+")
622: (beginning-of-line)
623: (kill-line 1)))))
624:
625:
626: (defun mh-read-file (file-name buffer-name)
627: "Read file FILE-NAME into buffer BUFFER-NAME. No errors if disk file
628: has been modified."
629: (pop-to-buffer buffer-name)
630: (kill-buffer buffer-name)
631: (pop-to-buffer buffer-name)
632: (if (file-exists-p file-name)
633: (insert-file-contents file-name t)
634: (setq buffer-file-name file-name))
635: (set-buffer-modified-p nil))
636:
637:
638:
639: ;;; The folder data abstraction.
640:
641: (defun mh-make-folder (name)
642: "Create and initialize a new mail folder called NAME and make
643: it the current folder."
644: (setq mh-current-folder name)
645: (setq mh-folder-buffer (concat "+" name))
646: (switch-to-buffer mh-folder-buffer)
647: (kill-all-local-variables)
648: (setq buffer-read-only nil)
649: (mh-folder-mode)
650: (erase-buffer)
651: (make-variable-buffer-local 'mh-folder-filename)
652: ;; "e.g./usr/foldbar/Mail/inbox/"
653: (setq mh-folder-filename (concat mh-user-path name "/"))
654: (make-variable-buffer-local 'mh-summarize) ; Show scan list only?
655: (setq mh-summarize t)
656: (make-variable-buffer-local 'mh-next-seq-num) ; Index of free sequence id
657: (setq mh-next-seq-num 0)
658: (make-variable-buffer-local 'mh-delete-list) ; List of msgs nums to delete
659: (setq mh-delete-list nil)
660: (make-variable-buffer-local 'mh-move-list) ; Alist of dest . msgs nums
661: (setq mh-move-list nil)
662: (make-variable-buffer-local 'mh-seq-list) ; Alist of seq . msgs nums
663: (setq mh-seq-list nil)
664: (make-variable-buffer-local 'mh-shown-msgs) ; List of msgs shown
665: (setq mh-shown-msgs nil)
666: (setq buffer-read-only t))
667:
668:
669: (defun mh-folder-mode ()
670: " \\[mh-next-line]: next message \\[mh-previous-line]: p
671: revious message
672: \\[mh-delete-msg]: delete (mark for deletion) \\[mh-move-msg]: put (m
673: ark for moving)
674: \\[mh-undo]: undo last delete or mark \\[mh-re-move]: repeat
675: last ^ command
676: \\[mh-copy-msg]: copy message to another folder
677: \\[mh-show]: type message \\[mh-toggle-summarize]: toggle
678: summarize mode
679: \\[scroll-other-window]: page message \\[mh-previous-p
680: age]: page message backwards
681: \\[mh-print-msg]: print message \\[mh-goto]: goto a mes
682: sage
683: \\[mh-exit]: exit \\[mh-quit]: quit
684: \\[mh-send]: send a message \\[mh-redistribute]: redistribu
685: te a message
686: \\[mh-answer]: answer a message \\[mh-forward]: forward a messa
687: ge
688: \\[mh-visit-folder]: visit folder \\[mh-inc-folder]: inc ma
689: il
690: \\[mh-close-folder]: close folder \\[mh-kill-folder]: kill
691: folder
692: \\[mh-list-folders]: list folders \\[mh-renumber-folder]: p
693: ack folder
694: \\[mh-rescan-folder]: rescan folder \\[mh-search-folder]: sea
695: rch folder
696: Edit the scan list, marking messages.
697: When you are done, type 'e'. The messages marked for deletion will be
698: deleted and messages marked for moving will be moved.
699: In any of the submodes, such as editing a message or composing a message,
700: exit with \\[exit-emacs]."
701: (auto-save-mode -1)
702: (use-local-map mh-keymap)
703: (setq major-mode 'mh-folder-mode)
704: (setq mode-name "mh-folder")
705: (if (and (boundp 'mh-folder-mode-hook) mh-folder-mode-hook)
706: (funcall mh-folder-mode-hook)))
707:
708:
709: (defun mh-scan-folder (folder range)
710: "Scan the folder FOLDER over the range RANGE."
711: (mh-make-folder folder)
712: (mh-regenerate-headers range)
713: (when (looking-at "scan: no messages ")
714: (let ((buffer-read-only nil))
715: (erase-buffer))
716: (if (string= range "all")
717: (message "Folder +%s is empty" folder)
718: (message "No messages in +%s, range %s" folder range))
719: (sit-for 5))
720: (setq mode-line-format (mh-make-mode-line))
721: (mh-unmark-all-headers nil)
722: (mh-position-to-current))
723:
724:
725: (defun mh-regenerate-headers (range)
726: "Replace buffer with scan of its contents over range RANGE."
727: (let ((buffer-read-only nil))
728: (message (format "scanning %s..." (buffer-name)))
729: (delete-other-windows)
730: (erase-buffer)
731: (mh-exec-cmd-output "scan" (buffer-name) range)
732: (goto-char (dot-min))
733: (message (format "scanning %s...done" (buffer-name)))
734: ))
735:
736:
737: (defun mh-get-new-mail ()
738: "Read new mail into the current buffer."
739: (let ((buffer-read-only nil))
740: (message (format "inc %s..." (buffer-name)))
741: (goto-char (dot-max))
742: (set-mark (dot))
743: (mh-exec-cmd-output "inc")
744: (message (format "inc %s...done" (buffer-name)))
745: (goto-char (mark))
746: (cond ((looking-at "inc: no mail")
747: (kill-line 1)
748: (message "No new mail")
749: (sit-for 5))
750: (t
751: (kill-line 2))))
752: (setq mode-line-format (mh-make-mode-line)))
753:
754:
755: (defun mh-make-mode-line ()
756: "Returns a string for mode-line-format."
757: (save-excursion
758: (goto-char (dot-min))
759: (set-mark (dot))
760: (goto-char (dot-max))
761: (let ((lines (count-lines (dot) (mark))))
762: (goto-char (dot-min))
763: (let ((first (mh-get-msg-num nil))
764: (case-fold-search nil))
765: (re-search-forward "[ ]*[0-9]*\\+" nil t)
766: (let ((current (mh-get-msg-num nil)))
767: (goto-char (dot-max))
768: (previous-line 1)
769: (let ((last (mh-get-msg-num nil)))
770: (concat "{%b} %[" lines " messages"
771: (if (> lines 0)
772: (concat " (" first " - " last ")")
773: "")
774: (if current
775: (concat " cur = " current)
776: "")
777: "%] ")))))))
778:
779:
780: (defun mh-unmark-all-headers (remove-all-flags)
781: "This function removes all + flags from the headers, and if called
782: with a non-nil argument, removes all D and ^ flags too."
783: (switch-to-buffer mh-folder-buffer)
784: (let ((buffer-read-only nil)
785: (case-fold-search nil))
786: (goto-char (dot-min))
787: (while (if remove-all-flags
788: (re-search-forward "^....\\+" nil t)
789: (re-search-forward "^\\D\\|^\\^\\|^....\\+" nil t))
790: (delete-backward-char 1)
791: (insert " "))))
792:
793:
794: (defun mh-position-to-current ()
795: "Position the cursor at the current message."
796: (let ((curmsg (mh-get-cur-msg mh-folder-filename)))
797: (when (or (zerop curmsg) (mh-goto curmsg t))
798: (message "No message %s" curmsg)
799: (goto-char (dot-max))
800: (forward-line -1))
801: (when (looking-at "[ ]+[0-9]+")
802: (mh-notate ?+ 0)
803: (recenter 0))))
804:
805:
806: (defun mh-pack-folder ()
807: "Closes and packs the current folder."
808: (let ((buffer-read-only nil))
809: (message "closing folder...")
810: (mh-process-commands mh-folder-buffer)
811: (message "packing folder...")
812: (mh-exec-cmd "folder" mh-folder-buffer "-pack")
813: (mh-regenerate-headers "all")
814: (message "packing done"))
815: (setq mode-line-format (mh-make-mode-line)))
816:
817:
818: (defun mh-apply-to-message-list (func list)
819: "Apply function FUNC to each item in a message-list LIST,
820: passing the name and list of messages as arguments."
821: (mapcar (function (lambda (l) (apply func (list (car l) (cdr l))))) list))
822:
823:
824: (defun mh-process-commands (buffer)
825: "Process outstanding commands for the buffer BUFFER."
826: (message "Processing deletes and moves...")
827: (switch-to-buffer buffer)
828: (let ((buffer-read-only nil))
829: ;; Sequences must be first
830: (mh-process-seq-commands mh-seq-list)
831:
832: ;; Then refile messages
833: (mh-apply-to-message-list
834: (function (lambda (dest msgs)
835: (apply 'mh-exec-cmd
836: (nconc (cons "refile" msgs)
837: (list "-src" (format "%s" buffer)
838: (format "+%s" dest))))))
839: mh-move-list)
840:
841: ;; Now delete messages
842: (if mh-delete-list
843: (apply 'mh-exec-cmd
844: (nconc (list "rmm" (format "%s" buffer)) mh-delete-list)))
845:
846: ;; Finally update unseen sequence
847: (if mh-shown-msgs
848: (apply 'mh-exec-cmd-no-wait
849: (nconc (list "show" (format "%s" buffer))
850: mh-shown-msgs
851: (list "-noformat"))))
852:
853: (setq mh-delete-list nil
854: mh-move-list nil
855: mh-seq-list nil
856: mh-shown-msgs nil))
857: (message "Processing deletes and moves...done"))
858:
859:
860:
861: ;;; Routines for editing a message.
862:
863: (defun mh-letter-mode ()
864: "Mode for composing letters in mh.
865: ^N and ^P work normally in the body of a letter but hug the end of field names
866: in the header.
867: ^X^C exits and sends a letter."
868: (text-mode)
869: (if mh-auto-fill-letters
870: (auto-fill-mode 1))
871: (setq paragraph-separate "^[- \t\^L]*$")
872: (setq paragraph-start "^$\\|^\^L\\|^-+$")
873: (when (not mh-letter-mode-map)
874: (setq mh-letter-mode-map (copy-sequence text-mode-map))
875: (define-key mh-letter-mode-map "\^N" 'mh-header-next)
876: (define-key mh-letter-mode-map "\^P" 'mh-header-previous))
877: (use-local-map mh-letter-mode-map)
878: (setq major-mode 'mh-letter-mode)
879: (setq mode-name "mh-letter")
880: (if (and (boundp 'mh-letter-mode-hook) mh-letter-mode-hook)
881: (funcall mh-letter-mode-hook)))
882:
883:
884: (defun mh-header-next (&optional arg)
885: "Modified ^N command that skips to end of header field names."
886: (interactive "p")
887: (next-line (if arg arg 1))
888: (mh-header-line-position))
889:
890:
891: (defun mh-header-previous (&optional arg)
892: "Modified ^P command that skips to end of header field names."
893: (interactive "p")
894: (previous-line (if arg arg 1))
895: (mh-header-line-position))
896:
897:
898: (defun mh-dot-in-header ()
899: "t iff cursor in message header."
900: (save-excursion
901: (let ((wasdot (dot))
902: (case-fold-search nil))
903: (goto-char (dot-min))
904: (re-search-forward "^-*$" nil t)
905: (beginning-of-line)
906: (backward-char 1)
907: (>= (dot) wasdot))))
908:
909:
910: (defun mh-header-line-position ()
911: "Position cursor at end of field name when in header."
912: (if (mh-dot-in-header)
913: (when (save-excursion (beginning-of-line) (not (looking-at " \\|\t")))
914: (beginning-of-line)
915: (search-forward ":" nil t)
916: (if (eolp)
917: (insert " ")
918: (while (looking-at "[ \t]") (forward-char 1))))))
919:
920:
921:
922: ;;; Routines to make a search pattern and search for a message.
923:
924: (defun mh-get-pick-pattern (buffer)
925: "Prompt the user for a pattern to search for in messages. Upon return,
926: current buffer contains the filled-in template."
927: (save-window-excursion
928: (pop-to-buffer buffer)
929: (if (or (zerop (buffer-size))
930: (not (y-or-n-p "Reuse pattern? ")))
931: (mh-pick-template)
932: (message ""))
933: (local-set-key "\^X\^C" 'mh-make-pick-pattern)
934: (let ((mode-line-format "{%b}\tPick Pattern\t^X^C to exit and search"))
935: (catch 'mh-pattern (recursive-edit)))))
936:
937:
938: (defun mh-make-pick-pattern ()
939: (interactive)
940: (goto-char (dot-min))
941: (throw 'mh-pattern nil))
942:
943:
944: (defun mh-pick-template ()
945: (erase-buffer)
946: (insert "From: \n"
947: "To: \n"
948: "Cc: \n"
949: "Date: \n"
950: "Subject: \n"
951: "---------\n")
952: (goto-char (dot-min))
953: (end-of-line)
954: (mh-letter-mode))
955:
956:
957: (defun mh-next-pick-field (buffer)
958: "Return a pattern to search for messages containing the next field, or NIL
959: if no fields remain."
960: (save-excursion
961: (pop-to-buffer buffer)
962: (let ((pat ())
963: (case-fold-search t))
964: (cond ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
965: (region-around-match 1)
966: (let ((component (concat "-" (downcase (region-to-string)))))
967: (region-around-match 2)
968: (setq pat (nconc (list component (region-to-string)) pat)))
969: (forward-line 1)
970: pat)
971: ((re-search-forward "^-*$" nil t)
972: (forward-char 1)
973: (set-mark (dot))
974: (goto-char (dot-max))
975: (let ((body (region-to-string)))
976: (if (> (length body) 0)
977: (list "-search" body)
978: nil)))
979: (t
980: nil)))))
981:
982:
983:
984: ;;; Routines compose and send a letter.
985:
986: (defun mh-compose-and-send-mail (send-args)
987: "Edit a draft message and send or save it. SEND-ARGS is passed to the
988: send command. Returns t if mail is being sent."
989: (save-window-excursion
990: (pop-to-buffer "draft")
991: (mh-letter-mode)
992: (local-set-key "\^X\^C" 'mh-send-letter)
993: (local-set-key "\^X\^Y" 'mh-insert-letter)
994: (mh-header-line-position)
995: (let ((mode-line-format
996: "{%b} %[Mail/draft%] (%p - %m) (^X^C to finish ^X^Y to yank msg)
997: %M"))
998: (catch 'mail-send (recursive-edit)))))
999:
1000:
1001: (defun mh-send-letter ()
1002: "Prompt the user as to the disposition of the just-composed letter."
1003: (interactive)
1004: (save-buffer)
1005: (let ((mode-line-format "{%b} %[Mail/draft%] (%p - %m) %M")
1006: (action (mh-get-response
1007: "Ready to send. Action (s, q, e, ?): "
1008: '(?s ?b ?q ?e ?\^C)
1009: "S-end, Q-uit, E-dit ")))
1010: (cond ((equal action ?s)
1011: (message "Sending...")
1012: (mh-exec-cmd-no-wait "send" "-push" "-unique" send-args
1013: (buffer-file-name))
1014: (message "Sending...done")
1015: (throw 'mail-send t))
1016:
1017: ((equal action ?q)
1018: (message "Not sent... Message remains in buffer draft")
1019: (throw 'mail-send nil)))))
1020:
1021:
1022: (defun mh-insert-letter ()
1023: "Insert a message in the current letter."
1024: (interactive)
1025: (let ((folder (mh-get-folder-name "Message from" mh-current-folder nil))
1026: (message (string-to-int (read-input "Message number: " ""))))
1027: (insert-file-contents (concat mh-user-path folder "/" message))))
1028:
1029:
1030:
1031: ;;; Commands to manipulate sequences.
1032:
1033: (defmacro mh-seq-name (pair)
1034: (list 'car pair))
1035:
1036: (defmacro mh-seq-msgs (pair)
1037: (list 'cdr pair))
1038:
1039:
1040: (defun mh-seq-to-msgs (seq)
1041: "Returns the list of messages in sequence SEQ."
1042: (mh-seq-msgs (assoc seq mh-seq-list)))
1043:
1044:
1045: (defun mh-read-seq (prompt)
1046: "Prompt the user with PROMPT and read a sequence name."
1047: (mh-letter-to-seq
1048: (string-to-char (read-string (format "%s %s" prompt "sequence: ")))))
1049:
1050:
1051: (defun mh-seq-from-command (seq command)
1052: "Make a sequence called SEQ by executing the form COMMAND."
1053: (let ((msgs ())
1054: (case-fold-search t))
1055: (save-window-excursion
1056: (apply 'mh-exec-cmd-quiet command)
1057: (pop-to-buffer " *mh-temp*")
1058: (goto-char (dot-min))
1059: (while (re-search-forward "\\([0-9]+\\)" nil t)
1060: (region-around-match 0) ; BUG in GNU EMACS: should be 1!
1061: (let ((num (string-to-int (region-to-string))))
1062: (if (not (zerop num))
1063: (push num msgs)))))
1064:
1065: (push (cons seq msgs) mh-seq-list)
1066: msgs))
1067:
1068:
1069: (defun mh-remove-seq (seq)
1070: "Delete the sequence SEQ."
1071: (let ((entry (assoc seq mh-seq-list)))
1072: (setq mh-seq-list (delq (car entry) mh-seq-list))
1073: (mh-apply-to-seq (mh-seq-msgs (car entry)) 'mh-notate ? 0)))
1074:
1075:
1076: (defun mh-remove-msg-from-seq (msg-num seq)
1077: "Remove a message MSG-NUM from the sequence SEQ."
1078: (let ((seq (assoc seq mh-seq-list)))
1079: (setcdr (car seq) (delq msg-num (mh-seq-msgs (car seq)))))
1080: (mh-notate ? mh-cmd-note))
1081:
1082:
1083: (defun mh-add-msg-to-seq (msg-num seq)
1084: "Add a message MSG-NUM to a sequence SEQ."
1085: (let ((seq-list (assoc seq mh-seq-list)))
1086: (mh-notate (mh-seq-to-notation seq) 0)
1087: (if (null seq-list)
1088: (push (cons seq (list msg-num)) mh-seq-list)
1089: (setcdr seq-list (cons msg-num (cdr seq-list))))))
1090:
1091:
1092:
1093: (defun mh-new-seq ()
1094: "Return a new sequence name."
1095: (save-excursion
1096: (switch-to-buffer mh-folder-buffer)
1097: (if (= mh-next-seq-num 10)
1098: (error "No more sequences"))
1099: (setq mh-next-seq-num (+ mh-next-seq-num 1))
1100: (mh-letter-to-seq (+ (1- mh-next-seq-num) ?a))))
1101:
1102:
1103: (defun mh-letter-to-seq (letter)
1104: "Given a LETTER, return a string that is a valid sequence name."
1105: (cond ((and (>= letter ?0) (< letter ?9))
1106: (intern (concat "mhe" (char-to-string letter))))
1107: ((and (>= letter ?a) (< letter ?z))
1108: (intern (concat "mhe" (char-to-string letter))))
1109: (t
1110: (error "A sequence is named 0...9"))))
1111:
1112:
1113: (defun mh-seq-to-notation (seq)
1114: "Return the string used to indicate sequence SEQ in a scan listing."
1115: (string-to-char (substring (symbol-name seq) 3 4)))
1116:
1117:
1118: (defun mh-notate-seq (seq notation offset)
1119: "Mark all messages in the sequence SEQ with the NOTATION at character
1120: OFFSET."
1121: (mh-apply-to-seq seq 'mh-notate notation offset))
1122:
1123:
1124: (defun mh-apply-to-seq (seq function &rest args)
1125: "For each message in sequence SEQ, evaluate the FUNCTION with ARGS."
1126: (mapcar (function (lambda (msg) (mh-goto msg) (apply function args)))
1127: (mh-seq-to-msgs seq)))
1128:
1129:
1130: (defun mh-process-seq-commands (seq-list)
1131: "Process outstanding sequence commands for the sequences in SEQ-LIST."
1132: (mh-apply-to-message-list
1133: (function (lambda (seq msgs)
1134: (apply 'mh-exec-cmd-quiet
1135: (nconc (list "mark" "-zero" "-seq" (format "%s" seq)
1136: "-add")
1137: msgs))))
1138: seq-list))
1139:
1140:
1141:
1142: ;;; Issue commands to mh.
1143:
1144: (defun mh-exec-cmd (command &rest args)
1145: "Execute MH command COMMAND with ARGS. Any output is shown to the user."
1146: (save-excursion
1147: (pop-to-buffer " *mh-temp*")
1148: (erase-buffer)
1149: (set-mark (dot))
1150: (apply 'call-process (nconc (list (concat mh-progs command) nil t nil)
1151: (mh-list-to-string args)))
1152: (when (> (buffer-size) 0)
1153: (message "%s" (region-to-string))
1154: (sit-for 5))))
1155:
1156:
1157: (defun mh-exec-cmd-quiet (command &rest args)
1158: "Execute MH command COMMAND with ARGS. Output is collected, but not shown
1159: to the user."
1160: (pop-to-buffer " *mh-temp*")
1161: (erase-buffer)
1162: (set-mark (dot))
1163: (apply 'call-process (nconc (list (concat mh-progs command) nil t nil)
1164: (mh-list-to-string args))))
1165:
1166:
1167: (defun mh-exec-cmd-output (command &rest args)
1168: "Execute MH command COMMAND with ARGS putting the output into the current
1169: buffer."
1170: (apply 'call-process (nconc (list (concat mh-progs command) nil t nil)
1171: (mh-list-to-string args))))
1172:
1173:
1174: (defun mh-exec-cmd-no-wait (command &rest args)
1175: "Execute MH command COMMAND with ARGS and do not wait until it finishes."
1176: (apply 'call-process (nconc (list (concat mh-progs command) nil 0 nil)
1177: (mh-list-to-string args))))
1178:
1179:
1180: (defun mh-list-to-string (l)
1181: "Flattens the list L and makes every element a string."
1182: (let ((new-list nil))
1183: (while l
1184: (cond ((symbolp (car l)) (push (format "%s" (car l)) new-list))
1185: ((numberp (car l)) (push (format "%d" (car l)) new-list))
1186: ((string= (car l) ""))
1187: ((stringp (car l)) (push (car l) new-list))
1188: ((null (car l)))
1189: ((listp (car l)) (setq new-list
1190: (nconc (mh-list-to-string (car l))
1191: new-list)))
1192: (t (error "Bad argument %s" (car l))))
1193: (setq l (cdr l)))
1194: (nreverse new-list)))
1195:
1196:
1197:
1198: ;;; Commands to annotate a message.
1199:
1200: (defun mh-annotate (note &rest args)
1201: "Mark the current message with the character NOTE and annotate the message
1202: with ARGS."
1203: (apply 'mh-exec-cmd-no-wait (cons "anno" args))
1204: (mh-notate note 5))
1205:
1206:
1207: (defun mh-notate (notation offset)
1208: "Marks the current message with the character NOTATION at position OFFSET."
1209: (save-excursion
1210: (pop-to-buffer mh-folder-buffer)
1211: (let ((buffer-read-only nil))
1212: (beginning-of-line)
1213: (goto-char (+ (dot) offset))
1214: (delete-char 1)
1215: (insert notation)
1216: (beginning-of-line))))
1217:
1218:
1219:
1220: ;;; User prompting commands.
1221:
1222: (defun mh-get-folder-name (prompt default can-create)
1223: "Prompt for a folder name with PROMPT. DEFAULT is the default folder.
1224: If the CAN-CREATE flag is t, then the folder can be made if it does not exist."
1225: (let ((exists nil)
1226: (prompt (concat prompt " folder"
1227: (if (string= "" default)
1228: "? "
1229: (concat " [" default "]? "))))
1230: (file-name))
1231: (let ((name))
1232: (while (not exists)
1233: (setq name (read-string prompt))
1234: (if (string= name "")
1235: (setq name default))
1236: (if (string= (substring name 0 1) "+")
1237: (setq name (substring name 1)))
1238: (if (not (string= (substring name 0 1) "/"))
1239: (setq file-name (concat mh-user-path name))
1240: (setq file-name name))
1241: (setq exists (file-exists-p file-name))
1242: (if (not exists)
1243: (cond ((and can-create
1244: (y-or-n-p (concat "Folder +" name
1245: " does not exist. Create it? ")))
1246: (message "Creating %s" name)
1247: (call-process "mkdir" nil nil nil file-name)
1248: (message "Creating %s...done" name)
1249: (setq exists t))
1250:
1251: (can-create
1252: (error ""))
1253:
1254: (t
1255: (setq prompt (concat "Sorry, no such folder as `" name
1256: "' Folder name? "))))))
1257: name)))
1258:
1259:
1260: (defun mh-get-response (prompt possibilities help)
1261: "Prints PROMPT, reads a character, and checks it against the list
1262: of POSSIBILITIES. Returns the character if it is legal. The HELP string
1263: is displayed if the character is not legal."
1264: (let ((ok nil)
1265: (first-char))
1266: (while (not ok)
1267: (let ((pos possibilities))
1268: (message prompt)
1269: (setq first-char (read-char))
1270: (while (and (not ok) pos)
1271: (if (equal first-char (car pos))
1272: (setq ok t))
1273: (setq pos (cdr pos)))
1274:
1275: (cond ((equal first-char ??)
1276: (message help)
1277: (sit-for 5))
1278: ((not ok)
1279: (message "Illegal response '%c'" first-char)
1280: (sit-for 5)))))
1281: first-char))
1282:
1283:
1284:
1285: ;;; Misc. functions.
1286:
1287: (defun mh-get-msg-num (error-if-no-message)
1288: "Returns the message number of the current message. If the argument
1289: ERROR-IF-NO-MESSAGE is t, then complain if the cursor is not pointing to a
1290: message."
1291: (save-excursion
1292: (switch-to-buffer mh-folder-buffer)
1293: (beginning-of-line)
1294: (cond ((looking-at "^\+?\\([0-9]+\\)")
1295: (region-around-match 1)
1296: (string-to-int (region-to-string)))
1297: ((looking-at "^\+?[0-9a-z]?[ ]+\\([0-9]+\\)")
1298: (region-around-match 1)
1299: (string-to-int (region-to-string)))
1300: (error-if-no-message
1301: (error "Cursor not pointing to message"))
1302: (t nil))))
1303:
1304:
1305: (defun mh-msg-filename ()
1306: "Returns a string containing the pathname for a message."
1307: (save-excursion
1308: (switch-to-buffer mh-folder-buffer)
1309: (concat mh-folder-filename (mh-get-msg-num t))))
1310:
1311:
1312: (defun mh-msg-filenames (msgs folder)
1313: "Returns an arglist for ls specifying the messages MSGS in folder FOLDER."
1314: (if msgs
1315: (let ((args (concat folder "{")))
1316: (while (cdr msgs)
1317: (setq args (concat args (car msgs) ","))
1318: (setq msgs (cdr msgs)))
1319: (concat args (car msgs) "}"))
1320: ""))
1321:
1322:
1323: (defun mh-find-path ()
1324: "Set mh_path from ~/.mh_profile."
1325: (save-window-excursion
1326: (if (not (file-exists-p "~/.mh_profile"))
1327: (error "Can find .mh_profile file."))
1328: (switch-to-buffer " *mh_profile*")
1329: (erase-buffer)
1330: (insert-file-contents "~/.mh_profile")
1331: (if (string= (setq mh-user-path (mh-get-field "Path:")) "")
1332: (setq mh-user-path "Mail/")
1333: (setq mh-user-path (concat mh-user-path "/")))
1334: (if (not (string= (substring mh-user-path 0 1) "/"))
1335: (setq mh-user-path (concat (getenv "HOME") "/" mh-user-path)))))
1336:
1337:
1338: (defun mh-get-cur-msg (folder)
1339: "Returns the cur message from FOLDER."
1340: (let ((seq-filename (concat folder ".mh_sequences")))
1341: (save-window-excursion
1342: (cond ((file-exists-p seq-filename)
1343: (switch-to-buffer " *mh_sequences*")
1344: (erase-buffer)
1345: (insert-file-contents seq-filename)
1346: (string-to-int (mh-get-field "cur: ")))
1347: (t 0)))))
1348:
1349:
1350: (defun mh-get-field (field)
1351: "Get the value of field FIELD in the current buffer."
1352: (let ((case-fold-search t))
1353: (goto-char (dot-min))
1354: (cond ((not (search-forward field nil t)) "")
1355: (t
1356: (re-search-forward "[\t ]*\\([a-zA-z0-9/].*\\)$" nil t)
1357: (region-around-match 1)
1358: (let ((field (region-to-string)))
1359: (set-mark (dot))
1360: (forward-line)
1361: (while (looking-at "[ \t]") (forward-line 1))
1362: (backward-char 1)
1363: (concat field (region-to-string)))))))
1364:
1365:
1366: (defun mh-insert-fields (&rest name-values)
1367: "Insert the NAME-VALUE pairs in the current buffer."
1368: (let ((case-fold-search t))
1369: (while name-values
1370: (let ((field-name (car name-values))
1371: (value (cadr name-values)))
1372: (goto-char (dot-min))
1373: (cond ((not (search-forward (concat "\n" field-name) nil t))
1374: (search-forward "---")
1375: (beginning-of-line)
1376: (insert field-name " " value "\n"))
1377: (t
1378: (end-of-line)
1379: (insert " " value)))
1380: (setq name-values (cddr name-values))))))
1381:
1382:
1383:
1384: ;;; Build the keymap for mh:
1385:
1386: (defvar mh-keymap (make-sparse-keymap))
1387:
1388: (define-key mh-keymap "?" 'mh-summary)
1389: (define-key mh-keymap "c" 'mh-copy-msg)
1390: (define-key mh-keymap "d" 'mh-delete-msg)
1391: (define-key mh-keymap "^" 'mh-move-msg)
1392: (define-key mh-keymap "!" 'mh-re-move)
1393: (define-key mh-keymap "u" 'mh-undo)
1394: (define-key mh-keymap "l" 'mh-print-msg)
1395: (define-key mh-keymap "p" 'mh-previous-line)
1396: (define-key mh-keymap "n" 'mh-next-line)
1397: (define-key mh-keymap "g" 'mh-goto)
1398: (define-key mh-keymap " " 'scroll-other-window)
1399: (define-key mh-keymap "\e " 'mh-page-digest)
1400: (define-key mh-keymap "\^H" 'mh-previous-page)
1401: (define-key mh-keymap "t" 'mh-toggle-summarize)
1402: (define-key mh-keymap "." 'mh-show)
1403: (define-key mh-keymap "a" 'mh-answer)
1404: (define-key mh-keymap "f" 'mh-forward)
1405: (define-key mh-keymap "r" 'mh-redistribute)
1406: (define-key mh-keymap "s" 'mh-send)
1407: (define-key mh-keymap "\^X\^C" 'mh-quit)
1408: (define-key mh-keymap "q" 'mh-quit)
1409: (define-key mh-keymap "e" 'mh-exit)
1410: (define-key mh-keymap "0" 'mh-indicate-seq)
1411: (define-key mh-keymap "1" 'mh-indicate-seq)
1412: (define-key mh-keymap "2" 'mh-indicate-seq)
1413: (define-key mh-keymap "3" 'mh-indicate-seq)
1414: (define-key mh-keymap "4" 'mh-indicate-seq)
1415: (define-key mh-keymap "5" 'mh-indicate-seq)
1416: (define-key mh-keymap "6" 'mh-indicate-seq)
1417: (define-key mh-keymap "7" 'mh-indicate-seq)
1418: (define-key mh-keymap "8" 'mh-indicate-seq)
1419: (define-key mh-keymap "9" 'mh-indicate-seq)
1420: (define-key mh-keymap "\ef" 'mh-visit-folder)
1421: (define-key mh-keymap "\ei" 'mh-inc-folder)
1422: (define-key mh-keymap "\ec" 'mh-close-folder)
1423: (define-key mh-keymap "\ek" 'mh-kill-folder)
1424: (define-key mh-keymap "\el" 'mh-list-folders)
1425: (define-key mh-keymap "\ep" 'mh-renumber-folder)
1426: (define-key mh-keymap "\er" 'mh-rescan-folder)
1427: (define-key mh-keymap "\es" 'mh-search-folder)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.