Return to mh-e.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / mh / miscellany / mh-e

Annotation of 43BSDReno/contrib/mh/miscellany/mh-e/mh-e.el, revision 1.1

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

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