Return to :mh-e.ml CVS log

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

Annotation of 43BSD/contrib/mh/miscellany/mh-e/:mh-e.ml, revision 1.1

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

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