Return to mh-e.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

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

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

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