Annotation of 43BSD/contrib/emacs/lisp/mh-e.el, revision 1.1.1.1

1.1       root        1: ;;;  mh-e.el   (Version: 3.3c for GNU Emacs Version 17 and MH.5 and MH.6)
                      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: (defvar mh-rejected-letter-start "^   ----- Unsent message follows -----$"
                     79:   "Regexp specifying the beginning of the wrapper around a letter returned
                     80: by the mail system.")
                     81: (defvar mh-good-msg-regexp  "^....[^D^]"
                     82:   "Regexp specifiying the scan lines that are 'good' messages")
                     83: 
                     84: ;;; Global variables:
                     85: 
                     86: (defvar mh-user-path  ""            "User's mail folder.")
                     87: (defvar mh-last-destination nil             "Destination of last "move" command.")
                     88: (defvar mh-folder-mode-map (make-sparse-keymap) "Keymap for MH folders.")
                     89: (defvar mh-letter-mode-map (make-sparse-keymap) "Keymap for composing mail.")
                     90: (defvar mh-pick-mode-map (make-sparse-keymap) "Keymap for searching folder.")
                     91: (defvar mh-folder-list nil          "List of folder names for completion.")
                     92: 
                     93: ;;; Macros and generic functions:
                     94: 
                     95: (defmacro push (v l)
                     96:   (list 'setq l (list 'cons v l)))
                     97: 
                     98: (defmacro caar (l)
                     99:   (list 'car (list 'car l)))
                    100: 
                    101: (defmacro cadr (l)
                    102:   (list 'car (list 'cdr l)))
                    103: 
                    104: (defmacro cdar (l)
                    105:   (list 'cdr (list 'car l)))
                    106: 
                    107: (defmacro cddr (l)
                    108:   (list 'cdr (list 'cdr l)))
                    109: 
                    110: (defmacro when (pred &rest body)
                    111:   (list 'cond (cons pred body)))
                    112: 
                    113: (defun mapc (func list)
                    114:   (while list
                    115:     (funcall func (car list))
                    116:     (setq list (cdr list))))
                    117: 
                    118: 
                    119: 
                    120: ;;; Entry points:
                    121: 
                    122: (defun mh-rmail (&optional arg)
                    123:   "Inc(orporate) new mail if optional ARG omitted, or scan a MH mail box
                    124: if arg is present.  This front end uses the MH mail system, which uses
                    125: different conventions from the usual mail system."
                    126:   (interactive "P")
                    127:   (mh-find-path)
                    128:   (if (null mh-folder-list)
                    129:       (setq mh-folder-list (mh-make-folder-list)))
                    130:   (cond (arg
                    131:         (let ((folder (mh-prompt-for-folder "mh" "+inbox" t))
                    132:               (range (read-string "Range [all]? ")))
                    133:           (mh-scan-folder folder (if (equal range "") "all" range))
                    134:           (delete-other-windows)))
                    135:        (t
                    136:         (mh-inc-folder))))
                    137: 
                    138: 
                    139: (defun mh-smail ()
                    140:   "Send mail using the MH mail system."
                    141:   (interactive)
                    142:   (mh-find-path)
                    143:   (call-interactively 'mh-send))
                    144: 
                    145: 
                    146: 
                    147: ;;; User executable mh-e commands:
                    148: 
                    149: 
                    150: (defun mh-answer (&optional arg)
                    151:   "Answer a letter.  If given a non-nil ARGUMENT, then include the current
                    152: message in the reply."
                    153:   (interactive "P")
                    154:   (let ((msg-filename (mh-msg-filename))
                    155:        (msg (mh-get-msg-num t))
                    156:        (minibuffer-help-form
                    157: "from => Sender\n  to => Sender and primary recipients\n  cc => Sender and all recipients")
                    158:        (folder mh-current-folder)
                    159:        (show-buffer mh-show-buffer))
                    160:     (let ((reply-to (completing-read
                    161:                     "Reply to whom: " '(("from") ("to") ("cc")) nil t)))
                    162:     (message "Composing a reply...")
                    163:     (cond ((or (equal reply-to "from") (equal reply-to ""))
                    164:           (apply 'mh-exec-cmd
                    165:                  (nconc
                    166:                   (list "repl" "-build" mh-current-folder msg "-nocc" "all")
                    167:                   (if arg (list "-filter" "mhl.reply")))))
                    168:          ((equal reply-to "to")
                    169:           (apply 'mh-exec-cmd
                    170:                  (nconc
                    171:                   (list "repl" "-build" mh-current-folder msg "-cc" "to")
                    172:                   (if arg (list "-filter" "mhl.reply")))))
                    173:          ((equal reply-to "cc")
                    174:           (apply 'mh-exec-cmd
                    175:                  (nconc
                    176:                   (list "repl" "-build" mh-current-folder msg "-cc" "all")
                    177:                   (if arg (list "-filter" "mhl.reply"))))))
                    178: 
                    179:     (mh-read-draft)
                    180:     (delete-other-windows)
                    181:     (when (or (zerop (buffer-size))
                    182:              (not (y-or-n-p "The file 'draft' exists.  Use for reply? ")))
                    183:       (erase-buffer)
                    184:       (insert-file-contents (format "%sreply" mh-user-path))
                    185:       (delete-file (format "%sreply" mh-user-path)))
                    186:     (set-buffer-modified-p nil)
                    187: 
                    188:     (let ((to (mh-get-field "To:"))
                    189:          (subject (mh-get-field "Subject:"))
                    190:          (cc (mh-get-field "Cc:")))
                    191:       (goto-char (point-min))
                    192:       (re-search-forward "^$" (point-max) nil)
                    193:       (if (not arg)
                    194:        (mh-display-msg msg msg-filename show-buffer))
                    195:       (mh-add-msg-to-seq msg "answered" t)
                    196:       (message "Composing a reply...done")
                    197:       (mh-compose-and-send-mail "" folder to subject cc "-" "Replied:")))))
                    198: 
                    199: 
                    200: (defun my-apply-command-to-seq (command)
                    201:   "Applies the next command to all messages in a sequence to be prompted for."
                    202:   (interactive "k")
                    203:   (funcall (key-binding command) (mh-read-seq "Apply to" mh-narrowed-to-seq)))
                    204: 
                    205: 
                    206: (defun mh-copy-msg (&optional seq)
                    207:   "Copy specified message(s) to another folder without deleting them.
                    208: Optional argument is a SEQUENCE name to copy."
                    209:   (interactive "P")
                    210:   (let ((msgs (if seq seq (mh-get-msg-num t))))
                    211:     (mh-exec-cmd "refile" msgs "-link" "-src" mh-current-folder
                    212:                 (mh-prompt-for-folder "Copy to" "" t))
                    213:     (if seq
                    214:        (mh-notate-seq msgs ?C mh-cmd-note)
                    215:        (mh-notate ?C mh-cmd-note))))
                    216: 
                    217: 
                    218: (defun mh-delete-msg (&optional seq)
                    219:   "Marks the specified message(s) for later deletion.  Optional argument is a
                    220: SEQUENCE name to  delete."
                    221:   (interactive "P")
                    222:   (if seq
                    223:       (mh-map-to-seq-msgs 'mh-delete-a-msg seq)
                    224:       (mh-delete-a-msg))
                    225:   (mh-next-msg))
                    226: 
                    227: 
                    228: (defun mh-delete-msg-from-seq (&optional arg)
                    229:   "Deletes a message from a sequence or, if optional ARG is non-nil, deletes
                    230: the sequence."
                    231:   (interactive "P")
                    232:   (if arg
                    233:       (mh-remove-seq (mh-read-seq "Delete"))
                    234:       (mh-remove-msg-from-seq (mh-get-msg-num t) (mh-read-seq "Delete from")))
                    235:   (mh-next-msg))
                    236: 
                    237: 
                    238: (defun mh-execute-commands ()
                    239:   "Process outstanding delete and move commands."
                    240:   (interactive)
                    241:   (if mh-narrowed-to-seq (mh-widen))
                    242:   (save-excursion
                    243:     (mh-process-commands mh-current-folder))
                    244:   (delete-other-windows)
                    245:   (setq mh-summarize t)
                    246:   (setq mode-name "Mh-Summary")
                    247:   (setq mode-line-format (mh-make-mode-line)))
                    248: 
                    249: 
                    250: (defun mh-extract-rejected-mail ()
                    251:   "Extract a letter returned by the mail system and make it resendable."
                    252:   (interactive "")
                    253:   (let ((msg-filename (format "%s%d" mh-folder-filename (mh-get-msg-num t))))
                    254:     (mh-read-draft)
                    255:     (when (or (zerop (buffer-size))
                    256:              (not (y-or-n-p "The file 'draft' exists.  Use it? ")))
                    257:       (erase-buffer)
                    258:       (insert-file-contents msg-filename))
                    259:     (goto-char (point-min))
                    260:     (re-search-forward mh-rejected-letter-start)
                    261:     (forward-char 1)
                    262:     (kill-region (point-min) (point))
                    263:     (let ((mh-invisible-headers "^Date:\\|^Received:\\|^Message-Id:\\|^From:"))
                    264:       (mh-clean-msg-header (point-min)))
                    265:     (goto-char (point-min))
                    266:     (switch-to-buffer mh-current-folder)
                    267:     (mh-compose-and-send-mail "" mh-current-folder (mh-get-field "To")
                    268:                              (mh-get-field "From") (mh-get-field "cc"))))
                    269: 
                    270: 
                    271: (defun mh-forward (&optional seq)
                    272:   "Forward a letter.  Optional argument is a SEQUENCE of messages to forward."
                    273:   (interactive "P")
                    274:   (let ((to (read-string "To: "))
                    275:        (cc (read-string "Cc: "))
                    276:        (msg-filename (mh-msg-filename))
                    277:        (msg (if seq seq (mh-get-msg-num t)))
                    278:        (folder mh-current-folder))
                    279:     (cond ((or (not (file-exists-p (format "%sdraft" mh-user-path)))
                    280:               (y-or-n-p "The file 'draft' exists.  Discard it? "))
                    281:           (mh-exec-cmd "forw" "-build" mh-current-folder msg)
                    282:           (mh-read-draft)
                    283:           (mh-insert-fields "To:" to "Cc:" cc)
                    284:           (set-buffer-modified-p nil))
                    285:          (t
                    286:           (mh-read-draft)))
                    287:     (goto-char (point-min))
                    288:     (re-search-forward "^------- Forwarded Message")
                    289:     (previous-line 1)
                    290:     (narrow-to-region (point) (point-max))
                    291:     (let* ((subject (save-excursion (mh-get-field "From:")))
                    292:           (trim (string-match "<" subject))
                    293:           (forw-subject (save-excursion (mh-get-field "Subject:"))))
                    294:       (if trim
                    295:          (setq subject (substring subject 0 (1- trim))))
                    296:       (widen)
                    297:       (save-excursion
                    298:        (mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject)))
                    299:       (delete-other-windows)
                    300:       (if seq
                    301:          (mh-add-msg-list-to-seq (mh-seq-to-msgs seq) "forwarded" t)
                    302:          (mh-add-msg-to-seq msg "forwarded" t))
                    303:       (mh-compose-and-send-mail "" folder to subject cc "F" "Forwarded:"))))
                    304: 
                    305: 
                    306: (defun mh-goto-msg (number &optional no-error-if-no-message)
                    307:   "Position the cursor at message NUMBER.  Do not signal an error if optional
                    308: ARG is t.  Return non-nil if cursor is at message."
                    309:   (interactive "nMessage number? ")
                    310:   (let ((starting-place (point)))
                    311:     (goto-char (point-min))
                    312:     (cond ((not (re-search-forward (mh-msg-search-pat number) nil t))
                    313:           (goto-char starting-place)
                    314:           (if (not no-error-if-no-message) (error "No message %d " number))
                    315:           nil)
                    316:          (t
                    317:           (beginning-of-line)
                    318:           (mh-maybe-show)
                    319:           t))))
                    320: 
                    321: 
                    322: (defun mh-inc-folder ()
                    323:   "inc(orporate) new mail into inbox."
                    324:   (interactive)
                    325:   (pop-to-buffer "+inbox")
                    326:   (if (or (not (boundp 'mh-current-folder)) (null mh-current-folder))
                    327:       (mh-make-folder "+inbox"))
                    328:   (if (mh-get-new-mail)
                    329:       (mh-show)))
                    330: 
                    331: 
                    332: (defun mh-kill-folder ()
                    333:   "Removes the current folder."
                    334:   (interactive)
                    335:   (if (yes-or-no-p (format "Remove folder %s? " mh-current-folder))
                    336:       (let ((folder mh-current-folder))
                    337:        (switch-to-buffer-other-window " *mh-temp*")
                    338:        (mh-exec-cmd "rmf" "-nointeractive" folder)
                    339:        (mh-remove-folder-from-folder-list folder)
                    340:        (message "Folder removed")
                    341:        (kill-buffer folder))
                    342:       (message "Folder not removed")))
                    343: 
                    344: 
                    345: (defun mh-list-folders ()
                    346:   "List mail folders."
                    347:   (interactive)
                    348:   (message "listing folders...")
                    349:   (switch-to-buffer-other-window " *mh-temp*")
                    350:   (erase-buffer)
                    351:   (mh-exec-cmd-output "folders")
                    352:   (goto-char (point-min))
                    353:   (message "listing folders...done"))
                    354: 
                    355: 
                    356: (defun mh-msg-is-in-seq ()
                    357:   "Displays the sequences that the current messages is in."
                    358:   (interactive)
                    359:   (let ((msg (mh-get-msg-num t))
                    360:        (l mh-seq-list)
                    361:        (seqs ""))
                    362:       (while l
                    363:        (if (memq msg (cdar l))
                    364:            (setq seqs (format "%s %s" (symbol-name (caar l)) seqs)))
                    365:        (setq l (cdr l)))
                    366:       (message "Message %d is in sequences: %s" msg seqs)))
                    367: 
                    368: 
                    369: (defun mh-move-msg (&optional seq)
                    370:   "Move specified message(s) to another folder.  Optional argument is a
                    371: SEQUENCE of messages to refile."
                    372:   (interactive "P")
                    373:   (setq mh-last-destination
                    374:        (cons 'move (intern (mh-prompt-for-folder "Destination" "" t))))
                    375:   (if seq
                    376:       (mh-map-to-seq-msgs 'mh-move-a-msg seq (cdr mh-last-destination))
                    377:       (mh-move-a-msg (cdr mh-last-destination)))
                    378:   (mh-next-msg))
                    379: 
                    380: 
                    381: (defun mh-move-or-write-again ()
                    382:   "Move or write the current message to same folder or file as the last move
                    383: or write."
                    384:   (interactive)
                    385:   (if (null mh-last-destination)
                    386:       (error "No previous move"))
                    387:   (cond ((eq (car mh-last-destination) 'move)
                    388:         (mh-move-a-msg (cdr mh-last-destination))
                    389:         (message "Destination folder: %s" (cdr mh-last-destination)))
                    390:        (t
                    391:         (mh-write-msg-to-file (cdr mh-last-destination))
                    392:         (message "Destination: %s" (cdr mh-last-destination))))
                    393:   (sit-for 3)
                    394:   (mh-next-msg))
                    395: 
                    396: 
                    397: (defun mh-narrow-to-seq ()
                    398:   "Restrict the display of the current folder to the messages in the sequence
                    399: to be prompted for.  Use \\[mh-widen] to undo this command."
                    400:   (interactive "")
                    401:   (let ((seq (mh-read-seq "Narrow to"))
                    402:        (eob (point-max))
                    403:        (buffer-read-only nil))
                    404:     (cond ((mh-seq-to-msgs seq)
                    405:           (mh-copy-seq-to-point seq eob)
                    406:           (narrow-to-region eob (point-max))
                    407:           (setq mode-line-format (mh-make-mode-line (symbol-name seq)))
                    408:           (recenter)
                    409:           (setq mh-narrowed-to-seq seq))
                    410:          (t
                    411:           (error "No messages in sequence `%s'" (symbol-name seq))))))
                    412: 
                    413: 
                    414: (defun mh-next-line (&optional arg)
                    415:   "Move to next undeleted message in window and display body if summary
                    416: flag set."
                    417:   (interactive "p")
                    418:   (forward-line (if arg arg 1))
                    419:   (setq mh-next-direction 'forward)
                    420:   (cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
                    421:         (beginning-of-line)
                    422:         (mh-maybe-show))
                    423:        (t
                    424:         (forward-line -1)
                    425:         (sit-for 2)
                    426:         (message "No more messages"))))
                    427: 
                    428: 
                    429: (defun mh-renumber-folder ()
                    430:   "Renumber messages in folder to be 1..N."
                    431:   (interactive)
                    432:   (message "packing buffer...")
                    433:   (mh-pack-folder)
                    434:   (mh-unmark-all-headers nil)
                    435:   (mh-goto-cur-msg)
                    436:   (message "packing buffer...done"))
                    437: 
                    438: 
                    439: (defun mh-page-digest ()
                    440:   "Advance displayed message to next digested message."
                    441:   (interactive)
                    442:   (save-excursion
                    443:     (switch-to-buffer-other-window mh-show-buffer)
                    444:     (move-to-window-line nil)
                    445:     (let ((case-fold-search nil))
                    446:       (when (not (search-forward "\nFrom:" nil t))
                    447:        (other-window -1)
                    448:        (error "No more messages")))
                    449:     (recenter 0)
                    450:     (other-window -1)))
                    451: 
                    452: 
                    453: (defun mh-page-msg (&optional arg)
                    454:   (interactive "P")
                    455:   (scroll-other-window arg))
                    456: 
                    457: 
                    458: (defun mh-previous-line (&optional arg)
                    459:   "Move to previous message in window and display body if summary flag set."
                    460:   (interactive "p")
                    461:   (setq mh-next-direction 'backward)
                    462:   (if (not (re-search-backward mh-good-msg-regexp nil 0 arg))
                    463:       (message "Beginning of messages")
                    464:       (mh-maybe-show)))
                    465: 
                    466: 
                    467: (defun mh-previous-page ()
                    468:   "Page the displayed message backwards."
                    469:   (interactive)
                    470:   (save-excursion
                    471:     (switch-to-buffer-other-window mh-show-buffer)
                    472:     (unwind-protect
                    473:        (scroll-down nil)
                    474:       (other-window -1))))
                    475: 
                    476: 
                    477: (defun mh-print-msg (&optional seq)
                    478:   "Print specified message(s) on a line printer.  Optional argument is a
                    479: SEQUENCE of messages to print."
                    480:   (interactive "P")
                    481:   (let ((msgs (if seq
                    482:                  (reverse (mh-seq-to-msgs seq))
                    483:                  (list (mh-get-msg-num t)))))
                    484:     (message "printing message...")
                    485:     (call-process shell-file-name nil 0 nil "-c"
                    486:                  (if seq
                    487:                      (format "(scan -clear %s ; %smhl -nobell -clear %s) | %s"
                    488:                              (mapconcat (function (lambda (msg) msg)) msgs " ")
                    489:                              mh-lib
                    490:                              (mh-msg-filenames msgs mh-folder-filename)
                    491:                              (format mh-lpr-command-format
                    492:                                      (if seq
                    493:                                          "Mail"
                    494:                                          (format "%s/%d" mh-current-folder
                    495:                                                  (mh-get-msg-num t)))))
                    496:                      (format "%smhl -nobell -clear %s | %s"
                    497:                              mh-lib
                    498:                              (mh-msg-filenames msgs mh-folder-filename)
                    499:                              (format mh-lpr-command-format
                    500:                                      (if seq
                    501:                                          "Mail"
                    502:                                          (format "%s/%d" mh-current-folder
                    503:                                                  (mh-get-msg-num t)))))))
                    504:     (if seq
                    505:        (mh-notate-seq msgs ?P mh-cmd-note)
                    506:        (mh-notate ?P mh-cmd-note))
                    507:     (mh-add-msg-list-to-seq msgs 'printed t)
                    508:     (message "printing message...done")))
                    509: 
                    510: 
                    511: (defun mh-put-msg-in-seq (&optional arg)
                    512:   "Add a message to a sequence or, if optional ARG is non-nil, add the
                    513: messages from a sequence to another sequence."
                    514:   (interactive "P")
                    515:   (if arg
                    516:       (mh-add-msg-list-to-seq (mh-seq-to-msgs
                    517:                               (mh-read-seq "Add messages from"))
                    518:                              (mh-read-seq "to"))
                    519:       (mh-add-msg-to-seq (mh-get-msg-num t) (mh-read-seq "Add to")))
                    520:   (mh-next-msg))
                    521: 
                    522: 
                    523: (defun mh-rescan-folder (&optional arg)
                    524:   "Rescan a folder after optionally processing the outstanding commands.  If
                    525: the optional argument is non-nil, then prompt for the range of messages to
                    526: display, otherwise assume the whole buffer."
                    527:   (interactive "P")
                    528:   (if (and (or mh-delete-list mh-move-list)
                    529:           (y-or-n-p "Process commands? "))
                    530:       (mh-process-commands mh-current-folder))
                    531:   (setq mh-next-direction 'forward)
                    532:   (mh-scan-folder mh-current-folder
                    533:                  (if arg (read-string "Range [all]? ") "all")))
                    534: 
                    535: 
                    536: (defun mh-redistribute (to cc)
                    537:   "Redistribute a letter."
                    538:   (interactive "sRedist-To: \nsRedist-Cc: ")
                    539:   (let ((msg-filename (mh-msg-filename))
                    540:        (msg (mh-get-msg-num t))
                    541:        (folder mh-current-folder))
                    542:     (save-window-excursion
                    543:       (mh-read-draft)
                    544:       (when (or (zerop (buffer-size))
                    545:                (not (y-or-n-p
                    546:                      "The file 'draft' exists.  Redistribute old version? ")))
                    547:        (erase-buffer)
                    548:        (insert-file-contents msg-filename))
                    549:       (re-search-forward "^$\\|^---")
                    550:       (insert "Resent-To: " to "\n")
                    551:       (if (not (equal cc ""))
                    552:          (insert "Resent-cc: " cc "\n"))
                    553:       (let ((mh-invisible-headers "^Message-Id:\\|^Received:\\|Return-Path:"))
                    554:        (mh-clean-msg-header (point-min)))
                    555:       (save-buffer)
                    556:       (message "Redistributing...")
                    557:       (call-process "/bin/sh" nil 0 nil "-c"
                    558:        (format "mhdist=1 mhaltmsg=%s %s/send -push %s/draft"
                    559:               msg-filename mh-progs mh-user-path))
                    560:       (mh-annotate-msg msg folder "R"
                    561:                       "-component" "Resent:"
                    562:                       "-text" (format "\"%s %s\"" to cc))
                    563:       (message "Redistributing...done"))))
                    564: 
                    565: 
                    566: (defun mh-write-msg-to-file (file)
                    567:   "Append the current message to the end of a file."
                    568:   (interactive "FSave message in file: ")
                    569:   (setq mh-last-destination (cons 'write file))
                    570:   (call-process shell-file-name nil 0 nil "-c"
                    571:                (format "cat %s >> %s " (mh-msg-filename) file)))
                    572: 
                    573: 
                    574: (defun mh-search-folder ()
                    575:   "Search the current folder for messages matching a pattern."
                    576:   (interactive)
                    577:   (let ((folder mh-current-folder))
                    578:     (switch-to-buffer-other-window "pick-pattern")
                    579:     (if (or (zerop (buffer-size))
                    580:            (not (y-or-n-p "Reuse pattern? ")))
                    581:        (mh-make-pick-template)
                    582:        (message ""))
                    583:     (setq mh-searching-folder folder)))
                    584: 
                    585: 
                    586: (defun mh-send (to cc subject)
                    587:   "Compose and send a letter."
                    588:   (interactive "sTo: \nsCc: \nsSubject: ")
                    589:   (let ((folder (if (boundp 'mh-current-folder) mh-current-folder)))
                    590:     (message "Composing a message...")
                    591:     (mh-read-draft)
                    592:     (delete-other-windows)
                    593:     (when (or (zerop (buffer-size))
                    594:              (not (y-or-n-p "The file 'draft' exists.  Use it? ")))
                    595:       (erase-buffer)
                    596:       (if (file-exists-p (format "%scomponents" mh-user-path))
                    597:          (insert-file-contents (format "%scomponents" mh-user-path))
                    598:          (if (file-exists-p (format "%scomponents" mh-lib))
                    599:              (insert-file-contents (format "%scomponents" mh-lib))
                    600:              (error "Can't find components")))
                    601:       (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
                    602:       (set-buffer-modified-p nil)
                    603:       (goto-char (point-max))
                    604:       (message "Composing a message...done"))
                    605:     (mh-compose-and-send-mail "" folder to subject cc)))
                    606: 
                    607: 
                    608: (defun mh-show ()
                    609:   "Show message indicated by cursor in scan buffer."
                    610:   (interactive)
                    611:   (setq mh-summarize nil)
                    612:   (setq mode-name "Mh-Show")
                    613:   (let ((msg-num (mh-get-msg-num t))
                    614:        (folder mh-current-folder))
                    615:     (mh-display-msg msg-num (mh-msg-filename) mh-show-buffer)
                    616: 
                    617:     ;; These contortions are to force the summary line to be the top window.
                    618:     (switch-to-buffer-other-window folder)
                    619:     (delete-other-windows)
                    620:     (switch-to-buffer-other-window mh-show-buffer)
                    621:     (switch-to-buffer-other-window folder)
                    622:     (shrink-window (- (window-height) mh-summary-height))
                    623:     (recenter 1)
                    624:     (push msg-num mh-seen-list)))
                    625: 
                    626: 
                    627: (defun mh-sort-folder ()
                    628:   "Sort the messages in the current folder by date."
                    629:   (interactive "")
                    630:   (mh-process-commands mh-current-folder)
                    631:   (setq mh-next-direction 'forward)
                    632:   (message "sorting folder...")
                    633:   (mh-exec-cmd "sortm" mh-current-folder)
                    634:   (message "sorting folder...done")
                    635:   (mh-scan-folder mh-current-folder "all"))
                    636: 
                    637: 
                    638: (defun mh-toggle-summarize ()
                    639:   "Turn the summary mode of displaying messages on or off."
                    640:   (interactive)
                    641:   (setq mh-summarize (not mh-summarize))
                    642:   (cond (mh-summarize
                    643:         (delete-other-windows)
                    644:         (setq mode-name "Mh-Summarize")
                    645:         (recenter (/ (window-height) 2)))
                    646:        (t
                    647:         (setq mode-name "Mh-Show")
                    648:         (mh-show))))
                    649: 
                    650: 
                    651: (defun mh-undo (&optional seq)
                    652:   "Undo the deletion or move of the specified message(s).  Optional argument
                    653: is a name of a sequence of messages to apply undo to."
                    654:   (interactive "P")
                    655:   (cond ((looking-at "^....D")
                    656:         (cond (seq
                    657:                (mapc (function (lambda (msg)
                    658:                                  (setq mh-delete-list
                    659:                                        (delq msg mh-delete-list))
                    660:                                  (mh-remove-msg-from-seq msg 'deleted)))
                    661:                      (mh-seq-to-msgs seq))
                    662:                (mh-notate-seq seq ?  mh-cmd-note))
                    663:               (t
                    664:                (let ((msg (mh-get-msg-num t)))
                    665:                  (setq mh-delete-list (delq msg mh-delete-list))
                    666:                  (mh-remove-msg-from-seq msg 'deleted)
                    667:                  (mh-notate ?  mh-cmd-note)))))
                    668: 
                    669:        ((looking-at "^....\\^")
                    670:         (cond (seq
                    671:                (mapc (function (lambda (msg)
                    672:                                  (mapc (function
                    673:                                         (lambda (dest)
                    674:                                           (mh-remove-msg-from-seq msg dest)))
                    675:                                        mh-move-list)))
                    676:                      (mh-seq-to-msgs seq))
                    677:                (mh-notate-seq seq ?  mh-cmd-note))
                    678:               (t
                    679:                (let ((msg (mh-get-msg-num t)))
                    680:                  (mapc (function (lambda (dest)
                    681:                                    (mh-remove-msg-from-seq msg dest)))
                    682:                        mh-move-list)
                    683:                  (mh-notate ?  mh-cmd-note)))))
                    684: 
                    685:        (t nil)))
                    686: 
                    687: 
                    688: (defun mh-undo-folder ()
                    689:   "Undo all commands in current folder."
                    690:   (interactive "")
                    691:   (cond ((yes-or-no-p "Undo all commands in folder? ")
                    692:         (setq mh-delete-list nil
                    693:               mh-move-list nil
                    694:               mh-seq-list nil
                    695:               mh-next-direction 'forward)
                    696:         (mh-unmark-all-headers t))
                    697:        (t
                    698:         (message "Commands not undone."))))
                    699: 
                    700: 
                    701: (defun mh-visit-folder (&optional arg)
                    702:   "Visit a new folder.  If optional argument is non-nil, then prompt for the
                    703: range of messages, otherwise scan the whole buffer."
                    704:   (interactive "p")
                    705:   (let ((folder (mh-prompt-for-folder "Visit" "" t))
                    706:        (range (if arg (read-string "Range [all]? ") "all")))
                    707:     (mh-scan-folder folder (if (equal range "") "all" range))
                    708:     (delete-other-windows)))
                    709: 
                    710: 
                    711: (defun mh-widen ()
                    712:   "Remove restrictions from the current folder, thereby showing all messages."
                    713:   (interactive "")
                    714:   (let ((buffer-read-only nil))
                    715:     (delete-region (point-min) (point-max))
                    716:     (widen)
                    717:     (setq mode-line-format (mh-make-mode-line)))
                    718:   (setq mh-narrowed-to-seq nil))
                    719: 
                    720: 
                    721: 
                    722: ;;; Support routines.
                    723: 
                    724: (defun mh-delete-a-msg ()
                    725:   "Delete the message pointed to by the cursor."
                    726:   (let ((msg (mh-get-msg-num t)))
                    727:     (if (looking-at "....\\^")
                    728:        (error "Message %d already moved.  Undo move before deleting." msg))
                    729:     (push msg mh-delete-list)
                    730:     (mh-add-msg-to-seq msg 'deleted t)
                    731:     (mh-notate ?D mh-cmd-note)))
                    732: 
                    733: 
                    734: (defun mh-move-a-msg (destination)
                    735:   "Move the message pointed to by the cursor."
                    736:   (if (looking-at "....D")
                    737:       (error "Message %d is already deleted.  Undo delete before moving."
                    738:             (mh-get-msg-num nil))
                    739:       (let ((msg (mh-get-msg-num t)))
                    740:        (if (not (memq destination mh-move-list))
                    741:            (push destination mh-move-list))
                    742:        (mh-add-msg-to-seq msg destination t)
                    743:        (mh-notate ?^ mh-cmd-note))))
                    744: 
                    745: 
                    746: (defun mh-display-msg (msg-num msg-filename show-buffer)
                    747:   "Displays the message NUMBER and PATHNAME in BUFFER."
                    748:   (if (not (file-exists-p msg-filename))
                    749:       (error "Message %d does not exist." msg-num))
                    750:   (switch-to-buffer show-buffer)
                    751:   (buffer-flush-undo (current-buffer))
                    752:   (when (not (equal msg-filename buffer-file-name))
                    753:     ;; Buffer does not yet contain message.
                    754:     (setq buffer-file-name msg-filename)
                    755:     (erase-buffer)
                    756:     (unlock-buffer)
                    757:     (if mh-use-mhl
                    758:        (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" msg-filename)
                    759:        (insert-file-contents msg-filename))
                    760:     (goto-char (point-min))
                    761:     (cond (mh-clean-message-header
                    762:           (mh-clean-msg-header (point-min))
                    763:           (goto-char (point-min)))
                    764:          (t
                    765:           (let ((case-fold-search t))
                    766:             (re-search-forward "^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
                    767:             (beginning-of-line)
                    768:             (recenter 0))))
                    769:     (set-buffer-modified-p nil)
                    770:     (setq mode-line-format
                    771:          (concat "{%b} %[%p of " folder "/" msg-num "%]        %M"))))
                    772: 
                    773: 
                    774: (defun mh-clean-msg-header (start)
                    775:   "Flush extraneous lines in a message header.  The variable
                    776: mh-invisible-headers contains a regular expression specifying these lines."
                    777:   (save-restriction
                    778:     (goto-char start)
                    779:     (search-forward "\n\n" nil t)
                    780:     (narrow-to-region start (point))
                    781:     (goto-char (point-min))
                    782:     (while (re-search-forward mh-invisible-headers nil t)
                    783:       (beginning-of-line)
                    784:       (kill-line 1)
                    785:       (while (looking-at "^[ \t]+")
                    786:        (beginning-of-line)
                    787:        (kill-line 1)))
                    788:     (unlock-buffer)))
                    789: 
                    790: 
                    791: (defun mh-read-draft ()
                    792:   "Read draft file into draft buffer.  Avoids errors even if disk file has been
                    793: modified underneath the buffer.  Causes an error if the folder is modified and
                    794: the user does not want to change it."
                    795:   (switch-to-buffer "draft")
                    796:   (if (buffer-modified-p)
                    797:       (if (y-or-n-p "Draft is modified; kill anyways? ")
                    798:          (set-buffer-modified-p nil)
                    799:          (error "Draft is not killed.")))
                    800:   (kill-buffer "draft")
                    801:   (switch-to-buffer-other-window
                    802:    (find-file-noselect (format "%sdraft" mh-user-path))))
                    803: 
                    804: 
                    805: (defun mh-next-msg ()
                    806:   "Move backward or forward to the next message in the buffer."
                    807:   (if (eq mh-next-direction 'forward)
                    808:       (mh-next-line 1)
                    809:       (mh-previous-line 1)))
                    810: 
                    811: 
                    812: (defun mh-maybe-show ()
                    813:   "If the scan listing is not summarized, show the message pointed to
                    814: by the cursor."
                    815:   (if (not mh-summarize) (mh-show)))
                    816: 
                    817: 
                    818: 
                    819: ;;; The folder data abstraction.
                    820: 
                    821: (defun mh-make-folder (name)
                    822:   "Create and initialize a new mail folder called NAME and make it the
                    823: current folder."
                    824:   (switch-to-buffer name)
                    825:   (buffer-flush-undo (current-buffer))
                    826:   (kill-all-local-variables)
                    827:   (setq buffer-read-only nil)
                    828:   (erase-buffer)
                    829:   (make-local-vars
                    830:    'mh-current-folder name             ;Name of folder
                    831:    'mh-show-buffer (format "show-%s" name) ; Buffer that displays messages
                    832:    'mh-folder-filename                 ; e.g. /usr/foobar/Mail/inbox/
                    833:      (format "%s%s/" mh-user-path (substring name 1))
                    834:    'mh-summarize t                     ; Show scan list only?
                    835:    'mh-next-seq-num 0                  ; Index of free sequence id
                    836:    'mh-delete-list nil                 ; List of msgs nums to delete
                    837:    'mh-move-list nil                   ; List of folder names in mh-seq-list
                    838:    'mh-seq-list nil                    ; Alist of seq . msgs nums
                    839:    'mh-seen-list nil                   ; List of displayed messages
                    840:    'mh-next-direction 'forward         ; Direction to move to next message
                    841:    'mh-narrowed-to-seq nil)            ; Sequence display is narrowed to
                    842:   (mh-folder-mode)
                    843:   (setq buffer-read-only t)
                    844:   (setq mode-name "Mh-Summarize"))
                    845: 
                    846: 
                    847: (defun make-local-vars (&rest pairs)
                    848:   "Takes VARIABLE-VALUE pairs and makes local variables initialized to the
                    849: value."
                    850:   (while pairs
                    851:     (make-local-variable (car pairs))
                    852:     (set (car pairs) (cadr pairs))
                    853:     (setq pairs (cddr pairs))))
                    854: 
                    855: 
                    856: (defun mh-folder-mode ()
                    857:   "Major mode for \"editing\" an MH folder scan listing.
                    858: Messages can be marked for refiling and deletion.  However, both actions
                    859: are defered until you request execution with \\[mh-execute-commands].
                    860: \\{mh-folder-mode-map}
                    861:   A prefix argument (\\[universal-argument]) to delete, move, list, or undo applies the action to a message sequence.
                    862: 
                    863: Variables controlling mh-e operation are (defaults in parentheses):
                    864: 
                    865:  mh-auto-fill-letters (t)
                    866:     Non-nil means invoke auto-fill-mode in draft messages.
                    867: 
                    868:  mh-clean-message-header (nil)
                    869:     Non-nil means remove header lines matching the regular expression
                    870:     specified in mh-invisible-headers from messages.
                    871: 
                    872:  mh-use-mhl (nil)
                    873:     Non-nil means use mhl to format displayed messages.
                    874: 
                    875:  mh-lpr-command-format (\"lpr -p -J '%s'\")
                    876:     Format for command used to print a message on a system printer.
                    877: 
                    878:  mh-summary-height (4)
                    879:     Number of lines in the summary window.
                    880: 
                    881:  mh-ins-buf-prefix (\">> \")
                    882:     String to insert before each non-blank line of a message as it is
                    883:     inserted in a letter being composed."
                    884: 
                    885:   (use-local-map mh-folder-mode-map)
                    886:   (setq major-mode 'mh-folder-mode)
                    887:   (setq mode-name "mh-folder")
                    888:   (if (and (boundp 'mh-folder-mode-hook) mh-folder-mode-hook)
                    889:       (funcall mh-folder-mode-hook)))
                    890: 
                    891: 
                    892: (defun mh-scan-folder (folder range)
                    893:   "Scan the folder FOLDER over the range RANGE.  Return in the folder."
                    894:   (cond ((null (get-buffer folder))
                    895:         (mh-make-folder folder))
                    896:        (t
                    897:         (if (or mh-delete-list mh-move-list mh-seq-list)
                    898:             (if (y-or-n-p "Process commands?")
                    899:                 (mh-process-commands folder)
                    900:                 (mh-undo-folder)))
                    901:         (switch-to-buffer-other-window folder)))
                    902:   (mh-regenerate-headers range)
                    903:   (when (= (count-lines (point-min) (point-max)) 0)
                    904:     (if (equal range "all")
                    905:        (message  "Folder %s is empty" folder)
                    906:        (message  "No messages in %s, range %s" folder range))
                    907:     (sit-for 5))
                    908:   (setq mode-line-format (mh-make-mode-line))
                    909:   (mh-unmark-all-headers nil)
                    910:   (mh-goto-cur-msg))
                    911: 
                    912: 
                    913: (defun mh-regenerate-headers (range)
                    914:   "Replace buffer with scan of its contents over range RANGE."
                    915:   (let ((buffer-read-only nil))
                    916:     (message (format "scanning %s..." (buffer-name)))
                    917:     (delete-other-windows)
                    918:     (erase-buffer)
                    919:     (mh-exec-cmd-output "scan" "-noclear" "-noheader" (buffer-name) range)
                    920:     (goto-char (point-min))
                    921:     (cond ((looking-at "scan: no messages in")
                    922:           (keep-lines "^[ ]*[0-9]"))   ; Flush random scan lines
                    923:          ((looking-at "scan: "))       ; Keep error messages
                    924:          (t
                    925:           (keep-lines "^[ ]*[0-9]")))  ; Flush random scan lines
                    926:     (message (format "scanning %s...done" (buffer-name)))))
                    927: 
                    928: 
                    929: (defun mh-get-new-mail ()
                    930:   "Read new mail into the current buffer.  Return t if there was new mail,
                    931: nil otherwise.  Leave cursor in current buffer."
                    932:   (let ((buffer-read-only nil)
                    933:        (point-before-inc (point)))
                    934:     (message (format "inc %s..." (buffer-name)))
                    935:     (mh-unmark-all-headers nil)
                    936:     (setq mh-next-direction 'forward)
                    937:     (flush-lines "^inc:\\|^scan:")     ; Kill old error messages
                    938:     (goto-char (point-max))
                    939:     (let ((start-of-inc (point)))
                    940:       (mh-exec-cmd-output "inc")
                    941:       (goto-char start-of-inc)
                    942:       (message (format "inc %s...done" (buffer-name)))
                    943:       (cond ((looking-at "inc: no mail")
                    944:             (keep-lines "^[ ]*[0-9]")  ; Flush random scan lines
                    945:             (setq mode-line-format (mh-make-mode-line))
                    946:             (goto-char point-before-inc)
                    947:             (message "No new mail.")
                    948:             nil)
                    949:            ((looking-at "inc:")        ; Error messages
                    950:             (setq mode-line-format (mh-make-mode-line))
                    951:             (goto-char point-before-inc)
                    952:             (message "inc error")
                    953:             nil)
                    954:            (t
                    955:             (keep-lines "^[ ]*[0-9]")
                    956:             (setq mode-line-format (mh-make-mode-line))
                    957:             (mh-goto-cur-msg)
                    958:             t)))))
                    959: 
                    960: 
                    961: (defun mh-make-mode-line (&optional annotation)
                    962:   "Returns a string for mode-line-format.  The optional ANNOTATION string is
                    963: displayed after the folder's name."
                    964:   (save-excursion
                    965:     (goto-char (point-min))
                    966:     (let ((lines (count-lines (point-min) (point-max))))
                    967:       (let* ((first (mh-get-msg-num nil))
                    968:             (case-fold-search nil)
                    969:             (current (and (re-search-forward "....\\+" nil t)
                    970:                           (mh-get-msg-num nil))))
                    971:        (goto-char (point-max))
                    972:        (previous-line 1)
                    973:        (let ((last (mh-get-msg-num nil)))
                    974:          (format "{%%b%s}  [%d messages%s%s]  (%%p%%%% - %%m)  %%M"
                    975:                  (if annotation (format "/%s" annotation) "")
                    976:                  lines
                    977:                  (if (> lines 0)
                    978:                      (format "  (%d - %d)" first last)
                    979:                      "")
                    980:                  (if current
                    981:                      (format "  cur = %d" current)
                    982:                      "")))))))
                    983: 
                    984: 
                    985: (defun mh-unmark-all-headers (remove-all-flags)
                    986:   "This function removes all + flags from the headers, and if called
                    987:   with a non-nil argument, removes all D and ^ flags too."
                    988:   (let ((buffer-read-only nil)
                    989:        (case-fold-search nil))
                    990:     (goto-char (point-min))
                    991:     (while (if remove-all-flags
                    992:               (re-search-forward "^....\\D\\|^....\\^\\|^....\\+\\|.....%"
                    993:                                  nil t)
                    994:               (re-search-forward "^....\\+" nil t))
                    995:       (delete-backward-char 1)
                    996:       (insert " "))))
                    997: 
                    998: 
                    999: (defun mh-goto-cur-msg ()
                   1000:   "Position the cursor at the current message."
                   1001:   (let ((curmsg (mh-get-cur-msg mh-current-folder)))
                   1002:     (cond ((or (zerop curmsg) (not (mh-goto-msg curmsg t)))
                   1003:           (goto-char (point-max))
                   1004:           (forward-line -1)
                   1005:           (mh-maybe-show)
                   1006:           (message "No current message"))
                   1007:          (t
                   1008:           (mh-notate ?+ 4)
                   1009:           (recenter 0)))))
                   1010: 
                   1011: 
                   1012: (defun mh-pack-folder ()
                   1013:   "Closes and packs the current folder."
                   1014:   (let ((buffer-read-only nil))
                   1015:     (message "closing folder...")
                   1016:     (mh-process-commands mh-current-folder)
                   1017:     (message "packing folder...")
                   1018:     (mh-exec-cmd-quiet 0 "folder" mh-current-folder "-pack")
                   1019:     (mh-regenerate-headers "all")
                   1020:     (message "packing done"))
                   1021:   (setq mode-line-format (mh-make-mode-line)))
                   1022: 
                   1023: 
                   1024: (defun mh-process-commands (buffer)
                   1025:   "Process outstanding commands for the buffer BUFFER."
                   1026:   (message "Processing deletes and moves...")
                   1027:   (switch-to-buffer buffer)
                   1028:   (let ((buffer-read-only nil))
                   1029:     ;; Sequences must be first
                   1030:     (mh-process-seq-commands mh-seq-list)
                   1031:     ;; Update the unseen sequence
                   1032:     (if mh-seen-list
                   1033:        (let ((unseen-seq (mh-get-profile-field "Unseen-Sequence:")))
                   1034:          (if (null unseen-seq)         ; For MH.5
                   1035:              (setq unseen-seq "unseen"))
                   1036:          (apply 'mh-exec-cmd-quiet
                   1037:                 (nconc (list 0 "mark" mh-current-folder)
                   1038:                        mh-seen-list
                   1039:                        (list "-sequence" unseen-seq "-delete")))))
                   1040: 
                   1041:     ;; Then refile messages
                   1042:     (mapc (function
                   1043:           (lambda (dest)
                   1044:             (let ((msgs (mh-seq-to-msgs dest)))
                   1045:               (when msgs
                   1046:                 (mh-delete-scan-msgs msgs)
                   1047:                 (apply 'mh-exec-cmd
                   1048:                        (nconc (cons "refile" msgs)
                   1049:                               (list "-src" buffer (symbol-name dest))))))))
                   1050:          mh-move-list)
                   1051: 
                   1052:     ;; Now delete messages
                   1053:     (when mh-delete-list
                   1054:       (apply 'mh-exec-cmd
                   1055:             (nconc (list "rmm" (format "%s" buffer)) mh-delete-list))
                   1056:       (mh-delete-scan-msgs mh-delete-list))
                   1057: 
                   1058:     ;; Mark as cur message.
                   1059:     (cond ((mh-get-msg-num nil)
                   1060:           (mh-exec-cmd "mark" mh-current-folder (mh-get-msg-num nil)
                   1061:                        "-seq" "cur" "-add" "-zero"))
                   1062:          ((> (buffer-size) 0)          ; Some messages left in folder.
                   1063:           (mh-exec-cmd "mark" mh-current-folder
                   1064:                        "-seq" "cur" "-delete" "all")))
                   1065: 
                   1066:     (save-excursion
                   1067:       (switch-to-buffer mh-show-buffer)
                   1068:       (setq buffer-file-name nil))     ; Invalidate buffer file cache
                   1069: 
                   1070:     (setq mh-delete-list nil
                   1071:          mh-move-list nil
                   1072:          mh-seq-list nil
                   1073:          mh-seen-list nil))
                   1074:   (message "Processing deletes and moves...done"))
                   1075: 
                   1076: 
                   1077: (defun mh-delete-scan-msgs (msgs)
                   1078:   "Delete the scan listing lines for each of the msgs in the LIST."
                   1079:   (save-excursion
                   1080:     (goto-char (point-min))
                   1081:     (while msgs
                   1082:       (flush-lines (mh-msg-search-pat (car msgs)))
                   1083:       (setq msgs (cdr msgs)))))
                   1084: 
                   1085: 
                   1086: 
                   1087: ;;; A mode for composing and sending a message.
                   1088: 
                   1089: (defun mh-letter-mode ()
                   1090:     "Mode for composing letters in mh-e.
                   1091: \\{mh-letter-mode-map}"
                   1092:   (text-mode)
                   1093:   (if mh-auto-fill-letters
                   1094:       (auto-fill-mode 1))
                   1095:   (make-local-variable 'paragraph-start)
                   1096:   (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
                   1097:   (make-local-variable 'paragraph-separate)
                   1098:   (setq paragraph-separate
                   1099:        (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
                   1100:   (use-local-map mh-letter-mode-map)
                   1101:   (setq major-mode 'mh-letter-mode)
                   1102:   (setq mode-name "mh-letter")
                   1103:   (if (and (boundp 'mh-letter-mode-hook) mh-letter-mode-hook)
                   1104:       (funcall mh-letter-mode-hook)))
                   1105: 
                   1106: 
                   1107: (defun mh-to-to ()
                   1108:   "Move point to end of To: field."
                   1109:   (interactive)
                   1110:   (expand-abbrev)
                   1111:   (mh-position-on-field "To:" t))
                   1112: 
                   1113: 
                   1114: (defun mh-to-subject ()
                   1115:   "Move point to end of Subject: field.  Creates the field if necessary"
                   1116:   (interactive)
                   1117:   (expand-abbrev)
                   1118:   (when (not (mh-position-on-field "Subject:" t))
                   1119:     (mh-position-on-field "To:" nil)
                   1120:     (insert-string "\nSubject: ")))
                   1121: 
                   1122: 
                   1123: (defun mh-to-cc ()
                   1124:   "Move point to end of Cc: field.  Creates the field if necessary"
                   1125:   (interactive)
                   1126:   (expand-abbrev)
                   1127:   (when (not (mh-position-on-field "Cc:" t))
                   1128:     (mh-position-on-field "To:" nil)
                   1129:     (insert-string "\nCc: ")))
                   1130: 
                   1131: 
                   1132: (defun mh-to-bcc ()
                   1133:   "Move point to end of Bcc: field.  Creates the field if necessary"
                   1134:   (interactive)
                   1135:   (expand-abbrev)
                   1136:   (when (not (mh-position-on-field "Bcc:" t))
                   1137:     (mh-position-on-field "To:" nil)
                   1138:     (insert-string "\nBcc: ")))
                   1139: 
                   1140: 
                   1141: (defun mh-to-fcc ()
                   1142:   "Move point to end of Fcc: field.  Creates the field if necessary"
                   1143:   (interactive)
                   1144:   (expand-abbrev)
                   1145:   (when (not (mh-position-on-field "Fcc:" t))
                   1146:     (mh-position-on-field "To:" nil)
                   1147:     (insert-string "\nFcc: ")))
                   1148: 
                   1149: 
                   1150: (defun mh-check-whom ()
                   1151:   "List recipients of the current message."
                   1152:   (interactive)
                   1153:   (let ((file-name (buffer-file-name)))
                   1154:     (set-buffer-modified-p t)          ; Force writing of contents
                   1155:     (save-buffer)
                   1156:     (message "Checking recipients...")
                   1157:     (switch-to-buffer-other-window "*Mail Recipients*")
                   1158:     (bury-buffer (current-buffer))
                   1159:     (erase-buffer)
                   1160:     (mh-exec-cmd-output "whom" file-name)
                   1161:     (other-window -1)
                   1162:     (message "Checking recipients...done")))
                   1163: 
                   1164: 
                   1165: 
                   1166: ;;; Routines to make a search pattern and search for a message.
                   1167: 
                   1168: (defun mh-make-pick-template ()
                   1169:   "Initialize a buffer with a template for a pick pattern."
                   1170:   (erase-buffer)
                   1171:   (kill-all-local-variables)
                   1172:   (make-local-variable 'mh-searching-folder)
                   1173:   (insert "From: \n"
                   1174:          "To: \n"
                   1175:          "Cc: \n"
                   1176:          "Date: \n"
                   1177:          "Subject: \n"
                   1178:          "---------\n")
                   1179:   (mh-letter-mode)
                   1180:   (use-local-map mh-pick-mode-map)
                   1181:   (setq mode-line-format "{%b}\tPick Pattern\t(^C^C to do search)")
                   1182:   (goto-char (point-min))
                   1183:   (end-of-line))
                   1184: 
                   1185: 
                   1186: (defun mh-do-pick-search ()
                   1187:   "Search the current folder for the messages matching the qualification
                   1188: in the current buffer and make them into a sequence called `search'."
                   1189:   (interactive)
                   1190:   (let* ((pattern-buffer (buffer-name))
                   1191:         (searching-buffer mh-searching-folder)
                   1192:         (range "all")
                   1193:         (pattern nil))
                   1194:     (message "Searching...")
                   1195:     (goto-char (point-min))
                   1196:     (while (setq pattern (mh-next-pick-field pattern-buffer))
                   1197:       (setq msgs
                   1198:            (mh-seq-from-command searching-buffer
                   1199:                                 'search
                   1200:                                 (nconc (cons "pick" pattern)
                   1201:                                        (list searching-buffer
                   1202:                                              range
                   1203:                                              "-sequence" "search"
                   1204:                                              "-list"))))
                   1205:       (setq range "search"))
                   1206:     (message "Searching...done")
                   1207:     (switch-to-buffer searching-buffer)
                   1208:     (mh-notate-seq 'search ?% (+ mh-cmd-note 1))))
                   1209: 
                   1210: 
                   1211: (defun mh-next-pick-field (buffer)
                   1212:   "Return the next piece of a pick argument that can be extracted from the
                   1213: BUFFER.  Returns nil if no pieces remain."
                   1214:   (switch-to-buffer buffer)
                   1215:   (let ((case-fold-search t))
                   1216:     (cond ((eobp)
                   1217:           nil)
                   1218:          ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
                   1219:           (let* ((component
                   1220:                   (format "-%s"
                   1221:                           (downcase (buffer-substring (match-beginning 1)
                   1222:                                                       (match-end 1)))))
                   1223:                  (pat (buffer-substring (match-beginning 2) (match-end 2))))
                   1224:               (forward-line 1)
                   1225:               (list component pat)))
                   1226:          ((re-search-forward "^-*$" nil t)
                   1227:           (forward-char 1)
                   1228:           (let ((body (buffer-substring (point) (point-max))))
                   1229:             (if (and (> (length body) 0) (not (equal body "\n")))
                   1230:                 (list "-search" body)
                   1231:                 nil)))
                   1232:          (t
                   1233:           nil))))
                   1234: 
                   1235: 
                   1236: 
                   1237: ;;; Routines compose and send a letter.
                   1238: 
                   1239: (defun mh-compose-and-send-mail (send-args sent-from-folder to subject cc
                   1240:                                           &optional annotate-char
                   1241:                                           annotate-field search-prefix)
                   1242:   "Edit and compose a draft message and send or save it.
                   1243: SENT-FROM-FOLDER is buffer containing summary of current folder, if any.
                   1244: SEND-ARGS is an optional argument passed to the send command.
                   1245: The TO, SUBJECT, and CC fields are passed to the mh-compose-letter-hook.
                   1246: If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
                   1247: current message.  In that case, the ANNOTATE-FIELD is used to build a string
                   1248: for mh-annotate-msg."
                   1249:   (let ((sent-from-msg))
                   1250:     (save-window-excursion
                   1251:       (when sent-from-folder
                   1252:        (switch-to-buffer sent-from-folder)
                   1253:        (setq sent-from-msg (mh-get-msg-num nil))))
                   1254:     (pop-to-buffer "draft")
                   1255:     (mh-letter-mode)
                   1256:     (make-local-vars
                   1257:      'mh-send-args send-args
                   1258:      'mh-sent-from-folder sent-from-folder
                   1259:      'mh-sent-from-msg sent-from-msg
                   1260:      'mh-annotate-field annotate-field
                   1261:      'mh-annotate-char annotate-char
                   1262:      'mh-annotate-search-prefix (if search-prefix search-prefix ""))
                   1263:     (setq mode-line-format "{%b}  %[Mail/draft%] (%p - %m) (^C^C to send) %M")
                   1264:     (if (and (boundp 'mh-compose-letter-hook) mh-compose-letter-hook)
                   1265:        (funcall mh-compose-letter-hook to subject cc))))
                   1266: 
                   1267: 
                   1268: (defun mh-send-letter (&optional arg)
                   1269:   "Send the letter in the current buffer.  If given an ARGUMENT, the delivery
                   1270: process is monitored and displayed."
                   1271:   (interactive "P")
                   1272:   (save-buffer)
                   1273:   (message "Sending...")
                   1274:   (if arg
                   1275:       (let ((from-buffer (buffer-name))
                   1276:            (file-name (buffer-file-name)))
                   1277:        (pop-to-buffer " *mh-temp*")
                   1278:        (erase-buffer)
                   1279:        (if mh-send-args
                   1280:            (mh-exec-cmd-output "send" "-watch" "-unique" mh-send-args
                   1281:                                file-name)
                   1282:            (mh-exec-cmd-output "send" "-watch" "-unique" file-name))
                   1283:        (pop-to-buffer from-buffer))
                   1284:       (if mh-send-args
                   1285:          (mh-exec-cmd-quiet 0 "send" "-push" "-unique" mh-send-args
                   1286:                             (buffer-file-name))
                   1287:          (mh-exec-cmd-quiet 0 "send" "-push" "-unique" (buffer-file-name))))
                   1288:   (if mh-annotate-char
                   1289:       (mh-annotate-msg mh-sent-from-msg
                   1290:                       mh-sent-from-folder
                   1291:                       mh-annotate-char
                   1292:                       "-component" mh-annotate-field
                   1293:                       "-text" (format "\"%s %s\""
                   1294:                                       (mh-get-field
                   1295:                                        (format "%s%s"
                   1296:                                                mh-annotate-search-prefix
                   1297:                                                "To:"))
                   1298:                                       (mh-get-field
                   1299:                                        (format "%s%s"
                   1300:                                                mh-annotate-search-prefix
                   1301:                                                "Cc:")))))
                   1302:   (message "Sending...done")
                   1303:   (kill-buffer (buffer-name)))
                   1304: 
                   1305: 
                   1306: (defun mh-insert-letter (&optional arg)
                   1307:   "Insert a message in the current letter, asking for folder and number.
                   1308: Removes headers using mh-invisible-headers.
                   1309: Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \").
                   1310: Just \\[universal-argument] means do not indent and do not delete any
                   1311: header fields.  Leaves point before the text and mark after it."
                   1312:   (interactive "p")
                   1313:   (let ((folder (mh-prompt-for-folder "Message from" mh-sent-from-folder nil))
                   1314:        (message (read-input (format "Message number%s: "
                   1315:                                     (if mh-sent-from-msg
                   1316:                                         (format " [%d]" mh-sent-from-msg)
                   1317:                                         ""))))
                   1318:        (start (point)))
                   1319:     (if (equal message "") (setq message (format "%d" mh-sent-from-msg)))
                   1320:     (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
                   1321:                            (format "%s%s/%s" mh-user-path
                   1322:                                    (substring folder 1) message))
                   1323:     (when (not (equal arg 4))
                   1324:       (mh-clean-msg-header start)
                   1325:       (narrow-to-region start (mark))
                   1326:       (mh-insert-prefix-string mh-ins-buf-prefix)
                   1327:       (widen))
                   1328:     (exchange-point-and-mark)))
                   1329: 
                   1330: 
                   1331: (defun mh-insert-cur-msg ()
                   1332:   "Inserts the currently displayed message into the current draft buffer.
                   1333: Prefixes each non-blank line with the string mh-ins-buf-prefix.
                   1334: If there is a region set in the  message's buffer,only the region will
                   1335: be inserted.  Otherwise, the region from (point) to the end will be grabbed."
                   1336:   (interactive)
                   1337:   (let ((to-point (point))
                   1338:        (to-buffer (current-buffer)))
                   1339:     (set-buffer mh-sent-from-folder)
                   1340:     (set-buffer mh-show-buffer)                ; Find displayed message
                   1341:     (let  ((mh-ins-str (if (mark)
                   1342:                           (buffer-substring (point) (mark))
                   1343:                           (buffer-substring (point) (point-max)))))
                   1344:       (set-buffer to-buffer)
                   1345:       (narrow-to-region to-point to-point)
                   1346:       (insert-string mh-ins-str)
                   1347:       (mh-insert-prefix-string mh-ins-buf-prefix)
                   1348:       (widen))))
                   1349: 
                   1350: 
                   1351: (defun mh-insert-prefix-string (ins-string)
                   1352: "Preface each line in the current buffer with STRING."
                   1353:   (goto-char (point-min))
                   1354:   (replace-regexp "^." (concat ins-string "\\&") nil)
                   1355:   (goto-char (point-min)))
                   1356: 
                   1357: 
                   1358: (defun mh-fully-kill-draft ()
                   1359:   "Kill the draft message file and the draft message buffer.  Use kill-buffer
                   1360: if you don't want to delete the draft message file."
                   1361:   (interactive "")
                   1362:   (if (file-exists-p (buffer-file-name))
                   1363:       (delete-file (buffer-file-name)))
                   1364:   (kill-buffer (buffer-name)))
                   1365: 
                   1366: 
                   1367: 
                   1368: ;;; Commands to manipulate sequences.  Sequences are stored in an alist
                   1369: ;;; of the form:
                   1370: ;;;    ((seq-name msgs ...) (seq-name msgs ...) ...)
                   1371: 
                   1372: 
                   1373: (defmacro mh-seq-name (pair)
                   1374:   (list 'car pair))
                   1375: 
                   1376: (defmacro mh-seq-msgs (pair)
                   1377:   (list 'cdr pair))
                   1378: 
                   1379: 
                   1380: (defun mh-seq-to-msgs (seq)
                   1381:   "Returns the messages in sequence SEQ."
                   1382:   (mh-seq-msgs (assoc seq mh-seq-list)))
                   1383: 
                   1384: 
                   1385: (defun mh-msg-to-seq (msg)
                   1386:   "Given a MESSAGE number, return the first sequence in which it occurs."
                   1387:   (let ((l mh-seq-list))
                   1388:     (while (and l (not (memq msg (cdar l))))
                   1389:       (setq l (cdr l)))
                   1390:     (caar l)))
                   1391: 
                   1392: 
                   1393: (defun mh-read-seq (prompt &optional seq)
                   1394:   "Read and return a sequence name from the minibuffer, prompting with 
                   1395: the string PROMPT and supplying the optional DEFAULT.
                   1396: % defaults to the sequences that the current message is in.
                   1397: Makes sure that the sequence is known to MH commands."
                   1398:   (let ((input (completing-read
                   1399:                (format "%s %s %s" prompt "sequence:"
                   1400:                        (if seq (format "[%s] " (symbol-name seq)) ""))
                   1401:                (mh-seq-names mh-seq-list))))
                   1402:     (let ((seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t)))
                   1403:                     ((equal input "") seq)
                   1404:                     (t (intern input)))))
                   1405:       (mh-process-seq seq (mh-seq-to-msgs seq))
                   1406:       seq)))
                   1407: 
                   1408: 
                   1409: (defun mh-seq-names (seq-list)
                   1410:   "Returns an alist of the names of the SEQUENCES."
                   1411:   (mapcar (function (lambda (entry) (cons (symbol-name (car entry)) nil)))
                   1412:          seq-list))
                   1413: 
                   1414: 
                   1415: (defun mh-seq-from-command (folder seq command)
                   1416:   "In FOLDER, make a sequence named SEQ by executing COMMAND."
                   1417:   (let ((msgs ())
                   1418:        (case-fold-search t))
                   1419:     (save-excursion
                   1420:       (save-window-excursion
                   1421:        (apply 'mh-exec-cmd-quiet (cons " *mh-temp*" command))
                   1422:        (goto-char (point-min))
                   1423:        (while (re-search-forward "\\([0-9]+\\)" nil t)
                   1424:          (let ((num (string-to-int (buffer-substring (match-beginning 1)
                   1425:                                                      (match-end 1)))))
                   1426:            (if (not (zerop num))
                   1427:                (push num msgs)))))
                   1428:       (switch-to-buffer folder)
                   1429:       (push (cons seq msgs) mh-seq-list)
                   1430:       msgs)))
                   1431: 
                   1432: 
                   1433: (defun mh-remove-seq (seq)
                   1434:   "Delete the sequence SEQ."
                   1435:   (let ((entry (assoc seq mh-seq-list)))
                   1436:     (setq mh-seq-list (delq (car entry) mh-seq-list))
                   1437:     (mh-notate-seq (mh-seq-msgs (car entry)) ?  (+ mh-cmd-note 1))))
                   1438: 
                   1439: 
                   1440: (defun mh-remove-msg-from-seq (msg-num seq &optional do-not-mark)
                   1441:   "Remove a message MSG-NUM from the sequence SEQ.  If optional FLAG is
                   1442: non-nil, do not mark the message as being part of a sequence."
                   1443:   (let ((seq (assoc seq mh-seq-list)))
                   1444:     (if seq
                   1445:        (setcdr seq (delq msg-num (mh-seq-msgs seq)))))
                   1446:   (if (not do-not-mark) (mh-notate ? (+ mh-cmd-note 1))))
                   1447: 
                   1448: 
                   1449: (defun mh-add-msg-to-seq (msg-num seq &optional do-not-mark)
                   1450:   "Add the message MSG-NUM to the SEQUENCE.  If optional FLAG is non-nil,
                   1451: do not mark the message as being part of a sequence."
                   1452:   (let ((seq-list (assoc seq mh-seq-list)))
                   1453:     (if (not do-not-mark) (mh-notate ?% (+ mh-cmd-note 1)))
                   1454:     (if (null seq-list)
                   1455:        (push (cons seq (list msg-num)) mh-seq-list)
                   1456:        (setcdr seq-list (cons msg-num (cdr seq-list))))))
                   1457: 
                   1458: 
                   1459: (defun mh-add-msg-list-to-seq (msgs seq &optional do-not-mark)
                   1460:   "Add the messages in LIST to the SEQUENCE.  If optional FLAG is non-nil,
                   1461: do not mark the messages as being part of a sequence."
                   1462:   (mapc (function (lambda (msg) (mh-add-msg-to-seq msg seq do-not-mark)))
                   1463:        msgs))
                   1464: 
                   1465: 
                   1466: (defun mh-rename-seq (seq new-name)
                   1467:   "Rename a SEQUENCE to have a new NAME."
                   1468:   (interactive "SOld sequence name: \nSNew name: ")
                   1469:   (let ((old-seq (assoc seq mh-seq-list)))
                   1470:     (if old-seq
                   1471:        (rplaca old-seq new-name)
                   1472:        (error "Sequence %s does not exists" (symbol-name seq)))))
                   1473: 
                   1474: 
                   1475: (defun mh-notate-seq (seq notation offset)
                   1476:   "Mark all messages in the sequence SEQ with the NOTATION at character
                   1477: OFFSET."
                   1478:   (mh-map-to-seq-msgs 'mh-notate seq notation offset))
                   1479: 
                   1480: 
                   1481: (defun mh-map-to-seq-msgs (func seq &rest args)
                   1482:   "Invoke the function FUNC at each message in the sequence SEQ, passing
                   1483: the remaining ARGS as arguments."
                   1484:   (let ((msgs (mh-seq-to-msgs seq)))
                   1485:     (while msgs
                   1486:       (mh-goto-msg (car msgs))
                   1487:       (apply func args)
                   1488:       (setq msgs (cdr msgs)))))
                   1489: 
                   1490: 
                   1491: (defun mh-map-over-seqs (func seq-list)
                   1492:   "Apply the function FUNC to each element in the sequence LIST,
                   1493: passing the sequence name and a list of messages as arguments."
                   1494:   (while seq-list
                   1495:     (funcall func (caar seq-list) (cdar seq-list))
                   1496:     (setq seq-list (cdr seq-list))))
                   1497: 
                   1498: 
                   1499: (defun mh-process-seq-commands (seq-list)
                   1500:   "Process outstanding sequence commands for the sequences in SEQ-LIST."
                   1501:   (mh-map-over-seqs 'mh-process-seq seq-list))
                   1502: 
                   1503: 
                   1504: (defun mh-process-seq (seq msgs)
                   1505:   "Mark sequence SEQ to contain MSGS."
                   1506:   ;; Do not mark pseudo-sequences.
                   1507:   (if (not (equal (substring (symbol-name seq) 0 1) "+"))
                   1508:       (apply 'mh-exec-cmd
                   1509:             (nconc (list "mark" "-zero" "-seq" (format "%s" seq) "-add")
                   1510:                    msgs))))
                   1511: 
                   1512: 
                   1513: (defun mh-copy-seq-to-point (seq location)
                   1514:   "Copy the messages in SEQUENCE to after the LOCATION in the current buffer."
                   1515:   (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
                   1516: 
                   1517: 
                   1518: (defun mh-copy-line-to-point (location)
                   1519:   "Copy the current line to the LOCATION in the current buffer."
                   1520:   (beginning-of-line)
                   1521:   (let ((beginning-of-line (point)))
                   1522:     (forward-line 1)
                   1523:     (copy-region-as-kill beginning-of-line (point))
                   1524:     (goto-char location)
                   1525:     (yank)
                   1526:     (goto-char beginning-of-line)))
                   1527: 
                   1528: 
                   1529: 
                   1530: ;;; Issue commands to mh.
                   1531: 
                   1532: (defun mh-exec-cmd (command &rest args)
                   1533:   "Execute MH command COMMAND with ARGS.  Any output is shown to the user."
                   1534:   (save-excursion
                   1535:     (switch-to-buffer-other-window " *mh-temp*")
                   1536:     (erase-buffer)
                   1537:     (apply 'call-process
                   1538:           (nconc (list (format "%s%s" mh-progs command) nil t nil)
                   1539:                  (mh-list-to-string args)))
                   1540:     (if (> (buffer-size) 0)
                   1541:        (sit-for 5))))
                   1542: 
                   1543: 
                   1544: (defun mh-exec-cmd-quiet (buffer command &rest args)
                   1545:   "In BUFFER, execute MH command COMMAND with ARGS.  Return in buffer, if
                   1546: one exists."
                   1547:   (when (stringp buffer)
                   1548:     (switch-to-buffer buffer)
                   1549:     (erase-buffer))
                   1550:   (apply 'call-process
                   1551:         (nconc (list (format "%s%s" mh-progs command) nil buffer nil)
                   1552:                (mh-list-to-string args))))
                   1553: 
                   1554: 
                   1555: (defun mh-exec-cmd-output (command &rest args)
                   1556:   "Execute MH command COMMAND with ARGS putting the output into buffer after
                   1557: point.  Set mark after inserted text."
                   1558:   (set-mark (point))
                   1559:   (apply 'call-process
                   1560:         (nconc (list (format "%s%s" mh-progs command) nil t nil)
                   1561:                (mh-list-to-string args)))
                   1562:   (exchange-point-and-mark))
                   1563: 
                   1564: 
                   1565: 
                   1566: (defun mh-exec-lib-cmd-output (command &rest args)
                   1567:   "Execute MH library command COMMAND with ARGS.  Put the output into
                   1568: buffer after point.  Set mark after inserted text."
                   1569:   (set-mark (point))
                   1570:   (apply 'call-process
                   1571:         (nconc (list (format "%s%s" mh-lib command) nil t nil)
                   1572:                (mh-list-to-string args)))
                   1573:   (exchange-point-and-mark))
                   1574: 
                   1575: 
                   1576: (defun mh-list-to-string (l)
                   1577:   "Flattens the list L and makes every element a string."
                   1578:   (let ((new-list nil))
                   1579:     (while l
                   1580:       (cond ((symbolp (car l)) (push (format "%s" (car l)) new-list))
                   1581:            ((numberp (car l)) (push (format "%d" (car l)) new-list))
                   1582:            ((equal (car l) ""))
                   1583:            ((stringp (car l)) (push (car l) new-list))
                   1584:            ((null (car l)))
                   1585:            ((listp (car l)) (setq new-list
                   1586:                                   (nconc (mh-list-to-string (car l))
                   1587:                                          new-list)))
                   1588:            (t (error "Bad argument %s" (car l))))
                   1589:       (setq l (cdr l)))
                   1590:     (nreverse new-list)))
                   1591: 
                   1592: 
                   1593: 
                   1594: ;;; Commands to annotate a message.
                   1595: 
                   1596: (defun mh-annotate-msg (msg buffer note &rest args)
                   1597:   "Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
                   1598: the saved message with ARGS."
                   1599:   ;; Wait for annotation to finish, to avoid race condition with reading msg.
                   1600:   (apply 'mh-exec-cmd (cons "anno" (cons buffer (cons msg args))))
                   1601:   (save-excursion
                   1602:     (switch-to-buffer buffer)
                   1603:     (if (mh-goto-msg msg t)
                   1604:        (mh-notate note (+ mh-cmd-note 1)))))
                   1605: 
                   1606: 
                   1607: (defun mh-notate (notation offset)
                   1608:   "Marks the current message with the character NOTATION at position OFFSET."
                   1609:   (let ((buffer-read-only nil))
                   1610:     (beginning-of-line)
                   1611:     (goto-char (+ (point) offset))
                   1612:     (delete-char 1)
                   1613:     (insert notation)
                   1614:     (beginning-of-line)))
                   1615: 
                   1616: 
                   1617: 
                   1618: ;;; User prompting commands.
                   1619: 
                   1620: (defun mh-prompt-for-folder (prompt default can-create)
                   1621:   "Prompt for a folder name with PROMPT.  Returns the folder's name.
                   1622: DEFAULT is used if the folder exists and the user types CR.
                   1623: If the CAN-CREATE flag is t,then a non-existant folder is made."
                   1624:   (let* ((prompt (format "%s folder%s" prompt
                   1625:                         (if (equal "" default)
                   1626:                             "? "
                   1627:                             (format " [%s]? " default))))
                   1628:         name)
                   1629:     (while (and (setq name (completing-read prompt mh-folder-list
                   1630:                                            nil (not can-create) "+"))
                   1631:                (equal name "")
                   1632:                (equal default "")))
                   1633:     (cond ((or (equal name "") (equal name "+"))
                   1634:           (setq name default))
                   1635:          ((not (equal (substring name 0 1) "+"))
                   1636:           (setq name (format "+%s" name))))
                   1637:     (let ((new-file-p
                   1638:           (not
                   1639:            (file-exists-p (format "%s%s" mh-user-path (substring name 1))))))
                   1640:       (cond ((and new-file-p
                   1641:                  (y-or-n-p
                   1642:                   (format "Folder %s does not exist. Create it? " name)))
                   1643:             (message "Creating %s" name)
                   1644:             (call-process "mkdir" nil nil nil
                   1645:                           (format "%s%s" mh-user-path (substring name 1)))
                   1646:             (message "Creating %s...done" name)
                   1647:             (push (list name) mh-folder-list)
                   1648:             (push (list (substring name 1 nil)) mh-folder-list))
                   1649:            (new-file-p
                   1650:             (error ""))
                   1651:            (t
                   1652:             (when (null (assoc name mh-folder-list))
                   1653:               (push (list name) mh-folder-list)
                   1654:               (push (list (substring name 1 nil)) mh-folder-list)))))
                   1655:     name))
                   1656: 
                   1657: 
                   1658: (defun mh-make-folder-list ()
                   1659:   "Returns a list of the user's folders in a form suitable for completing
                   1660: read."
                   1661:   (interactive)
                   1662:   (save-window-excursion
                   1663:     (mh-exec-cmd-quiet " *mh-temp*" "folders" "-fast" "-norecurse")
                   1664:     (goto-char (point-min))
                   1665:     (let ((list nil))
                   1666:       (while (not (eobp))
                   1667:        (let ((start (point)))
                   1668:          (search-forward "\n" nil t)
                   1669:          (let ((folder (buffer-substring start (- (point) 1))))
                   1670:            (push (list (format "+%s" folder)) list))))
                   1671:       list)))
                   1672: 
                   1673: 
                   1674: (defun mh-remove-folder-from-folder-list (folder)
                   1675:   "Remove FOLDER from the list of folders."
                   1676:   (setq mh-folder-list
                   1677:        (delq (assoc (substring folder 1 nil) mh-folder-list)
                   1678:              mh-folder-list)))
                   1679: 
                   1680: 
                   1681: 
                   1682: ;;; Misc. functions.
                   1683: 
                   1684: (defun mh-get-msg-num (error-if-no-message)
                   1685:   "Returns the message number of the current message.  If the argument
                   1686: ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not 
                   1687: pointing to a message."
                   1688:   (save-excursion
                   1689:     (beginning-of-line)
                   1690:     (cond ((looking-at "^[ ]*\\([0-9]+\\)")
                   1691:           (string-to-int (buffer-substring (match-beginning 1)
                   1692:                                            (match-end 1))))
                   1693:          (error-if-no-message
                   1694:           (error "Cursor not pointing to message"))
                   1695:          (t nil))))
                   1696: 
                   1697: 
                   1698: (defun mh-msg-search-pat (n)
                   1699:   "Returns a search pattern for message N in the scan listing."
                   1700:   (cond ((< n 10) (format "^[^0-9][^0-9][^0-9]%d" n))
                   1701:        ((< n 100) (format "^[^0-9][^0-9]%d" n))
                   1702:        ((< n 1000) (format "^[^0-9]%d" n))
                   1703:        (t (format "^%d" n))))
                   1704: 
                   1705: 
                   1706: (defun mh-msg-filename ()
                   1707:   "Returns a string containing the pathname for the file containing the
                   1708: current message."
                   1709:   (format "%s%d" mh-folder-filename (mh-get-msg-num t)))
                   1710: 
                   1711: 
                   1712: (defun mh-msg-filenames (msgs folder)
                   1713:   "Returns a string of filenames for MSGS in FOLDER."
                   1714:   (mapconcat (function (lambda (msg) (concat folder msg))) msgs " "))
                   1715: 
                   1716: 
                   1717: (defun mh-find-path ()
                   1718:    "Set mh-user-path to the user's Mail directory from  ~/.mh_profile."
                   1719:    (if (equal (setq mh-user-path (mh-get-profile-field "Path:")) "")
                   1720:        (setq mh-user-path "Mail/")
                   1721:        (setq mh-user-path (format "%s/" mh-user-path)))
                   1722:    (if (not (equal (substring mh-user-path 0 1) "/"))
                   1723:        (setq mh-user-path (format "%s/%s" (getenv "HOME") mh-user-path))))
                   1724: 
                   1725: 
                   1726: (defun mh-get-profile-field (field)
                   1727:   "Return FIELD from the user's .mh_profile file."
                   1728:   (save-window-excursion
                   1729:     (if (not (file-exists-p "~/.mh_profile"))
                   1730:        (error "Cannot find .mh_profile file."))
                   1731:     (switch-to-buffer " *mh_temp*")
                   1732:     (erase-buffer)
                   1733:     (insert-file-contents "~/.mh_profile")
                   1734:     (mh-get-field field)))
                   1735: 
                   1736: 
                   1737: (defun mh-get-cur-msg (folder)
                   1738:   "Returns the number of the 'cur' message in FOLDER."
                   1739:   (save-excursion
                   1740:     (switch-to-buffer " *mh_temp*")
                   1741:     (erase-buffer)
                   1742:     (mh-exec-cmd-output "pick" folder "cur")
                   1743:     (string-to-int (buffer-substring (point-min) (point-max)))))
                   1744: 
                   1745: 
                   1746: (defun mh-get-field (field)
                   1747:   "Find and return the value of field FIELD in the current buffer.
                   1748: Returns the empty string if the field is not in the message."
                   1749:   (let ((case-fold-search t))
                   1750:     (goto-char (point-min))
                   1751:     (cond ((not (search-forward field nil t)) "")
                   1752:          ((looking-at "[\t ]*$") "")
                   1753:          (t
                   1754:           (re-search-forward "[\t ]*\\([a-zA-z0-9/\.].*\\)$" nil t)
                   1755:           (let ((field (buffer-substring (match-beginning 1)
                   1756:                                          (match-end 1)))
                   1757:                 (end-of-match (point)))
                   1758:             (forward-line)
                   1759:             (while (looking-at "[ \t]") (forward-line 1))
                   1760:             (backward-char 1)
                   1761:             (format "%s%s" field (buffer-substring end-of-match (point))))))))
                   1762: 
                   1763: 
                   1764: (defun mh-insert-fields (&rest name-values)
                   1765:   "Insert the NAME-VALUE pairs in the current buffer."
                   1766:   (let ((case-fold-search t))
                   1767:     (while name-values
                   1768:       (let ((field-name (car name-values))
                   1769:            (value (cadr name-values)))
                   1770:        (goto-char (point-min))
                   1771:        (cond ((not (re-search-forward (format "^%s" field-name) nil t))
                   1772:               (re-search-forward "^---\\|^$")
                   1773:               (beginning-of-line)
                   1774:               (insert field-name " " value "\n"))
                   1775:              (t
                   1776:               (end-of-line)
                   1777:               (insert " " value)))
                   1778:        (setq name-values (cddr name-values))))))
                   1779: 
                   1780: 
                   1781: (defun mh-position-on-field (field set-mark)
                   1782:   "Set point to the end of the line beginning with FIELD.  Sets the mark
                   1783: to the point, if SET-MARK is non-nil."
                   1784:   (if set-mark (set-mark (point)))
                   1785:   (goto-char (point-min))
                   1786:   (if (re-search-forward (format "^%s" field) nil t)
                   1787:       (progn (end-of-line) t)
                   1788:       nil))
                   1789: 
                   1790: 
                   1791: 
                   1792: ;;; Build the folder-mode keymap:
                   1793: 
                   1794: (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
                   1795: (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
                   1796: (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
                   1797: (define-key mh-folder-mode-map "\^xn" 'mh-narrow-to-seq)
                   1798: (define-key mh-folder-mode-map "\^xw" 'mh-widen)
                   1799: 
                   1800: (define-key mh-folder-mode-map "\^c" 'my-apply-command-to-seq)
                   1801: (define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
                   1802: (define-key mh-folder-mode-map "\e " 'mh-page-digest)
                   1803: (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
                   1804: (define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
                   1805: (define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
                   1806: (define-key mh-folder-mode-map "\el" 'mh-list-folders)
                   1807: (define-key mh-folder-mode-map "\ep" 'mh-renumber-folder)
                   1808: (define-key mh-folder-mode-map "\es" 'mh-search-folder)
                   1809: (define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
                   1810: (define-key mh-folder-mode-map "l" 'mh-print-msg)
                   1811: (define-key mh-folder-mode-map "t" 'mh-toggle-summarize)
                   1812: (define-key mh-folder-mode-map "c" 'mh-copy-msg)
                   1813: (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
                   1814: (define-key mh-folder-mode-map "i" 'mh-inc-folder)
                   1815: (define-key mh-folder-mode-map "x" 'mh-execute-commands)
                   1816: (define-key mh-folder-mode-map "e" 'mh-execute-commands)
                   1817: (define-key mh-folder-mode-map "r" 'mh-redistribute)
                   1818: (define-key mh-folder-mode-map "f" 'mh-forward)
                   1819: (define-key mh-folder-mode-map "s" 'mh-send)
                   1820: (define-key mh-folder-mode-map "a" 'mh-answer)
                   1821: (define-key mh-folder-mode-map "g" 'mh-goto-msg)
                   1822: (define-key mh-folder-mode-map "\177" 'mh-previous-page)
                   1823: (define-key mh-folder-mode-map " " 'mh-page-msg)
                   1824: (define-key mh-folder-mode-map "." 'mh-show)
                   1825: (define-key mh-folder-mode-map "u" 'mh-undo)
                   1826: (define-key mh-folder-mode-map "!" 'mh-move-or-write-again)
                   1827: (define-key mh-folder-mode-map "^" 'mh-move-msg)
                   1828: (define-key mh-folder-mode-map "d" 'mh-delete-msg)
                   1829: (define-key mh-folder-mode-map "p" 'mh-previous-line)
                   1830: (define-key mh-folder-mode-map "n" 'mh-next-line)
                   1831: 
                   1832: 
                   1833: ;;; Build the letter-mode keymap:
                   1834: 
                   1835: (define-key mh-letter-mode-map "\^Cb" 'mh-to-bcc)
                   1836: (define-key mh-letter-mode-map "\^Cw" 'mh-check-whom)
                   1837: (define-key mh-letter-mode-map "\^Cc" 'mh-to-cc)
                   1838: (define-key mh-letter-mode-map "\^Cf" 'mh-to-fcc)
                   1839: (define-key mh-letter-mode-map "\^Cs" 'mh-to-subject)
                   1840: (define-key mh-letter-mode-map "\^Ct" 'mh-to-to)
                   1841: (define-key mh-letter-mode-map "\^Cq" 'mh-fully-kill-draft)
                   1842: (define-key mh-letter-mode-map "\^Cy" 'mh-insert-cur-msg)
                   1843: (define-key mh-letter-mode-map "\^C\^Y" 'mh-insert-letter)
                   1844: (define-key mh-letter-mode-map "\^C\^C" 'mh-send-letter)
                   1845: 
                   1846: ;;; Build the pick-mode keymap:
                   1847: 
                   1848: (define-key mh-pick-mode-map "\^C\^C" 'mh-do-pick-search)
                   1849: (define-key mh-pick-mode-map "\^Cb" 'mh-to-bcc)
                   1850: (define-key mh-pick-mode-map "\^Cc" 'mh-to-cc)
                   1851: (define-key mh-pick-mode-map "\^Cf" 'mh-to-fcc)
                   1852: (define-key mh-pick-mode-map "\^Cs" 'mh-to-subject)
                   1853: (define-key mh-pick-mode-map "\^Ct" 'mh-to-to)
                   1854: (define-key mh-pick-mode-map "\^Cw" 'mh-check-whom)

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.