home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / unix_c / gnu / mh_e.el < prev    next >
Encoding:
Text File  |  1989-03-21  |  83.3 KB  |  2,502 lines
  1. ;;;  mh-e.el    (Version: 3.5 for GNU Emacs Version 18 and MH.5 and MH.6)
  2.  
  3. (defvar mh-e-RCS-id)
  4. (setq mh-e-RCS-id "$Header: mh-e.el,v 2.17 88/05/12 14:39:15 larus Exp $")
  5. (provide 'mh-e)
  6.  
  7. ;;;  Copyright (C) 1985, 1986, 1987 Free Software Foundation
  8. ;;;     Author:  James Larus (larus@ginger.Berkeley.EDU or ucbvax!larus)
  9. ;;;    Please send suggestions and corrections to the above address.
  10. ;;;
  11. ;;;  This file contains mh-e, a GNU Emacs front end to the MH mail system.
  12.  
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but without any warranty.  No author or distributor
  16. ;; accepts responsibility to anyone for the consequences of using it
  17. ;; or for whether it serves any particular purpose or works at all,
  18. ;; unless he says so in writing.
  19.  
  20. ;; Everyone is granted permission to copy, modify and redistribute
  21. ;; GNU Emacs, but only under the conditions described in the
  22. ;; document "GNU Emacs copying permission notice".   An exact copy
  23. ;; of the document is supposed to have been given to you along with
  24. ;; GNU Emacs so that you can know how you may redistribute it all.
  25. ;; It should be in a file named COPYING.  Among other things, the
  26. ;; copyright notice and this notice must be preserved on all copies.
  27.  
  28.  
  29. ;;;  Original version for Gosling emacs by Brian Reid, Stanford, 1982.
  30. ;;;  Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
  31. ;;;  Rewritten for GNU Emacs, James Larus 1985.  larus@ginger.berkeley.edu
  32. ;;;  Modified by Stephen Gildea 1988.  gildea@bbn.com
  33.  
  34.  
  35. ;;;  NB.  MH must have been compiled with the MHE compiler flag or several
  36. ;;;  features necessary mh-e will be missing from MH commands, specifically
  37. ;;;  the -build switch to repl and forw.
  38.  
  39.  
  40.  
  41. ;;; Constants:
  42.  
  43. ;;; Set for local environment:
  44. ;;;* These are now in paths.el.
  45. ;;;(defvar mh-progs "/usr/new/mh/" "Directory containing MH commands")
  46. ;;;(defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library")
  47.  
  48. (defvar mh-redist-full-contents t
  49.   "Non-nil if the `dist' command needs whole letter for redistribution (i.e.,
  50. when `send' is compiled with the BERK option).  Nil otherwise.")
  51.  
  52.  
  53. ;;; Mode hooks:
  54.  
  55. (defvar mh-folder-mode-hook nil
  56.   "*Invoked in mh-folder-mode on a new folder.")
  57.  
  58. (defvar mh-letter-mode-hook nil
  59.   "*Invoked in mh-letter-mode on a new letter.")
  60.  
  61. (defvar mh-compose-letter-hook nil
  62.   "*Invoked in mh-compose-and-send-mail on an outgoing letter.  It is passed
  63. three arguments: TO recipients, SUBJECT, and CC recipients.")
  64.  
  65. (defvar mh-inc-folder-hook nil
  66.   "*Invoked after incorporating new mail into a folder.")
  67.  
  68.  
  69. ;;; Personal preferences:
  70.  
  71. (defvar mh-clean-message-header nil
  72.   "*Non-nil means remove invisible header lines or only show visible header
  73. lines in messages.")
  74.  
  75. (defvar mh-visible-headers nil
  76.   "*If non-nil, it contains a regexp specifying the headers that are shown in
  77. a message if mh-clean-message-header is non-nil.  Setting this variable
  78. overrides mh-invisible-headers.")
  79.  
  80. (defvar mhl-formfile nil
  81.   "*Name of format file to be used by mhl to show messages.
  82. A value of T means use the default format file.
  83. Nil means don't use mhl to format messages.")
  84.  
  85. (defvar mh-lpr-command-format "lpr -p -J '%s'"
  86.   "*Format for Unix command line to print a message. The format should be
  87. a unix command line, with the string \"%s\" where the folder and message
  88. number should appear.")
  89.  
  90. (defvar mh-print-background nil
  91.   "*Print messages in the background if non-nil.  WARNING: do not delete
  92. the messages until printing is finished; otherwise, your output may be
  93. truncated.")
  94.  
  95. (defvar mh-summary-height 4
  96.   "*Number of lines in summary window.")
  97.  
  98. (defvar mh-recenter-summary-p nil
  99.   "*Recenter summary window when the show window is toggled off if
  100. this is non-nil.")
  101.  
  102. (defvar mh-ins-buf-prefix ">> "
  103.   "*String to put before each non-blank line of the the current message
  104. as it is inserted in an outgoing letter.")
  105.  
  106. (defvar mh-do-not-confirm nil
  107.   "*Non-nil means do not prompt for confirmation before executing some
  108. innocuous commands.")
  109.  
  110. (defvar mh-bury-show-buffer t
  111.   "*Non-nil means that the displayed show buffer for a folder is buried.")
  112.  
  113.  
  114. (defvar mh-delete-yanked-msg-window nil
  115.   "*If non-nil, yanking the current message into a letter being composed
  116. (with  with \\[mh-yank-cur-msg]) deletes any windows displaying the message.")
  117.  
  118.  
  119. (defvar mh-yank-from-start-of-msg t
  120.   "*If non-nil, \\[mh-yank-cur-msg] will include the entire message.  If
  121. nil, only the portion of the message following the point will be yanked.
  122. If there is a region in the show buffer, this variable is ignored.")
  123.  
  124.  
  125. ;;; Real constants:
  126.  
  127. (defvar mh-cmd-note 4               "Offset to insert notation")
  128.  
  129. (defvar mh-invisible-headers
  130.   "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^In-Reply-To: \\|^Resent-"
  131.   "Regexp specifying headers that are not to be shown.")
  132.  
  133. (defvar mh-rejected-letter-start "^   ----- Unsent message follows -----$"
  134.   "Regexp specifying the beginning of the wrapper around a letter returned
  135. by the mail system.")
  136.  
  137. (defvar mh-good-msg-regexp  "^....[^D^]"
  138.   "Regexp specifiying the scan lines that are 'good' messages")
  139.  
  140.  
  141. (defvar mh-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:")
  142.                   (?b . "Bcc:") (?f . "Fcc:"))
  143.   "A-list of (character . field name) strings for mh-to-field.")
  144.  
  145.  
  146. ;;; Global variables:
  147.  
  148. (defvar mh-user-path  ""
  149.   "User's mail folder.")
  150.  
  151. (defvar mh-last-destination nil
  152.   "Destination of last `refile' command.")
  153.  
  154. (defvar mh-folder-mode-map (make-keymap)
  155.   "Keymap for MH folders.")
  156.  
  157. (defvar mh-letter-mode-map (make-sparse-keymap)
  158.   "Keymap for composing mail.")
  159.  
  160. (defvar mh-pick-mode-map (make-sparse-keymap)
  161.   "Keymap for searching folder.")
  162.  
  163. (defvar mh-letter-mode-syntax-table nil
  164.   "Syntax table used while in mh-e letter mode.")
  165.  
  166. (if mh-letter-mode-syntax-table
  167.     ()
  168.     (setq mh-letter-mode-syntax-table
  169.       (make-syntax-table text-mode-syntax-table))
  170.     (set-syntax-table mh-letter-mode-syntax-table)
  171.     (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
  172.  
  173. (defvar mh-folder-list nil
  174.   "List of folder names for completion.")
  175.  
  176. (defvar mh-draft-folder nil
  177.   "Name of folder containing draft messages.
  178. NIL means do not use draft folder.")
  179.  
  180. (defvar mh-unseen-seq nil
  181.   "Name of the unseen sequence.")
  182.  
  183.  
  184. ;;; Macros and generic functions:
  185.  
  186. (defmacro mh-push (v l)
  187.   (list 'setq l (list 'cons v l)))
  188.  
  189. (defmacro when (pred &rest body)
  190.   (list 'cond (cons pred body)))
  191.  
  192. (defun mapc (func list)
  193.   (while list
  194.     (funcall func (car list))
  195.     (setq list (cdr list))))
  196.  
  197.  
  198. (defun mh-list* (&rest args) (mh-make-list* args))
  199.  
  200. (defun mh-make-list* (arglist)
  201.   (cond ((null arglist) ())
  202.     ((null (cdr arglist)) (car arglist))
  203.     (t (cons (car arglist) (mh-make-list* (cdr arglist))))))
  204.  
  205.  
  206.  
  207. ;;; Entry points:
  208.  
  209. (defun mh-rmail (&optional arg)
  210.   "Inc(orporate) new mail (no arg) or scan a MH mail box (arg given).
  211. This front end uses the MH mail system, which uses different conventions
  212. from the usual mail system."
  213.   (interactive "P")
  214.   (mh-find-path)
  215.   (if arg
  216.       (call-interactively 'mh-visit-folder)
  217.       (mh-inc-folder)))
  218.  
  219.  
  220. (defun mh-smail ()
  221.   "Send mail using the MH mail system."
  222.   (interactive)
  223.   (mh-find-path)
  224.   (call-interactively 'mh-send))
  225.  
  226.  
  227. (defun mh-smail-other-window ()
  228.   "Send mail in other window using the MH mail system."
  229.   (interactive)
  230.   (mh-find-path)
  231.   (call-interactively 'mh-send-other-window))
  232.  
  233.  
  234.  
  235. ;;; User executable mh-e commands:
  236.  
  237. (defun mh-burst-digest ()
  238.   "Burst apart the current message, which should be a digest.  Message is
  239. replaced by its table of contents and the letters from the digest are inserted
  240. into the folder after that message."
  241.   (interactive)
  242.   (let ((digest (mh-get-msg-num t)))
  243.     (mh-process-or-undo-commands mh-current-folder)
  244.     (message "Bursting digest...")
  245.     (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
  246.     (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
  247.     (message "Bursting digest...done")))
  248.  
  249.  
  250. (defun mh-copy-msg (prefix-provided msg-or-seq dest)
  251.   "Copy specified MESSAGE(s) (default: displayed message) to another
  252. FOLDER without deleting them.
  253. If (optional) prefix argument provided, then prompt for the message sequence."
  254.   (interactive (list current-prefix-arg
  255.              (if current-prefix-arg
  256.              (mh-read-seq "Copy" t mh-narrowed-to-seq)
  257.              (mh-get-msg-num t))
  258.              (mh-prompt-for-folder "Copy to" "" t)))
  259.   (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest)
  260.   (if prefix-provided
  261.       (mh-notate-seq msg-or-seq ?C mh-cmd-note)
  262.       (mh-notate msg-or-seq ?C mh-cmd-note)))
  263.  
  264.  
  265. (defun mh-delete-msg (prefix-provided msg-or-seq)
  266.   "Mark the specified MESSAGE(s) (default: displayed message) for later
  267. deletion.
  268. If (optional) prefix argument provided, then prompt for the message sequence."
  269.   (interactive (list current-prefix-arg
  270.              (if current-prefix-arg
  271.              (mh-read-seq "Delete" t mh-narrowed-to-seq)
  272.              (mh-get-msg-num t))))
  273.   (if prefix-provided
  274.       (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)
  275.       (mh-delete-a-msg msg-or-seq))
  276.   (mh-next-msg))
  277.  
  278.  
  279. (defun mh-delete-msg-from-seq (prefix-provided msg-or-seq &optional from-seq)
  280.   "Delete MESSAGE (default: displayed message) from SEQUENCE.
  281. If (optional) prefix argument provided, then delete all messages from a
  282. sequence."
  283.   (interactive (let ((argp current-prefix-arg))
  284.          (list argp
  285.                (if argp
  286.                (mh-read-seq "Delete" t mh-narrowed-to-seq)
  287.                (mh-get-msg-num t))
  288.                (if (not argp)
  289.                (mh-read-seq "Delete from" t mh-narrowed-to-seq)))))
  290.   (if prefix-provided
  291.       (mh-remove-seq msg-or-seq)
  292.       (mh-remove-msg-from-seq msg-or-seq from-seq)))
  293.  
  294.  
  295. (defun mh-edit-again (msg)
  296.   "Clean-up a draft or a message previously sent and make it resendable."
  297.   (interactive (list (mh-get-msg-num t)))
  298.   (let* ((from-folder mh-current-folder)
  299.      (config (current-window-configuration))
  300.      (draft
  301.       (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
  302.          (find-file (mh-msg-filename msg))
  303.          (rename-buffer (format "draft-%d" msg))
  304.          (buffer-name))
  305.         (t
  306.          (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
  307.     (mh-clean-msg-header (point-min)
  308.              "^Date:\\|^Received:\\|^Message-Id:\\|^From:"
  309.              nil)
  310.     (goto-char (point-min))
  311.     (set-buffer-modified-p nil)
  312.     (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
  313.                   config)))
  314.  
  315.  
  316. (defun mh-execute-commands ()
  317.   "Process outstanding delete and refile requests."
  318.   (interactive)
  319.   (if mh-narrowed-to-seq (mh-widen))
  320.   (save-excursion
  321.     (mh-process-commands mh-current-folder))
  322.   (mh-goto-cur-msg)
  323.   (mh-set-scan-mode)
  324.   (mh-make-folder-mode-line))
  325.  
  326.  
  327. (defun mh-extract-rejected-mail (msg)
  328.   "Extract a letter returned by the mail system (default: displayed message)
  329. and make it resendable."
  330.   (interactive (list (mh-get-msg-num t)))
  331.   (let ((from-folder mh-current-folder)
  332.     (config (current-window-configuration))
  333.     (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
  334.     (goto-char (point-min))
  335.     (cond ((re-search-forward mh-rejected-letter-start nil t)
  336.        (forward-char 1)
  337.        (delete-region (point-min) (point))
  338.        (mh-clean-msg-header (point-min)
  339.                 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:"
  340.                 nil))
  341.       (t
  342.        (message "Does not appear to be a rejected letter.")))
  343.     (goto-char (point-min))
  344.     (set-buffer-modified-p nil)
  345.     (mh-compose-and-send-mail draft "" from-folder msg (mh-get-field "To")
  346.                   (mh-get-field "From") (mh-get-field "cc")
  347.                   nil nil config)))
  348.  
  349.  
  350. (defun mh-forward (prefix-provided msg-or-seq to cc)
  351.   "Forward MESSAGE(s) (default: displayed message).
  352. If (optional) prefix argument provided, then prompt for the message sequence."
  353.   (interactive (list current-prefix-arg
  354.              (if current-prefix-arg
  355.              (mh-read-seq "Forward" t mh-narrowed-to-seq)
  356.              (mh-get-msg-num t))
  357.              (read-string "To: ")
  358.              (read-string "Cc: ")))
  359.   (let* ((msg-filename (mh-msg-filename msg-or-seq))
  360.      (folder mh-current-folder)
  361.      (config (current-window-configuration))
  362.      ;; forw always leaves file in "draft" since it doesn't have -draft
  363.      (draft-name (mh-expand-file-name "draft" mh-user-path))
  364.      (draft (cond ((or (not (file-exists-p draft-name))
  365.                (y-or-n-p "The file 'draft' exists.  Discard it? "))
  366.                (mh-exec-cmd "forw" "-build"
  367.                     mh-current-folder msg-or-seq)
  368.                (prog1
  369.                (mh-read-draft "" draft-name t)
  370.              (mh-insert-fields "To:" to "Cc:" cc)
  371.              (set-buffer-modified-p nil)))
  372.               (t
  373.                (mh-read-draft "" draft-name nil)))))
  374.     (goto-char (point-min))
  375.     (re-search-forward "^------- Forwarded Message")
  376.     (previous-line 1)
  377.     (narrow-to-region (point) (point-max))
  378.     (let* ((subject (save-excursion (mh-get-field "From:")))
  379.        (trim (string-match "<" subject))
  380.        (forw-subject (save-excursion (mh-get-field "Subject:"))))
  381.       (if trim
  382.       (setq subject (substring subject 0 (1- trim))))
  383.       (widen)
  384.       (save-excursion
  385.     (mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject)))
  386.       (delete-other-windows)
  387.       (if prefix-provided
  388.       (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)
  389.       (mh-add-msgs-to-seq msg-or-seq 'forwarded t))
  390.       (mh-compose-and-send-mail draft "" folder msg-or-seq
  391.                 to subject cc
  392.                 "F" "Forwarded:"
  393.                 config))))
  394.  
  395.  
  396. (defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
  397.   "Position the cursor at message NUMBER.
  398. Non-nil second argument means do not signal an error if message does not exist.
  399. Non-nil third argument means not to show the message.
  400. Return non-nil if cursor is at message."
  401.   (interactive "NMessage number? ")
  402.   (let ((cur-msg (mh-get-msg-num nil))
  403.     (starting-place (point))
  404.     (msg-pattern (mh-msg-search-pat number)))
  405.     (cond ((cond ((and cur-msg (= cur-msg number)) t)
  406.          ((and cur-msg
  407.                (< cur-msg number)
  408.                (re-search-forward msg-pattern nil t)) t)
  409.          ((and cur-msg
  410.                (> cur-msg number)
  411.                (re-search-backward msg-pattern nil t)) t)
  412.          (t            ; Do thorough search of buffer
  413.           (goto-char (point-min))
  414.           (re-search-forward msg-pattern nil t)))
  415.         (beginning-of-line)
  416.         (if (not dont-show) (mh-maybe-show number))
  417.         t)
  418.       (t
  419.        (goto-char starting-place)
  420.        (if (not no-error-if-no-message)
  421.            (error "No message %d " number))
  422.        nil))))
  423.  
  424.  
  425. (defun mh-inc-folder (&optional maildrop-name)
  426.   "Inc(orporate) new mail into +inbox.
  427. Optional prefix argument specifies an alternate maildrop from the default.
  428. If this is given, mail is incorporated into the current folder, rather
  429. than +inbox."
  430.   (interactive (list (if current-prefix-arg
  431.              (expand-file-name
  432.               (read-file-name "inc mail from file: "
  433.                       mh-user-path)))))
  434.   (let ((config (current-window-configuration)))
  435.     (if (not maildrop-name)
  436.     (cond ((not (get-buffer "+inbox"))
  437.            (mh-make-folder "+inbox")
  438.            (setq mh-previous-window-config config))
  439.           ((not (eq (current-buffer) (get-buffer "+inbox")))
  440.            (switch-to-buffer "+inbox")
  441.            (setq mh-previous-window-config config)))))
  442.   (mh-get-new-mail maildrop-name)
  443.   (run-hooks 'mh-inc-folder-hook))
  444.  
  445.  
  446. (defun mh-kill-folder ()
  447.   "Remove the current folder."
  448.   (interactive)
  449.   (if (or mh-do-not-confirm
  450.       (yes-or-no-p (format "Remove folder %s? " mh-current-folder)))
  451.       (let ((folder mh-current-folder))
  452.     (mh-exec-cmd-demon "rmf" folder)
  453.     (mh-remove-folder-from-folder-list folder)
  454.     (message "Folder removed")
  455.     (kill-buffer folder))
  456.       (message "Folder not removed")))
  457.  
  458.  
  459. (defun mh-list-folders ()
  460.   "List mail folders."
  461.   (interactive)
  462.   (with-output-to-temp-buffer " *mh-temp*"
  463.     (save-excursion
  464.       (switch-to-buffer " *mh-temp*")
  465.       (erase-buffer)
  466.       (message "listing folders...")
  467.       (mh-exec-cmd-output "folders" t)
  468.       (goto-char (point-min))
  469.       (message "listing folders...done"))))
  470.  
  471.  
  472. (defun mh-msg-is-in-seq (msg)
  473.   "Display the sequences that contain MESSAGE (default: displayed message)."
  474.   (interactive (list (mh-get-msg-num t)))
  475.   (message "Message %d is in sequences: %s"
  476.        msg
  477.        (mapconcat 'concat
  478.               (mh-list-to-string (mh-seq-containing-msg msg))
  479.               " ")))
  480.  
  481.  
  482. (defun mh-narrow-to-seq (seq)
  483.   "Restrict display of this folder to just messages in a sequence.
  484. Reads which sequence.  Use \\[mh-widen] to undo this command."
  485.   (interactive (list (mh-read-seq "Narrow to" t)))
  486.   (let ((eob (point-max))
  487.     (buffer-read-only nil))
  488.     (cond ((mh-seq-to-msgs seq)
  489.        (mh-copy-seq-to-point seq eob)
  490.        (narrow-to-region eob (point-max))
  491.        (mh-make-folder-mode-line (symbol-name seq))
  492.        (recenter)
  493.        (setq mh-narrowed-to-seq seq))
  494.       (t
  495.        (error "No messages in sequence `%s'" (symbol-name seq))))))
  496.  
  497.  
  498. (defun mh-next-undeleted-msg (&optional arg)
  499.   "Move to next undeleted message in window."
  500.   (interactive "p")
  501.   (forward-line (if arg arg 1))
  502.   (setq mh-next-direction 'forward)
  503.   (cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
  504.      (beginning-of-line)
  505.      (mh-maybe-show (mh-get-msg-num t)))
  506.     (t
  507.      (forward-line -1)
  508.      (if (get-buffer mh-show-buffer)
  509.          (delete-windows-on mh-show-buffer)))))
  510.  
  511.  
  512. (defun mh-pack-folder ()
  513.   "Execute any outstanding commands for the current folder, then renumber the
  514. remaining messages to be 1..N."
  515.   (interactive)
  516.   (message "packing buffer...")
  517.   (mh-pack-folder-1)
  518.   (mh-goto-cur-msg)
  519.   (message "packing buffer...done"))
  520.  
  521.  
  522. (defun mh-refile-msg (prefix-provided msg-or-seq dest)
  523.   "Refile MESSAGE(s) (default: displayed message) in FOLDER.
  524. If (optional) prefix argument provided, then prompt for message sequence."
  525.   (interactive (list current-prefix-arg
  526.              (if current-prefix-arg
  527.              (mh-read-seq "Refile" t mh-narrowed-to-seq)
  528.              (mh-get-msg-num t))
  529.              (intern (mh-prompt-for-folder "Destination" "" t))))
  530.   (setq mh-last-destination (cons 'refile dest))
  531.   (if prefix-provided
  532.       (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest)
  533.       (mh-refile-a-msg msg-or-seq dest))
  534.   (mh-next-msg))
  535.  
  536.  
  537. (defun mh-refile-or-write-again (msg)
  538.   "Re-execution the last refile or write command on the given MESSAGE (default:
  539. displayed message).
  540. Use the same folder or file as the previous refile or write command."
  541.   (interactive (list (mh-get-msg-num t)))
  542.   (if (null mh-last-destination)
  543.       (error "No previous refile"))
  544.   (cond ((eq (car mh-last-destination) 'refile)
  545.      (mh-refile-a-msg msg (cdr mh-last-destination))
  546.      (message "Destination folder: %s" (cdr mh-last-destination)))
  547.     (t
  548.      (mh-write-msg-to-file msg (cdr mh-last-destination))
  549.      (message "Destination: %s" (cdr mh-last-destination))))
  550.   (mh-next-msg))
  551.  
  552.  
  553. (defun mh-reply (prefix-provided msg)
  554.   "Reply to a MESSAGE (default: displayed message).
  555. If (optional) prefix argument provided, then include the message in the reply."
  556.   (interactive (list current-prefix-arg (mh-get-msg-num t)))
  557.   (let ((minibuffer-help-form
  558.      "from => Sender\n  to => Sender and primary recipients\n  cc => Sender and all recipients"))
  559.     (let ((reply-to
  560.        (completing-read "Reply to whom: " '(("from") ("to") ("cc")) nil t))
  561.       (msg-filename (mh-msg-filename msg))
  562.       (folder mh-current-folder)
  563.       (show-buffer mh-show-buffer)
  564.       (config (current-window-configuration)))
  565.       (message "Composing a reply...")
  566.       (cond ((or (equal reply-to "from") (equal reply-to ""))
  567.          (apply 'mh-exec-cmd
  568.             (mh-list* "repl" "-build"
  569.                   "-nodraftfolder" mh-current-folder
  570.                   msg
  571.                   "-nocc" "all"
  572.                   (if prefix-provided
  573.                   (list "-filter" "mhl.reply")))))
  574.         ((equal reply-to "to")
  575.          (apply 'mh-exec-cmd
  576.             (mh-list* "repl" "-build"
  577.                   "-nodraftfolder" mh-current-folder
  578.                   msg
  579.                   "-cc" "to"
  580.                   (if prefix-provided
  581.                   (list "-filter" "mhl.reply")))))
  582.         ((equal reply-to "cc")
  583.          (apply 'mh-exec-cmd
  584.             (mh-list* "repl" "-build"
  585.                   "-nodraftfolder" mh-current-folder
  586.                   msg
  587.                   "-cc" "all" "-nocc" "me"
  588.                   (if prefix-provided
  589.                   (list "-filter" "mhl.reply"))))))
  590.  
  591.       (let ((draft (mh-read-draft "reply"
  592.                   (mh-expand-file-name "reply" mh-user-path)
  593.                   t)))
  594.     (delete-other-windows)
  595.     (set-buffer-modified-p nil)
  596.  
  597.     (let ((to (mh-get-field "To:"))
  598.           (subject (mh-get-field "Subject:"))
  599.           (cc (mh-get-field "Cc:")))
  600.       (goto-char (point-min))
  601.       (mh-goto-header-end 1)
  602.       (if (not prefix-provided)
  603.           (mh-display-msg msg msg-filename show-buffer))
  604.       (mh-add-msgs-to-seq msg 'answered t)
  605.       (message "Composing a reply...done")
  606.       (mh-compose-and-send-mail draft "" folder msg to subject cc
  607.                     "-" "Replied:" config))))))
  608.  
  609.  
  610. (defun mh-restore-window-config ()
  611.   "Restore the previous window configuration, if one exists."
  612.   (interactive)
  613.   (if mh-previous-window-config
  614.       (set-window-configuration mh-previous-window-config)))
  615.  
  616.  
  617. (defun mh-page-digest ()
  618.   "Advance displayed message to next digested message."
  619.   (interactive)
  620.   (save-excursion
  621.     (mh-show-message-in-other-window)
  622.     ;; Go to top of screen (in case user moved point).
  623.     (move-to-window-line 0)
  624.     (let ((case-fold-search nil))
  625.       ;; Search for blank line and then for From:
  626.       (when (not (and (search-forward "\n\n" nil t)
  627.               (search-forward "From:" nil t)))
  628.     (other-window -1)
  629.     (error "No more messages.")))
  630.     ;; Go back to previous blank line, then forward to the first non-blank.
  631.     (search-backward "\n\n" nil t)
  632.     (forward-line 2)
  633.     (recenter 0)
  634.     (other-window -1)))
  635.  
  636.  
  637. (defun mh-page-digest-backwards ()
  638.   "Back up displayed message to previous digested message."
  639.   (interactive)
  640.   (save-excursion
  641.     (mh-show-message-in-other-window)
  642.     ;; Go to top of screen (in case user moved point).
  643.     (move-to-window-line 0)
  644.     (let ((case-fold-search nil))
  645.       (beginning-of-line)
  646.       (when (not (and (search-backward "\n\n" nil t)
  647.               (search-backward "From:" nil t)))
  648.     (other-window -1)
  649.     (error "No more messages.")))
  650.     ;; Go back to previous blank line, then forward to the first non-blank.
  651.     (search-backward "\n\n" nil t)
  652.     (forward-line 2)
  653.     (recenter 0)
  654.     (other-window -1)))
  655.  
  656.  
  657. (defun mh-page-msg (&optional arg)
  658.   "Page the displayed message forwards ARG lines or a full screen if no
  659. argument is supplied."
  660.   (interactive "P")
  661.   (scroll-other-window arg))
  662.  
  663.  
  664. (defun mh-previous-page (&optional arg)
  665.   "Page the displayed message backwards ARG lines or a full screen if no
  666. argument is supplied."
  667.   (interactive "P")
  668.   (save-excursion
  669.     (mh-show-message-in-other-window)
  670.     (unwind-protect
  671.     (scroll-down arg)
  672.       (other-window -1))))
  673.  
  674.  
  675. (defun mh-previous-undeleted-msg (&optional arg)
  676.   "Move to previous undeleted message in window."
  677.   (interactive "p")
  678.   (setq mh-next-direction 'backward)
  679.   (beginning-of-line 1)
  680.   (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
  681.      (mh-maybe-show (mh-get-msg-num t)))
  682.     (t
  683.      (if (get-buffer mh-show-buffer)
  684.          (delete-windows-on mh-show-buffer)))))
  685.  
  686.  
  687. (defun mh-print-msg (prefix-provided msg-or-seq)
  688.   "Print MESSAGE(s) (default: displayed message) on a line printer.
  689. If (optional) prefix argument provided, then prompt for the message sequence."
  690.   (interactive (list current-prefix-arg
  691.              (if current-prefix-arg
  692.              (reverse (mh-seq-to-msgs
  693.                    (mh-read-seq "Print" t mh-narrowed-to-seq)))
  694.              (list (mh-get-msg-num t)))))
  695.   (message "printing message...")
  696.   (let ((command
  697.      (if prefix-provided
  698.          (format "(scan -clear %s ; %s -nobell -clear %s) | %s"
  699.              (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
  700.              (mh-expand-file-name "mhl" mh-lib)
  701.              (mh-msg-filenames msg-or-seq mh-folder-filename)
  702.              (format mh-lpr-command-format
  703.                  (if prefix-provided
  704.                  (format "Sequence from %s" mh-current-folder)
  705.                  (format "%s/%d" mh-current-folder
  706.                      (car msg-or-seq)))))
  707.          (format "%s -nobell -clear %s | %s"
  708.              (mh-expand-file-name "mhl" mh-lib)
  709.              (mh-msg-filenames msg-or-seq mh-folder-filename)
  710.              (format mh-lpr-command-format
  711.                  (if prefix-provided
  712.                  (format "Sequence from %s" mh-current-folder)
  713.                  (format "%s/%d" mh-current-folder
  714.                      (car msg-or-seq))))))))
  715.     (if mh-print-background
  716.     (mh-exec-cmd-demon shell-file-name "-c" command)
  717.     (call-process shell-file-name nil nil nil "-c" command))
  718.     (if prefix-provided
  719.     (mh-notate-seq msg-or-seq ?P mh-cmd-note)
  720.     (mh-notate (car msg-or-seq) ?P mh-cmd-note))
  721.     (mh-add-msgs-to-seq msg-or-seq 'printed t)
  722.     (message "printing message...done")))
  723.  
  724.  
  725. (defun mh-put-msg-in-seq (prefix-provided from to)
  726.   "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
  727. If (optional) prefix argument provided, then prompt for the message sequence."
  728.   (interactive (list current-prefix-arg
  729.              (if current-prefix-arg
  730.              (mh-seq-to-msgs
  731.                (mh-read-seq "Add messages from" t
  732.                     mh-narrowed-to-seq))
  733.              (mh-get-msg-num t))
  734.              (mh-read-seq "Add to" nil mh-narrowed-to-seq)))
  735.   (mh-add-msgs-to-seq from to))
  736.  
  737.  
  738. (defun mh-rescan-folder (range)
  739.   "Rescan a folder after optionally processing the outstanding commands.
  740. If (optional) prefix argument provided, prompt for the range of messages to
  741. display.  Otherwise show the entire folder."
  742.   (interactive (list (if current-prefix-arg
  743.               (read-string "Range [all]? ")
  744.               "all")))
  745.   (setq mh-next-direction 'forward)
  746.   (mh-scan-folder mh-current-folder range))
  747.  
  748.  
  749. (defun mh-redistribute (to cc msg)
  750.   "Redistribute a letter."
  751.   (interactive (list (read-string "Redist-To: ")
  752.              (read-string "Redist-Cc: ")
  753.              (mh-get-msg-num t)))
  754.   (save-window-excursion
  755.     (let ((msg-filename (mh-msg-filename msg))
  756.       (folder mh-current-folder)
  757.       (draft (mh-read-draft "redistribution"
  758.                 (if mh-redist-full-contents
  759.                     (mh-msg-filename msg)
  760.                     nil)
  761.                 nil)))
  762.       (mh-goto-header-end 0)
  763.       (insert "Resent-To: " to "\n")
  764.       (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
  765.       (mh-clean-msg-header (point-min)
  766.                "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
  767.                nil)
  768.       (save-buffer)
  769.       (message "Redistributing...")
  770.       (if mh-redist-full-contents
  771.       (call-process "/bin/sh" nil 0 nil "-c"
  772.             (format "mhdist=1 mhaltmsg=%s -push %s"
  773.                 (buffer-file-name)
  774.                 (mh-expand-file-name "send" mh-progs)
  775.                 (buffer-file-name)))
  776.       (call-process "/bin/sh" nil 0 nil "-c"
  777.             (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
  778.                 msg-filename
  779.                 (mh-expand-file-name "send" mh-progs)
  780.                 (buffer-file-name))))
  781.       (mh-annotate-msg msg folder "R"
  782.                "-component" "Resent:"
  783.                "-text" (format "\"%s %s\"" to cc))
  784.       (kill-buffer draft)
  785.       (message "Redistributing...done"))))
  786.  
  787.  
  788. (defun mh-write-msg-to-file (msg file)
  789.   "Append MESSAGE to the end of a FILE."
  790.   (interactive (list (mh-get-msg-num t)
  791.              (expand-file-name
  792.               (read-file-name "Save message in file: "))))
  793.   (setq mh-last-destination (cons 'write file))
  794.   (let ((file-name (mh-msg-filename msg)))
  795.     (save-excursion
  796.       (set-buffer (get-buffer-create " *mh-temp*"))
  797.       (erase-buffer)
  798.       (insert-file-contents file-name)
  799.       (append-to-file (point-min) (point-max) file))))
  800.  
  801.  
  802. (defun mh-search-folder (folder)
  803.   "Search FOLDER for messages matching a pattern."
  804.   (interactive (list (mh-prompt-for-folder "Search"
  805.                        mh-current-folder
  806.                        t)))
  807.   (switch-to-buffer-other-window "pick-pattern")
  808.   (if (or (zerop (buffer-size))
  809.       (not (y-or-n-p "Reuse pattern? ")))
  810.       (mh-make-pick-template)
  811.       (message ""))
  812.   (setq mh-searching-folder folder))
  813.  
  814.  
  815. (defun mh-send (to cc subject)
  816.   "Compose and send a letter."
  817.   (interactive "sTo: \nsCc: \nsSubject: ")
  818.   (let ((config (current-window-configuration)))
  819.     (delete-other-windows)
  820.     (mh-send-sub to cc subject config)))
  821.  
  822.  
  823. (defun mh-send-other-window (to cc subject)
  824.   "Compose and send a letter in another window.."
  825.   (interactive "sTo: \nsCc: \nsSubject: ")
  826.   (let ((pop-up-windows t))
  827.     (mh-send-sub to cc subject (current-window-configuration))))
  828.  
  829.  
  830. (defun mh-send-sub (to cc subject config)
  831.   "Do the real work of composing and sending a letter.
  832. Expects the TO, CC, and SUBJECT fields as arguments.
  833. CONFIG is the window configuration before sending mail."
  834.   (let ((folder (if (boundp 'mh-current-folder) mh-current-folder))
  835.     (msg-num (mh-get-msg-num nil)))
  836.     (message "Composing a message...")
  837.     (let ((draft (mh-read-draft
  838.           "message"
  839.           (if (file-exists-p (mh-expand-file-name "components"
  840.                               mh-user-path))
  841.               (mh-expand-file-name "components" mh-user-path)
  842.               (if (file-exists-p (mh-expand-file-name "components"
  843.                                   mh-lib))
  844.               (mh-expand-file-name "components" mh-lib)
  845.               (error "Can't find components file")))
  846.           nil)))
  847.       (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
  848.       (set-buffer-modified-p nil)
  849.       (goto-char (point-max))
  850.       (message "Composing a message...done")
  851.       (mh-compose-and-send-mail draft "" folder msg-num
  852.                 to subject cc
  853.                 nil nil config))))
  854.  
  855.  
  856. (defun mh-show (msg)
  857.   "Show MESSAGE (default: displayed message)."
  858.   (interactive (list (mh-get-msg-num t)))
  859.   (setq mh-summarize nil)
  860.   (mh-set-mode-name "mh-e show")
  861.   (let ((folder mh-current-folder))
  862.     (mh-display-msg msg (mh-msg-filename msg) mh-show-buffer)
  863.  
  864.     ;; These contortions are to force the summary line to be the top window.
  865.     (switch-to-buffer-other-window folder)
  866.     (delete-other-windows)
  867.     (mh-show-message-in-other-window)
  868.     (switch-to-buffer-other-window folder)
  869.     (shrink-window (- (window-height) mh-summary-height))
  870.     (recenter '(4))            ;center this line
  871.     (if mh-bury-show-buffer (bury-buffer mh-show-buffer))
  872.     (if (not (memq msg mh-seen-list)) (mh-push msg mh-seen-list))))
  873.  
  874.  
  875. (defun mh-sort-folder ()
  876.   "Sort the messages in the current folder by date."
  877.   (interactive "")
  878.   (mh-process-or-undo-commands mh-current-folder)
  879.   (setq mh-next-direction 'forward)
  880.   (message "sorting folder...")
  881.   (mh-exec-cmd "sortm" mh-current-folder)
  882.   (message "sorting folder...done")
  883.   (mh-scan-folder mh-current-folder "all"))
  884.  
  885.  
  886. (defun mh-toggle-summarize ()
  887.   "Turn the summary mode of displaying messages on or off."
  888.   (interactive)
  889.   (if mh-summarize
  890.       (mh-show (mh-get-msg-num t))
  891.       (mh-set-scan-mode)))
  892.  
  893.  
  894. (defun mh-undo (prefix-provided msg-or-seq)
  895.   "Undo the deletion or refile of the specified MESSAGE(s)
  896. \(default: displayed message).
  897. If (optional) prefix argument provided, then prompt for the message sequence."
  898.   (interactive (list current-prefix-arg
  899.              (if current-prefix-arg
  900.              (mh-read-seq "Undo" t mh-narrowed-to-seq)
  901.              (mh-get-msg-num t))))
  902.   (beginning-of-line)
  903.   (cond ((looking-at "^....D")
  904.      (cond (prefix-provided
  905.         (mapc (function (lambda (msg)
  906.             (setq mh-delete-list
  907.                   (delq msg mh-delete-list))
  908.             (mh-remove-msg-from-seq msg 'deleted t)))
  909.               (mh-seq-to-msgs msg-or-seq))
  910.         (mh-notate-seq msg-or-seq ?  mh-cmd-note))
  911.            (t
  912.         (setq mh-delete-list (delq msg-or-seq mh-delete-list))
  913.         (mh-remove-msg-from-seq msg-or-seq 'deleted t)
  914.         (mh-notate msg-or-seq ?  mh-cmd-note))))
  915.  
  916.     ((looking-at "^....\\^")
  917.      (cond (prefix-provided
  918.         (mapc (function (lambda (msg)
  919.             (mapc (function
  920.                    (lambda (dest)
  921.                 (mh-remove-msg-from-seq msg dest t)))
  922.                   mh-refile-list)))
  923.               (mh-seq-to-msgs msg-or-seq))
  924.         (mh-notate-seq msg-or-seq ?  mh-cmd-note))
  925.            (t
  926.         (mapc (function (lambda (dest)
  927.             (mh-remove-msg-from-seq msg-or-seq dest t)))
  928.               mh-refile-list)
  929.         (mh-notate msg-or-seq ?  mh-cmd-note))))
  930.  
  931.     (t nil))
  932.   (if (mh-outstanding-commands-p)
  933.       (mh-set-folder-modified-p nil)))
  934.  
  935.  
  936. (defun mh-undo-folder ()
  937.   "Undo all commands in current folder."
  938.   (interactive "")
  939.   (cond ((or mh-do-not-confirm
  940.          (yes-or-no-p "Undo all commands in folder? "))
  941.      (setq mh-delete-list nil
  942.            mh-refile-list nil
  943.            mh-seq-list nil
  944.            mh-next-direction 'forward)
  945.      (mh-unmark-all-headers t)
  946.      (mh-set-folder-modified-p nil))
  947.     (t
  948.      (message "Commands not undone.")
  949.      (sit-for 2))))
  950.  
  951.  
  952. (defun mh-visit-folder (folder range config)
  953.   "Visit FOLDER and display RANGE of messages."
  954.   (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t)
  955.              (read-string "Range [all]? ")
  956.              (current-window-configuration)))
  957.     (mh-scan-folder folder (if (equal range "") "all" range))
  958.     (setq mh-previous-window-config config))
  959.  
  960.  
  961. (defun mh-widen ()
  962.   "Remove restrictions from the current folder, thereby showing all messages."
  963.   (interactive "")
  964.   (let ((buffer-read-only nil))
  965.     (delete-region (point-min) (point-max))
  966.     (widen)
  967.     (mh-make-folder-mode-line))
  968.   (setq mh-narrowed-to-seq nil))
  969.  
  970.  
  971.  
  972. ;;; Support routines.
  973.  
  974. (defun mh-delete-a-msg (msg)
  975.   ;; Delete the MESSAGE.
  976.   (save-excursion
  977.     (mh-goto-msg msg nil nil)
  978.     (if (looking-at "....\\^")
  979.     (error "Message %d is refiled.  Undo refile before deleting." msg))
  980.     (mh-push msg mh-delete-list)
  981.     (mh-add-msgs-to-seq msg 'deleted t)
  982.     (mh-notate msg ?D mh-cmd-note)
  983.     (mh-set-folder-modified-p t)))
  984.  
  985.  
  986. (defun mh-refile-a-msg (msg destination)
  987.   ;; Refile the MESSAGE in the FOLDER.
  988.   (save-excursion
  989.     (mh-goto-msg msg nil nil)
  990.     (cond ((looking-at "....D")
  991.        (error "Message %d is deleted.  Undo delete before moving." msg))
  992.       (t
  993.        (if (not (memq destination mh-refile-list))
  994.            (mh-push destination mh-refile-list))
  995.        (mh-add-msgs-to-seq msg destination t)
  996.        (mh-notate msg ?^ mh-cmd-note)
  997.        (mh-set-folder-modified-p t)))))
  998.  
  999.  
  1000. (defun mh-display-msg (msg-num msg-filename show-buffer)
  1001.   ;; Display the message NUMBER and PATHNAME in BUFFER.
  1002.   (if (not (file-exists-p msg-filename))
  1003.       (error "Message %d does not exist." msg-num))
  1004.   ;; Bind these variables in case they are local to folder buffer.
  1005.   (let ((formfile mhl-formfile)
  1006.     (clean-message-header mh-clean-message-header)
  1007.     (invisible-headers mh-invisible-headers)
  1008.     (visible-headers mh-visible-headers))
  1009.     (switch-to-buffer show-buffer)
  1010.     (if mh-bury-show-buffer (bury-buffer (current-buffer)))
  1011.     (when (not (equal msg-filename buffer-file-name))
  1012.       ;; Buffer does not yet contain message.
  1013.       (clear-visited-file-modtime)
  1014.       (unlock-buffer)
  1015.       (erase-buffer)
  1016.       (if formfile
  1017.       (if (stringp formfile)
  1018.           (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
  1019.                       "-form" formfile msg-filename)
  1020.           (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
  1021.                       msg-filename))
  1022.       (insert-file-contents msg-filename t))
  1023.       (goto-char (point-min))
  1024.       (cond (clean-message-header
  1025.          (mh-clean-msg-header (point-min)
  1026.                   invisible-headers
  1027.                   visible-headers)
  1028.          (goto-char (point-min)))
  1029.         (t
  1030.          (let ((case-fold-search t))
  1031.            (re-search-forward
  1032.         "^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
  1033.            (beginning-of-line)
  1034.            (recenter 0))))
  1035.       (set-buffer-modified-p nil)
  1036.       (setq buffer-file-name msg-filename)
  1037.       (set-mark nil)
  1038.       (setq mode-line-buffer-identification
  1039.         (list "{%b}  " (format "%s" folder) "/" (format "%d" msg-num))))))
  1040.  
  1041.  
  1042. (defun mh-show-message-in-other-window ()
  1043.   (let ((buffer mh-show-buffer))
  1044.     (switch-to-buffer-other-window buffer)
  1045.     (if mh-bury-show-buffer (bury-buffer (current-buffer)))))
  1046.  
  1047.  
  1048. (defun mh-clean-msg-header (start invisible-headers visible-headers)
  1049.   ;; Flush extraneous lines in a message header, from the given POINT to the
  1050.   ;; end of the message header.  If VISIBLE-HEADERS is non-nil, it contains a
  1051.   ;; regular expression specifying the lines to display, otherwise
  1052.   ;; INVISIBLE-HEADERS contains a regular expression specifying lines to
  1053.   ;; delete from the header.
  1054.   (let ((case-fold-search t))
  1055.     (save-restriction
  1056.       (goto-char start)
  1057.       (if (search-forward "\n\n" nil t)
  1058.       (backward-char 2))
  1059.       (narrow-to-region start (point))
  1060.       (goto-char (point-min))
  1061.       (if visible-headers
  1062.       (while (< (point) (point-max))
  1063.         (beginning-of-line)
  1064.         (cond ((looking-at visible-headers)
  1065.            (forward-line 1)
  1066.            (while (looking-at "^[ \t]+") (forward-line 1)))
  1067.           (t
  1068.             (mh-delete-line 1)
  1069.             (while (looking-at "^[ \t]+")
  1070.               (beginning-of-line)
  1071.               (mh-delete-line 1)))))
  1072.       (while (re-search-forward invisible-headers nil t)
  1073.         (beginning-of-line)
  1074.         (mh-delete-line 1)
  1075.         (while (looking-at "^[ \t]+")
  1076.           (beginning-of-line)
  1077.           (mh-delete-line 1))))
  1078.       (unlock-buffer))))
  1079.  
  1080.  
  1081. (defun mh-delete-line (lines)
  1082.   ;; Delete version of kill-line.
  1083.   (delete-region (point) (save-excursion (forward-line lines) (point))))
  1084.  
  1085.  
  1086. (defun mh-read-draft (use initial-contents delete-contents-file)
  1087.   ;; Read draft file into a draft buffer and make that buffer the current one.
  1088.   ;; USE is a message used for prompting about the intended use of the message.
  1089.   ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
  1090.   ;; if buffer should not be modified.  Delete the initial-contents file if
  1091.   ;; DELETE-CONTENTS-FILE flag is set.
  1092.   ;; Returns the draft folder's name.
  1093.   ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
  1094.   ;; used each time and saved in the draft folder.  The draft file can then be
  1095.   ;; reused.
  1096.   (cond (mh-draft-folder
  1097.      (pop-to-buffer (find-file-noselect (mh-new-draft-name) t))
  1098.      (rename-buffer (format "draft-%s" (buffer-name))))
  1099.     (t
  1100.      (let ((draft-name (mh-expand-file-name "draft" mh-user-path)))
  1101.        (pop-to-buffer "draft")    ; Create if necessary
  1102.        (if (buffer-modified-p)
  1103.            (if (y-or-n-p "Draft has been modified; kill anyway? ")
  1104.            (set-buffer-modified-p nil)
  1105.            (error "Draft preserved.")))
  1106.        (setq buffer-file-name draft-name)
  1107.        (clear-visited-file-modtime)
  1108.        (unlock-buffer)
  1109.        (when (and (file-exists-p draft-name)
  1110.               (not (equal draft-name initial-contents)))
  1111.          (insert-file-contents draft-name)
  1112.          (delete-file draft-name)))))
  1113.   (when (and initial-contents
  1114.          (or (zerop (buffer-size))
  1115.          (not (y-or-n-p
  1116.                (format "A draft exists.  Use for %s? " use)))))
  1117.     (erase-buffer)
  1118.     (insert-file-contents initial-contents)
  1119.     (if delete-contents-file (delete-file initial-contents)))
  1120.   (auto-save-mode 1)
  1121.   (if mh-draft-folder
  1122.       (save-buffer))            ; Do not reuse draft name
  1123.   (buffer-name))
  1124.  
  1125.  
  1126. (defun mh-new-draft-name ()
  1127.   ;; Returns the pathname of folder for draft messages.
  1128.   (save-excursion
  1129.     (set-buffer (get-buffer-create " *mh-temp*"))
  1130.     (erase-buffer)
  1131.     (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new")
  1132.     (buffer-substring (point) (1- (mark)))))
  1133.  
  1134.  
  1135. (defun mh-next-msg ()
  1136.   ;; Move backward or forward to the next undeleted message in the buffer.
  1137.   (if (eq mh-next-direction 'forward)
  1138.       (mh-next-undeleted-msg 1)
  1139.       (mh-previous-undeleted-msg 1)))
  1140.  
  1141.  
  1142. (defun mh-set-scan-mode ()
  1143.   ;; Display the scan listing buffer, but do not show a message.
  1144.   (if (get-buffer mh-show-buffer)
  1145.       (delete-windows-on mh-show-buffer))
  1146.   (mh-set-mode-name "mh-e scan")
  1147.   (setq mh-summarize t)
  1148.   (if mh-recenter-summary-p
  1149.       (recenter (/ (window-height) 2))))
  1150.  
  1151.  
  1152. (defun mh-maybe-show (msg)
  1153.   ;; If the scan listing is not summarized, then display the message pointed
  1154.   ;; to by the cursor is the scan listing.
  1155.   (if (not mh-summarize) (mh-show msg)))
  1156.  
  1157.  
  1158. (defun mh-set-mode-name (mode-name-string)
  1159.   ;; Set the mode-name and ensure that the mode line is updated.
  1160.   (setq mode-name mode-name-string)
  1161.   ;; Force redisplay of all buffers' mode lines to be considered.
  1162.   (save-excursion (set-buffer (other-buffer)))
  1163.   (set-buffer-modified-p (buffer-modified-p)))
  1164.  
  1165.  
  1166.  
  1167. ;;; The folder data abstraction.
  1168.  
  1169. (defvar mh-current-folder nil "Name of current folder")
  1170. (defvar mh-show-buffer nil "Buffer that displays mesage for this folder")
  1171. (defvar mh-folder-filename nil "Full path of directory for this folder")
  1172. (defvar mh-summarize nil "If non-nil, show scan list only")
  1173. (defvar mh-next-seq-num nil "Index of free sequence id")
  1174. (defvar mh-delete-list nil "list of msg numbers to delete")
  1175. (defvar mh-refile-list nil "list of folder names in mh-seq-list")
  1176. (defvar mh-seq-list nil "alist of (seq .msgs ) numbers")
  1177. (defvar mh-seen-list nil "list of displayed messages")
  1178. (defvar mh-next-direction 'forward "direction to move to next message")
  1179. (defvar mh-narrowed-to-seq nil "sequence display is narrowed to")
  1180. (defvar mh-first-msg-num nil "number of first msg in buffer")
  1181. (defvar mh-last-msg-num nil "number of last msg in buffer")
  1182.  
  1183. (defun mh-make-folder (name)
  1184.   ;; Create and initialize a new mail folder called NAME and make it the
  1185.   ;; current folder.
  1186.   (switch-to-buffer name)
  1187.   (kill-all-local-variables)
  1188.   (setq buffer-read-only nil)
  1189.   (erase-buffer)
  1190.   (make-local-vars
  1191.    'mh-current-folder name        ; Name of folder
  1192.    'mh-show-buffer (format "show-%s" name) ; Buffer that displays messages
  1193.    'mh-folder-filename            ; e.g. /usr/foobar/Mail/inbox/
  1194.    (file-name-as-directory (mh-expand-file-name name))
  1195.    'mh-summarize t            ; Show scan list only?
  1196.    'mh-next-seq-num 0            ; Index of free sequence id
  1197.    'mh-delete-list nil            ; List of msgs nums to delete
  1198.    'mh-refile-list nil            ; List of folder names in mh-seq-list
  1199.    'mh-seq-list nil            ; Alist of (seq . msgs) nums
  1200.    'mh-seen-list nil            ; List of displayed messages
  1201.    'mh-next-direction 'forward        ; Direction to move to next message
  1202.    'mh-narrowed-to-seq nil        ; Sequence display is narrowed to
  1203.    'mh-first-msg-num nil        ; Number of first msg in buffer
  1204.    'mh-last-msg-num nil            ; Number of last msg in buffer
  1205.    'mh-previous-window-config nil)    ; Previous window configuration
  1206.   (mh-folder-mode)
  1207.   (setq buffer-read-only t)
  1208.   (mh-set-folder-modified-p nil)
  1209.   (auto-save-mode -1)
  1210.   (setq buffer-offer-save t)
  1211.   (mh-set-mode-name "mh-e scan"))
  1212.  
  1213.  
  1214.  
  1215. (defun make-local-vars (&rest pairs)
  1216.   ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the
  1217.   ;; value.
  1218.   (while pairs
  1219.     (make-variable-buffer-local (car pairs))
  1220.     (set (car pairs) (car (cdr pairs)))
  1221.     (setq pairs (cdr (cdr pairs)))))
  1222.  
  1223.  
  1224. (defun mh-folder-mode ()
  1225.   "Major mode for \"editing\" an MH folder scan listing.
  1226. Messages can be marked for refiling and deletion.  However, both actions
  1227. are deferred until you request execution with \\[mh-execute-commands].
  1228. \\{mh-folder-mode-map}
  1229.   A prefix argument (\\[universal-argument]) to delete, refile, list, or undo applies the action to a message sequence.
  1230.  
  1231. Variables controlling mh-e operation are (defaults in parentheses):
  1232.  
  1233.  mh-bury-show-buffer (t)
  1234.     Non-nil means that the buffer used to display message is buried.
  1235.     It will never be offered as the default other buffer.
  1236.  
  1237.  mh-clean-message-header (nil)
  1238.     Non-nil means remove header lines matching the regular expression
  1239.     specified in mh-invisible-headers from messages.
  1240.  
  1241.  mh-visible-headers (nil)
  1242.     If non-nil, it contains a regexp specifying the headers that are shown in
  1243.     a message if mh-clean-message-header is non-nil.  Setting this variable
  1244.     overrides mh-invisible-headers.
  1245.  
  1246.  mh-do-not-confirm (nil)
  1247.     Non-nil means do not prompt for confirmation before executing some
  1248.     non-recoverable commands such as mh-kill-folder and mh-undo-folder.
  1249.  
  1250.  mhl-formfile (nil)
  1251.     Name of format file to be used by mhl to show messages.
  1252.     A value of T means use the default format file.
  1253.     Nil means don't use mhl to format messages.
  1254.  
  1255.  mh-lpr-command-format (\"lpr -p -J '%s'\")
  1256.     Format for command used to print a message on a system printer.
  1257.  
  1258.  mh-recenter-summary-p (nil)
  1259.     If non-nil, then the scan listing is recentered when the window displaying
  1260.     a messages is toggled off.
  1261.  
  1262.  mh-summary-height (4)
  1263.     Number of lines in the summary window.
  1264.  
  1265.  mh-ins-buf-prefix (\">> \")
  1266.     String to insert before each non-blank line of a message as it is
  1267.     inserted in a letter being composed."
  1268.  
  1269.   (use-local-map mh-folder-mode-map)
  1270.   (setq major-mode 'mh-folder-mode)
  1271.   (mh-set-mode-name "mh-e folder")
  1272.   (run-hooks 'mh-folder-mode-hook))
  1273.  
  1274.  
  1275. (defun mh-scan-folder (folder range)
  1276.   ;; Scan the FOLDER over the RANGE.  Return in the folder's buffer.
  1277.   (cond ((null (get-buffer folder))
  1278.      (mh-make-folder folder))
  1279.     (t
  1280.      (mh-process-or-undo-commands folder)
  1281.      (switch-to-buffer folder)))
  1282.   (mh-regenerate-headers range)
  1283.   (when (= (count-lines (point-min) (point-max)) 0)
  1284.     (if (equal range "all")
  1285.     (message  "Folder %s is empty" folder)
  1286.     (message  "No messages in %s, range %s" folder range))
  1287.     (sit-for 5))
  1288.   (mh-goto-cur-msg))
  1289.  
  1290.  
  1291. (defun mh-regenerate-headers (range)
  1292.   ;; Replace buffer with scan of its contents over range RANGE.
  1293.   (let ((buffer-read-only nil)
  1294.     (folder (buffer-name)))
  1295.     (message (format "scanning %s..." folder))
  1296.     (erase-buffer)
  1297.     (mh-exec-cmd-output "scan" nil
  1298.             "-noclear" "-noheader"
  1299.             "-width" (window-width)
  1300.             folder range)
  1301.     (goto-char (point-min))
  1302.     (cond ((looking-at "scan: no messages in")
  1303.        (keep-lines "^[ ]*[0-9]"))    ; Flush random scan lines
  1304.       ((looking-at "scan: "))    ; Keep error messages
  1305.       (t
  1306.        (keep-lines "^[ ]*[0-9]")))    ; Flush random scan lines
  1307.     (mh-delete-seq-locally 'cur)    ; To pick up new one
  1308.     (setq mh-seq-list (mh-read-folder-sequences folder t))
  1309.     (mh-notate-user-sequences)
  1310.     (mh-make-folder-mode-line)
  1311.     (mh-set-folder-modified-p nil)
  1312.     (message (format "scanning %s...done" folder))))
  1313.  
  1314.  
  1315. (defun mh-get-new-mail (maildrop-name)
  1316.   ;; Read new mail from a maildrop into the current buffer.
  1317.   ;; Return T if there was new mail, NIL otherwise.  Return in the current
  1318.   ;; buffer.
  1319.   (let ((buffer-read-only nil)
  1320.     (point-before-inc (point))
  1321.     (folder (buffer-name))
  1322.     (folder-modified-flag (buffer-modified-p)))
  1323.     (message (if maildrop-name
  1324.          (format "inc %s -file %s..." folder maildrop-name)
  1325.          (format "inc %s..." folder)))
  1326.     (mh-unmark-all-headers nil)
  1327.     (setq mh-next-direction 'forward)
  1328.     (flush-lines "^inc:\\|^scan:")    ; Kill old error messages
  1329.     (goto-char (point-max))
  1330.     (let ((start-of-inc (point)))
  1331.       (if maildrop-name
  1332.       (mh-exec-cmd-output "inc" nil folder
  1333.                   "-file" (expand-file-name maildrop-name)
  1334.                   "-width" (window-width)
  1335.                   "-truncate")
  1336.       (mh-exec-cmd-output "inc" nil
  1337.                   "-width" (window-width)))
  1338.       (message
  1339.        (if maildrop-name
  1340.        (format "inc %s -file %s...done" folder maildrop-name)
  1341.        (format "inc %s...done" folder)))
  1342.       (mh-delete-seq-locally 'cur)    ; To pick up new one
  1343.       (setq mh-seq-list (mh-read-folder-sequences folder t))
  1344.       (mh-notate-user-sequences)
  1345.       (goto-char start-of-inc)
  1346.       (cond ((looking-at "inc: no mail")
  1347.          (keep-lines "^[ ]*[0-9]")    ; Flush random scan lines
  1348.          (mh-make-folder-mode-line)
  1349.          (goto-char point-before-inc)
  1350.          (message "No new mail%s%s." (if maildrop-name " in " "")
  1351.               (if maildrop-name maildrop-name ""))
  1352.          nil)
  1353.         ((looking-at "inc:")    ; Error messages
  1354.          (mh-make-folder-mode-line)
  1355.          (goto-char point-before-inc)
  1356.          (message "inc error")
  1357.          nil)
  1358.         (t
  1359.          (keep-lines "^[ ]*[0-9]")
  1360.          (mh-make-folder-mode-line)
  1361.          (mh-goto-cur-msg)
  1362.          t)))
  1363.     (mh-set-folder-modified-p folder-modified-flag)))
  1364.  
  1365.  
  1366. (defun mh-make-folder-mode-line (&optional annotation)
  1367.   ;; Set the fields of the mode line for a folder buffer.
  1368.   ;; The optional ANNOTATION string is displayed after the folder's name.
  1369.   (save-excursion
  1370.     (goto-char (point-min))
  1371.     (setq mh-first-msg-num (mh-get-msg-num nil))
  1372.     (let* ((lines (count-lines (point-min) (point-max)))
  1373.        (case-fold-search nil))
  1374.       (goto-char (point-max))
  1375.       (previous-line 1)
  1376.       (setq mh-last-msg-num (mh-get-msg-num nil))
  1377.       (setq mode-line-buffer-identification
  1378.         (list (format "{%%b%s}  %d msg%s"
  1379.               (if annotation (format "/%s" annotation) "")
  1380.               lines
  1381.               (if (= lines 0)
  1382.                   "s"
  1383.                   (if (> lines 1)
  1384.                   (format "s (%d-%d)" mh-first-msg-num
  1385.                       mh-last-msg-num)
  1386.                   (format " (%d)" mh-first-msg-num)))))))))
  1387.  
  1388.  
  1389. (defun mh-unmark-all-headers (remove-all-flags)
  1390.   ;; Remove all '+' flags from the headers, and if called with a non-nil
  1391.   ;; argument, remove all 'D', '^' and '%' flags too.
  1392.   (save-excursion
  1393.     (let ((buffer-read-only nil)
  1394.       (case-fold-search nil))
  1395.       (goto-char (point-min))
  1396.       (while (if remove-all-flags
  1397.          (re-search-forward "^....\\D\\|^....\\^\\|^....\\+\\|^.....%"
  1398.                     nil t)
  1399.          (re-search-forward "^....\\+" nil t))
  1400.     (delete-backward-char 1)
  1401.     (insert " ")
  1402.     (beginning-of-line)))))        ; Check line again
  1403.  
  1404.  
  1405. (defun mh-goto-cur-msg ()
  1406.   ;; Position the cursor at the current message.
  1407.   (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
  1408.     (cond ((or (null cur-msg) (not (mh-goto-msg cur-msg t nil)))
  1409.        (goto-char (point-max))
  1410.        (forward-line -1)
  1411.        (message "No current message"))
  1412.       (t
  1413.        (mh-notate cur-msg ?+ 4)
  1414.        (recenter 0)
  1415.        (mh-maybe-show cur-msg)))))
  1416.  
  1417.  
  1418. (defun mh-pack-folder-1 ()
  1419.   ;; Close and pack the current folder.
  1420.   (let ((buffer-read-only nil))
  1421.     (message "closing folder...")
  1422.     (mh-process-or-undo-commands mh-current-folder)
  1423.     (message "packing folder...")
  1424.     (save-excursion
  1425.       (mh-exec-cmd-quiet " *mh-temp*" "folder" mh-current-folder "-pack"))
  1426.     (mh-regenerate-headers "all")
  1427.     (message "packing done")))
  1428.  
  1429.  
  1430. (defun mh-process-or-undo-commands (folder)
  1431.   ;; If FOLDER has outstanding commands, then either process or discard them.
  1432.   (set-buffer folder)
  1433.   (if (mh-outstanding-commands-p)
  1434.       (if (or mh-do-not-confirm
  1435.           (y-or-n-p
  1436.         "Process outstanding deletes and refiles (or lose them)? "))
  1437.       (mh-process-commands folder)
  1438.       (mh-undo-folder))
  1439.       (mh-invalidate-show-cache)))
  1440.  
  1441.  
  1442. (defun mh-process-commands (folder)
  1443.   ;; Process outstanding commands for the folder FOLDER.
  1444.   (message "Processing deletes and refiles...")
  1445.   (set-buffer folder)
  1446.   (let ((buffer-read-only nil))
  1447.     ;; Update the unseen sequence if it exists
  1448.     (if (and mh-seen-list (mh-seq-to-msgs mh-unseen-seq))
  1449.     (mh-undefine-sequence mh-unseen-seq mh-seen-list))
  1450.  
  1451.     ;; Then refile messages
  1452.     (mapc (function
  1453.        (lambda (dest)
  1454.          (let ((msgs (mh-seq-to-msgs dest)))
  1455.            (when msgs
  1456.          (mh-delete-scan-msgs msgs)
  1457.          (apply 'mh-exec-cmd
  1458.             (nconc (cons "refile" msgs)
  1459.                    (list "-src" folder (symbol-name dest))))))))
  1460.       mh-refile-list)
  1461.  
  1462.     ;; Now delete messages
  1463.     (when mh-delete-list
  1464.       (apply 'mh-exec-cmd (mh-list* "rmm" (format "%s" folder) mh-delete-list))
  1465.       (mh-delete-scan-msgs mh-delete-list))
  1466.  
  1467.     ;; Don't need to remove sequences since delete and refile do so.
  1468.  
  1469.     ;; Mark cur message
  1470.     (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))
  1471.  
  1472.     (mh-invalidate-show-cache)
  1473.  
  1474.     (setq mh-delete-list nil
  1475.       mh-refile-list nil
  1476.       mh-seq-list (mh-read-folder-sequences mh-current-folder nil)
  1477.       mh-seen-list nil)
  1478.     (mh-unmark-all-headers t)
  1479.     (mh-notate-user-sequences)
  1480.     (mh-set-folder-modified-p nil)
  1481.     (message "Processing deletes and refiles...done")))
  1482.  
  1483.  
  1484. (defun mh-invalidate-show-cache ()
  1485.   ;; Invalidate show buffer file cache.
  1486.   (if (get-buffer mh-show-buffer)
  1487.       (save-excursion
  1488.     (set-buffer mh-show-buffer)
  1489.     (setq buffer-file-name nil))))
  1490.  
  1491.  
  1492. (defun mh-delete-scan-msgs (msgs)
  1493.   ;; Delete the scan listing lines for each of the msgs in the LIST.
  1494.   (save-excursion
  1495.     (goto-char (point-min))
  1496.     (flush-lines (mapconcat 'mh-msg-search-pat msgs "\\|"))))
  1497.  
  1498.  
  1499. (defun mh-set-folder-modified-p (flag)
  1500.   "Mark current folder as modified or unmodified according to FLAG."
  1501.   (set-buffer-modified-p flag))
  1502.  
  1503.  
  1504. (defun mh-outstanding-commands-p ()
  1505.   ;; Returns non-nil if there are outstanding deletes or refiles.
  1506.   (or mh-delete-list mh-refile-list))
  1507.  
  1508.  
  1509.  
  1510. ;;; Mode for composing and sending a message.
  1511.  
  1512. (defun mh-letter-mode ()
  1513.   "Mode for composing letters in mh-e.
  1514.  
  1515. Variables controlling this mode (defaults in parentheses):
  1516.  
  1517.  mh-delete-yanked-msg-window (nil)
  1518.     If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
  1519.     the yanked message.
  1520.  
  1521.  mh-yank-from-start-of-msg (t)
  1522.     If non-nil, \\[mh-yank-cur-msg] will include the entire message.
  1523.     If nil, only the portion of the message following the point will be yanked.
  1524.     If there is a region, this variable is ignored.
  1525.  
  1526. \\{mh-letter-mode-map}"
  1527.   (interactive)
  1528.   (kill-all-local-variables)
  1529.   (make-local-variable 'paragraph-start)
  1530.   (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
  1531.   (make-local-variable 'paragraph-separate)
  1532.   (setq paragraph-separate
  1533.     (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
  1534.   (make-local-variable 'mh-send-args)
  1535.   (make-local-variable 'mh-annotate-char)
  1536.   (make-local-variable 'mh-sent-from-folder)
  1537.   (make-local-variable 'mh-sent-from-msg)
  1538.   (use-local-map mh-letter-mode-map)
  1539.   (setq major-mode 'mh-letter-mode)
  1540.   (mh-set-mode-name "mh-e letter")
  1541.   (set-syntax-table mh-letter-mode-syntax-table)
  1542.   (run-hooks 'text-mode-hook 'mh-letter-mode-hook))
  1543.  
  1544.  
  1545. (defun mh-to-field ()
  1546.   "Move point to the end of the header field indicated by the previous
  1547. keystroke.  Create the field if it does not exist.  Set the mark to the
  1548. point before moving."
  1549.   (interactive "")
  1550.   (expand-abbrev)
  1551.   (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices)))
  1552.     (case-fold-search t))
  1553.     (cond ((mh-position-on-field target t)
  1554.        (if (not (looking-at "[ \t]")) (insert " ")))
  1555.       (t
  1556.        (goto-char (dot-min))
  1557.        (re-search-forward "^To:")
  1558.        (forward-line 1)
  1559.        (while (looking-at "^[ \t]") (forward-line 1))
  1560.        (insert (format "%s \n" target))
  1561.        (backward-char 1)))))
  1562.  
  1563.  
  1564. (defun mh-to-fcc ()
  1565.   "Insert a Fcc: field in the current message, prompting for the field
  1566. name with a completion list of the current folders."
  1567.   (interactive)
  1568.   (expand-abbrev)
  1569.   (save-excursion
  1570.     (mh-insert-fields "Fcc:"
  1571.               (substring (mh-prompt-for-folder "Fcc" "" t) 1 nil))))
  1572.  
  1573.  
  1574. (defun mh-insert-signature ()
  1575.   "Insert the file ~/.signature at the current point."
  1576.   (interactive "")
  1577.   (insert-file-contents "~/.signature"))
  1578.  
  1579.  
  1580. (defun mh-check-whom ()
  1581.   "Verify recipients of the current letter."
  1582.   (interactive)
  1583.   (let ((file-name (buffer-file-name)))
  1584.     (set-buffer-modified-p t)        ; Force writing of contents
  1585.     (save-buffer)
  1586.     (message "Checking recipients...")
  1587.     (switch-to-buffer-other-window "*Mail Recipients*")
  1588.     (bury-buffer (current-buffer))
  1589.     (erase-buffer)
  1590.     (mh-exec-cmd-output "whom" t file-name)
  1591.     (other-window -1)
  1592.     (message "Checking recipients...done")))
  1593.  
  1594.  
  1595.  
  1596. ;;; Routines to make a search pattern and search for a message.
  1597.  
  1598. (defun mh-make-pick-template ()
  1599.   ;; Initialize the current buffer with a template for a pick pattern.
  1600.   (erase-buffer)
  1601.   (kill-all-local-variables)
  1602.   (make-local-variable 'mh-searching-folder)
  1603.   (insert "From: \n"
  1604.       "To: \n"
  1605.       "Cc: \n"
  1606.       "Date: \n"
  1607.       "Subject: \n"
  1608.       "---------\n")
  1609.   (mh-letter-mode)
  1610.   (use-local-map mh-pick-mode-map)
  1611.   (goto-char (point-min))
  1612.   (end-of-line))
  1613.  
  1614.  
  1615. (defun mh-do-pick-search ()
  1616.   "Find messages in the folder named in mh-searching-folder that match the
  1617. qualifications in current buffer.  Put messages found in a sequence
  1618. named `search'."
  1619.   (interactive)
  1620.   (let ((pattern-buffer (buffer-name))
  1621.     (searching-buffer mh-searching-folder)
  1622.     (range)
  1623.     (pattern nil)
  1624.     (new-buffer nil))
  1625.     (save-excursion
  1626.       (cond ((get-buffer searching-buffer)
  1627.          (set-buffer searching-buffer)
  1628.          (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num)))
  1629.         (t
  1630.          (mh-make-folder searching-buffer)
  1631.          (setq range "all")
  1632.          (setq new-buffer t))))
  1633.     (message "Searching...")
  1634.     (goto-char (point-min))
  1635.     (while (setq pattern (mh-next-pick-field pattern-buffer))
  1636.       (setq msgs (mh-seq-from-command searching-buffer
  1637.                       'search
  1638.                       (nconc (cons "pick" pattern)
  1639.                          (list searching-buffer
  1640.                            range
  1641.                            "-sequence" "search"
  1642.                            "-list"))))
  1643.       (setq range "search"))
  1644.     (message "Searching...done")
  1645.     (if new-buffer
  1646.     (mh-scan-folder searching-buffer msgs)
  1647.     (switch-to-buffer searching-buffer))
  1648.     (delete-other-windows)
  1649.     (mh-notate-seq 'search ?% (+ mh-cmd-note 1))))
  1650.  
  1651.  
  1652. (defun mh-next-pick-field (buffer)
  1653.   ;; Return the next piece of a pick argument that can be extracted from the
  1654.   ;; BUFFER.  Returns nil if no pieces remain.
  1655.   (set-buffer buffer)
  1656.   (let ((case-fold-search t))
  1657.     (cond ((eobp)
  1658.        nil)
  1659.       ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
  1660.        (let* ((component
  1661.            (format "-%s"
  1662.                (downcase (buffer-substring (match-beginning 1)
  1663.                                (match-end 1)))))
  1664.           (pat (buffer-substring (match-beginning 2) (match-end 2))))
  1665.            (forward-line 1)
  1666.            (list component pat)))
  1667.       ((re-search-forward "^-*$" nil t)
  1668.        (forward-char 1)
  1669.        (let ((body (buffer-substring (point) (point-max))))
  1670.          (if (and (> (length body) 0) (not (equal body "\n")))
  1671.          (list "-search" body)
  1672.          nil)))
  1673.       (t
  1674.        nil))))
  1675.  
  1676.  
  1677.  
  1678. ;;; Routines to compose and send a letter.
  1679.  
  1680. (defun mh-compose-and-send-mail (draft send-args
  1681.                        sent-from-folder sent-from-msg
  1682.                        to subject cc
  1683.                        annotate-char annotate-field
  1684.                        config)
  1685.   ;; Edit and compose a draft message in buffer DRAFT and send or save it.
  1686.   ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
  1687.   ;; nil if none exists.
  1688.   ;; SENT-FROM-MSG is the message number or sequence name or nil.
  1689.   ;; SEND-ARGS is an optional argument passed to the send command.
  1690.   ;; nThe TO, SUBJECT, and CC fields are passed to the mh-compose-letter-hook.
  1691.   ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
  1692.   ;; message.  In that case, the ANNOTATE-FIELD is used to build a string
  1693.   ;; for mh-annotate-msg.
  1694.   ;; CONFIG is the window configuration to restore after sending the letter.
  1695.   (pop-to-buffer draft)
  1696.   (mh-letter-mode)
  1697.   (make-local-vars
  1698.    'mh-annotate-field annotate-field
  1699.    'mh-previous-window-config config)
  1700.   (setq mh-sent-from-folder sent-from-folder)
  1701.   (setq mh-sent-from-msg sent-from-msg)
  1702.   (setq mh-send-args send-args)
  1703.   (setq mh-annotate-char annotate-char)
  1704.   (setq mode-line-buffer-identification (list "{%b}"))
  1705.   (if (and (boundp 'mh-compose-letter-hook)
  1706.        (symbol-value 'mh-compose-letter-hook))
  1707.       ;; run-hooks will not pass arguments.
  1708.       (let ((value (symbol-value 'mh-compose-letter-hook)))
  1709.     (if (and (listp value) (not (eq (car value) 'lambda)))
  1710.         (while value
  1711.           (funcall (car value) to subject cc)
  1712.           (setq value (cdr value)))
  1713.         (funcall mh-compose-letter-hook to subject cc)))))
  1714.  
  1715.  
  1716. (defun mh-send-letter (&optional arg)
  1717.   "Send the draft letter in the current buffer.
  1718. If (optional) prefix argument provided, monitor delivery."
  1719.   (interactive "P")
  1720.   (set-buffer-modified-p t)        ; Make sure buffer is written
  1721.   (save-buffer)
  1722.   (message "Sending...")
  1723.   (let ((buffer-name (buffer-name))
  1724.     (file-name (buffer-file-name))
  1725.     (config mh-previous-window-config))
  1726.     (cond (arg
  1727.        (pop-to-buffer "MH mail delivery")
  1728.        (erase-buffer)
  1729.        (if mh-send-args
  1730.            (mh-exec-cmd-output "send" t "-watch" "-nopush"
  1731.                    "-nodraftfolder" mh-send-args file-name)
  1732.            (mh-exec-cmd-output "send" t "-watch" "-nopush"
  1733.                    "-nodraftfolder" file-name)))
  1734.  
  1735.       (mh-send-args
  1736.        (mh-exec-cmd-demon "send" "-nodraftfolder" "-noverbose"
  1737.                   mh-send-args file-name))
  1738.       (t
  1739.        (mh-exec-cmd-demon "send" "-nodraftfolder" "-noverbose"
  1740.                   file-name)))
  1741.  
  1742.     (if mh-annotate-char
  1743.     (mh-annotate-msg mh-sent-from-msg
  1744.              mh-sent-from-folder
  1745.              mh-annotate-char
  1746.              "-component" mh-annotate-field
  1747.              "-text" (format "\"%s %s\""
  1748.                      (mh-get-field "To:")
  1749.                      (mh-get-field "Cc:"))))
  1750.  
  1751.     (when (or (not arg)
  1752.           (y-or-n-p "Kill draft buffer? "))
  1753.       (kill-buffer buffer-name)
  1754.       (if config
  1755.       (set-window-configuration config)))
  1756.     (message "Sending...done")))
  1757.  
  1758.  
  1759.  
  1760. (defun mh-insert-letter (prefix-provided folder msg)
  1761.   "Insert a message from any folder into the current letter.
  1762. Removes the message's headers using mh-invisible-headers.
  1763. Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \").
  1764. If (optional) prefix argument provided, do not indent and do not delete
  1765. headers.
  1766. Leaves the mark before the letter and point after it."
  1767.   (interactive
  1768.    (list current-prefix-arg
  1769.      (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
  1770.      (read-input (format "Message number%s: "
  1771.                  (if mh-sent-from-msg
  1772.                  (format " [%d]" mh-sent-from-msg)
  1773.                  "")))))
  1774.   (save-restriction
  1775.     (narrow-to-region (point) (point))
  1776.     (let ((start (point-min)))
  1777.       (if (equal msg "") (setq msg (format "%d" mh-sent-from-msg)))
  1778.       (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
  1779.                   (mh-expand-file-name msg
  1780.                            (mh-expand-file-name
  1781.                             folder)))
  1782.       (when (not prefix-provided)
  1783.         (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
  1784.         (set-mark start)        ; since mh-clean-msg-header moves it
  1785.         (mh-insert-prefix-string mh-ins-buf-prefix)))))
  1786.  
  1787.  
  1788. (defun mh-yank-cur-msg ()
  1789.   "Insert the currently displayed message into the draft buffer.  Prefix each
  1790. non-blank line in the message with the string in mh-ins-buf-prefix.  If a
  1791. region is set in the message's buffer, then only the region will be inserted.
  1792. Otherwise, the entire message will be inserted if mh-yank-from-start-of-msg is
  1793. non-nil.   If this variable is nil, the portion of the message following the
  1794. point will be yanked.  If mh-delete-yanked-msg-window is non-nil, any window
  1795. displaying the yanked message will be deleted."
  1796.   (interactive)
  1797.   (if (and (boundp 'mh-sent-from-folder) mh-sent-from-folder mh-sent-from-msg)
  1798.       (let ((to-point (point))
  1799.         (to-buffer (current-buffer)))
  1800.     (set-buffer mh-sent-from-folder)
  1801.     (if mh-delete-yanked-msg-window
  1802.         (delete-windows-on mh-show-buffer))
  1803.     (set-buffer mh-show-buffer)    ; Find displayed message
  1804.     (let ((mh-ins-str (cond ((mark)
  1805.                  (buffer-substring (point) (mark)))
  1806.                 (mh-yank-from-start-of-msg
  1807.                  (buffer-substring (point-min) (point-max)))
  1808.                 (t
  1809.                  (buffer-substring (point) (point-max))))))
  1810.       (set-buffer to-buffer)
  1811.       (narrow-to-region to-point to-point)
  1812.       (insert mh-ins-str)
  1813.       (mh-insert-prefix-string mh-ins-buf-prefix)
  1814.       (insert "\n")
  1815.       (widen)))
  1816.       (error "There is no current message.")))
  1817.  
  1818. (defun mh-insert-prefix-string (ins-string)
  1819.   ;; Preface each line in the current buffer with STRING.
  1820.   (goto-char (point-min))
  1821.   (while (not (eobp))
  1822.     (insert ins-string)
  1823.     (forward-line 1)))
  1824.  
  1825.  
  1826. (defun mh-fully-kill-draft ()
  1827.   "Kill the draft message file and the draft message buffer.
  1828. Use \\[kill-buffer] if you don't want to delete the draft message file."
  1829.   (interactive "")
  1830.   (if (y-or-n-p "Kill draft message? ")
  1831.       (let ((config mh-previous-window-config))
  1832.     (if (file-exists-p (buffer-file-name))
  1833.         (delete-file (buffer-file-name)))
  1834.     (set-buffer-modified-p nil)
  1835.     (kill-buffer (buffer-name))
  1836.     (if config
  1837.         (set-window-configuration config)))
  1838.     (error "Message not killed")))
  1839.  
  1840.  
  1841.  
  1842. ;;; Commands to manipulate sequences.  Sequences are stored in an alist
  1843. ;;; of the form:
  1844. ;;;    ((seq-name msgs ...) (seq-name msgs ...) ...)
  1845.  
  1846. (defun mh-make-seq (name msgs) (cons name msgs))
  1847.  
  1848. (defmacro mh-seq-name (pair) (list 'car pair))
  1849.  
  1850. (defmacro mh-seq-msgs (pair) (list 'cdr pair))
  1851.  
  1852. (defun mh-find-seq (name) (assoc name mh-seq-list))
  1853.  
  1854.  
  1855. (defun mh-seq-to-msgs (seq)
  1856.   "Return a list of the messages in SEQUENCE."
  1857.   (mh-seq-msgs (mh-find-seq seq)))
  1858.  
  1859.  
  1860. (defun mh-seq-containing-msg (msg)
  1861.   ;; Return a list of the sequences containing MESSAGE.
  1862.   (let ((l mh-seq-list)
  1863.     (seqs ()))
  1864.     (while l
  1865.       (if (memq msg (mh-seq-msgs (car l)))
  1866.       (mh-push (mh-seq-name (car l)) seqs))
  1867.       (setq l (cdr l)))
  1868.     seqs))
  1869.  
  1870.  
  1871. (defun mh-msg-to-seq (msg)
  1872.   ;; Given a MESSAGE number, return the first sequence in which it occurs.
  1873.   (car (mh-seq-containing-msg msg)))
  1874.  
  1875.  
  1876. (defun mh-read-seq (prompt not-empty &optional default)
  1877.   ;; Read and return a sequence name.  Prompt with PROMPT, raise an error
  1878.   ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
  1879.   ;; an optional DEFAULT sequence.
  1880.   ;; A reply of '%' defaults to the first sequence containing the current
  1881.   ;; message.
  1882.   (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
  1883.                      (if default
  1884.                          (format "[%s] " default)
  1885.                          ""))
  1886.                  (mh-seq-names mh-seq-list)))
  1887.      (seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t)))
  1888.             ((equal input "") default)
  1889.             (t (intern input))))
  1890.      (msgs (mh-seq-to-msgs seq)))
  1891.     (if (and (null msgs) not-empty)
  1892.     (error (format "No messages in sequence `%s'" seq)))
  1893.     seq))
  1894.  
  1895.  
  1896. (defun mh-read-folder-sequences (folder define-sequences)
  1897.   ;; Read and return the predefined sequences for a FOLDER.  If
  1898.   ;; DEFINE-SEQUENCES is non-nil, then define mh-e's sequences before
  1899.   ;; reading MH's sequences.
  1900.   (let ((seqs ()))
  1901.     (when define-sequences
  1902.       (mh-define-sequences mh-seq-list)
  1903.       (mapc (function (lambda (seq)    ; Save the internal sequences
  1904.           (if (mh-folder-name (mh-seq-name seq))
  1905.           (mh-push seq seqs))))
  1906.         mh-seq-list))
  1907.     (save-excursion
  1908.       (mh-exec-cmd-quiet " *mh-temp*" "mark" folder "-list")
  1909.       (goto-char (point-min))
  1910.       (while (re-search-forward "\\(^[a-zA-Z][a-zA-Z]*\\)" nil t)
  1911.     (mh-push (mh-make-seq (intern (buffer-substring (match-beginning 1)
  1912.                             (match-end 1)))
  1913.                   (mh-read-msg-list))
  1914.          seqs)))
  1915.     seqs))
  1916.  
  1917.  
  1918. (defun mh-seq-names (seq-list)
  1919.   ;; Return an alist containing the names of the SEQUENCES.
  1920.   (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
  1921.       seq-list))
  1922.  
  1923.  
  1924. (defun mh-seq-from-command (folder seq command)
  1925.   ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
  1926.   (let ((msg)
  1927.     (msgs ())
  1928.     (case-fold-search t))
  1929.     (save-excursion
  1930.       (save-window-excursion
  1931.     (apply 'mh-exec-cmd-quiet (cons " *mh-temp*" command))
  1932.     (goto-char (point-min))
  1933.     (while (setq msg (car (mh-read-msg-list)))
  1934.       (mh-push msg msgs)
  1935.       (forward-line 1)))
  1936.       (set-buffer folder)
  1937.       (setq msgs (nreverse msgs))    ; Put in ascending order
  1938.       (mh-push (mh-make-seq seq msgs) mh-seq-list)
  1939.       msgs)))
  1940.  
  1941.  
  1942. (defun mh-read-msg-list ()
  1943.   ;; Return a list of message numbers from the current point to the end of
  1944.   ;; the line.
  1945.   (let ((msgs ())
  1946.     (end-of-line (save-excursion (end-of-line) (point))))
  1947.     (while (re-search-forward "\\([0-9]+\\)" end-of-line t)
  1948.       (let ((num (string-to-int (buffer-substring (match-beginning 1)
  1949.                           (match-end 1)))))
  1950.     (cond ((looking-at "-")        ; Message range
  1951.            (forward-char 1)
  1952.            (re-search-forward "\\([0-9]+\\)" end-of-line t)
  1953.            (let ((num2 (string-to-int (buffer-substring (match-beginning 1)
  1954.                                 (match-end 1)))))
  1955.          (if (< num2 num)
  1956.              (error "Bad message range: %d-%d" num num2))
  1957.          (while (<= num num2)
  1958.            (mh-push num msgs)
  1959.            (setq num (1+ num)))))
  1960.           ((not (zerop num)) (mh-push num msgs)))))
  1961.     msgs))
  1962.  
  1963.  
  1964. (defun mh-remove-seq (seq)
  1965.   ;; Delete the SEQUENCE.
  1966.   (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ?  (+ mh-cmd-note 1) seq)
  1967.   (mh-undefine-sequence seq (list "all"))
  1968.   (mh-delete-seq-locally seq))
  1969.  
  1970.  
  1971. (defun mh-delete-seq-locally (seq)
  1972.   ;; Remove mh-e's record of SEQUENCE.
  1973.   (let ((entry (mh-find-seq seq)))
  1974.     (setq mh-seq-list (delq entry mh-seq-list))))
  1975.  
  1976.  
  1977. (defun mh-remove-msg-from-seq (msg seq &optional internal-flag)
  1978.   ;; Remove MESSAGE from the SEQUENCE.  If optional FLAG is non-nil, do not
  1979.   ;; inform MH of the change.
  1980.   (let ((entry (mh-find-seq seq)))
  1981.     (when entry
  1982.       (mh-notate-if-in-one-seq msg ?  (+ mh-cmd-note 1) (mh-seq-name entry))
  1983.       (if (not internal-flag)
  1984.       (mh-undefine-sequence seq (list msg)))
  1985.       (setcdr entry (delq msg (mh-seq-msgs entry))))))
  1986.  
  1987.  
  1988. (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
  1989.   ;; Add MESSAGE(s) to the SEQUENCE.  If optional FLAG is non-nil, do not mark
  1990.   ;; the message in the scan listing or inform MH of the addition.
  1991.   (let ((entry (mh-find-seq seq)))
  1992.     (if (and msgs (atom msgs)) (setq msgs (list msgs)))
  1993.     (if (null entry)
  1994.     (mh-push (mh-make-seq seq msgs) mh-seq-list)
  1995.     (if msgs (setcdr entry (append msgs (cdr entry)))))
  1996.     (when (not internal-flag)
  1997.       (mh-add-to-sequence seq msgs)
  1998.       (mh-notate-seq seq ?% (+ mh-cmd-note 1)))))
  1999.  
  2000.  
  2001. (defun mh-rename-seq (seq new-name)
  2002.   "Rename a SEQUENCE to have a new NAME."
  2003.   (interactive "SOld sequence name: \nSNew name: ")
  2004.   (let ((old-seq (mh-find-seq seq)))
  2005.     (if old-seq
  2006.     (rplaca old-seq new-name)
  2007.     (error "Sequence %s does not exists" seq))
  2008.     (mh-undefine-sequence seq (mh-seq-msgs old-seq))
  2009.     (mh-define-sequence new-name (mh-seq-msgs old-seq))))
  2010.  
  2011.  
  2012. (defun mh-notate-user-sequences ()
  2013.   ;; Mark the scan listing of all messages in user-defined sequences.
  2014.   (let ((seqs mh-seq-list))
  2015.     (while seqs
  2016.       (let ((name (mh-seq-name (car seqs))))
  2017.     (if (not (mh-internal-seq name))
  2018.         (mh-notate-seq name ?% (+ mh-cmd-note 1)))
  2019.     (setq seqs (cdr seqs))))))
  2020.  
  2021.  
  2022. (defun mh-internal-seq (name)
  2023.   ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
  2024.   (or (memq name '(answered cur deleted forwarded printed))
  2025.       (eq name mh-unseen-seq)
  2026.       (mh-folder-name name)))
  2027.  
  2028.  
  2029. (defun mh-folder-name (name)
  2030.   ;; Return non-NIL if NAME is the possible name of a folder (i.e., begins
  2031.   ;; with "+").
  2032.   (if (symbolp name)
  2033.       (mh-folder-name (symbol-name name))
  2034.       (equal (substring name 0 1) "+")))
  2035.  
  2036.  
  2037. (defun mh-notate-seq (seq notation offset)
  2038.   ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
  2039.   ;; at the given OFFSET from the beginning of the listing line.
  2040.   (mh-map-to-seq-msgs 'mh-notate seq notation offset))
  2041.  
  2042.  
  2043. (defun mh-notate-if-in-one-seq (msg notation offset seq)
  2044.   ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
  2045.   ;; message with the CHARACTER at the given OFFSET from the beginning of the
  2046.   ;; listing line.
  2047.   (let ((in-seqs (mh-seq-containing-msg msg)))
  2048.     (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
  2049.     (mh-notate msg notation offset))))
  2050.  
  2051.  
  2052. (defun mh-map-to-seq-msgs (func seq &rest args)
  2053.   ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
  2054.   ;; remaining ARGS as arguments.
  2055.   (save-excursion
  2056.     (let ((msgs (mh-seq-to-msgs seq)))
  2057.       (while msgs
  2058.     (if (mh-goto-msg (car msgs) t t)
  2059.         (apply func (cons (car msgs) args)))
  2060.     (setq msgs (cdr msgs))))))
  2061.  
  2062.  
  2063. (defun mh-map-over-seqs (func seq-list)
  2064.   ;; Apply the FUNCTION to each element in the list of SEQUENCES,
  2065.   ;; passing the sequence name and the list of messages as arguments.
  2066.   (while seq-list
  2067.     (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
  2068.     (setq seq-list (cdr seq-list))))
  2069.  
  2070.  
  2071. (defun mh-define-sequences (seq-list)
  2072.   ;; Define the sequences in SEQ-LIST.
  2073.   (mh-map-over-seqs 'mh-define-sequence seq-list))
  2074.  
  2075.  
  2076. (defun mh-add-to-sequence (seq msgs)
  2077.   ;; Add to a SEQUENCE each message the list of MSGS.
  2078.   (if (not (equal (substring (symbol-name seq) 0 1) "+"))
  2079.       (if msgs
  2080.       (apply 'mh-exec-cmd (mh-list* "mark" mh-current-folder
  2081.                     "-sequence" (format "%s" seq)
  2082.                     "-add" msgs)))))
  2083.  
  2084. (defun mh-define-sequence (seq msgs)
  2085.   ;; Define the SEQUENCE to contain the list of MSGS.  Do not mark
  2086.   ;; pseudo-sequences or empty sequences.
  2087.   (if (and msgs
  2088.        (not (equal (substring (symbol-name seq) 0 1) "+")))
  2089.       (save-excursion
  2090.     (apply 'mh-exec-cmd-quiet (mh-list* " *mh-temp*"
  2091.                         "mark" mh-current-folder
  2092.                         "-sequence" (format "%s" seq)
  2093.                         "-add" "-zero" msgs)))))
  2094.  
  2095.  
  2096. (defun mh-undefine-sequence (seq msgs)
  2097.   ;; Remove from the SEQUENCE the list of MSGS.
  2098.   (apply 'mh-exec-cmd (mh-list* "mark" mh-current-folder
  2099.                 "-sequence" (format "%s" seq)
  2100.                 "-delete" msgs)))
  2101.  
  2102.  
  2103. (defun mh-copy-seq-to-point (seq location)
  2104.   ;; Copy the scan listing of the messages in SEQUENCE to after the point
  2105.   ;; LOCATION in the current buffer.
  2106.   (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
  2107.  
  2108.  
  2109. (defun mh-copy-line-to-point (msg location)
  2110.   ;; Copy the current line to the LOCATION in the current buffer.
  2111.   (beginning-of-line)
  2112.   (let ((beginning-of-line (point)))
  2113.     (forward-line 1)
  2114.     (copy-region-as-kill beginning-of-line (point))
  2115.     (goto-char location)
  2116.     (yank)
  2117.     (goto-char beginning-of-line)))
  2118.  
  2119.  
  2120.  
  2121. ;;; Issue commands to MH.
  2122.  
  2123. (defun mh-exec-cmd (command &rest args)
  2124.   ;; Execute MH command COMMAND with ARGS.  Any output is shown to the user.
  2125.   (save-window-excursion
  2126.     (switch-to-buffer-other-window " *mh-temp*")
  2127.     (erase-buffer)
  2128.     (apply 'call-process
  2129.        (mh-list* (mh-expand-file-name command mh-progs) nil t nil
  2130.              (mh-list-to-string args)))
  2131.     (if (> (buffer-size) 0)
  2132.     (sit-for 5))))
  2133.  
  2134.  
  2135. (defun mh-exec-cmd-quiet (buffer command &rest args)
  2136.   ;; In BUFFER, execute MH command COMMAND with ARGS.  Return in buffer, if
  2137.   ;; one exists.
  2138.   (when (stringp buffer)
  2139.     (switch-to-buffer buffer)
  2140.     (erase-buffer))
  2141.   (apply 'call-process
  2142.      (mh-list* (mh-expand-file-name command mh-progs) nil buffer nil
  2143.            (mh-list-to-string args))))
  2144.  
  2145.  
  2146. (defun mh-exec-cmd-output (command display &rest args)
  2147.   ;; Execute MH command COMMAND with DISPLAY flag and ARGS putting the output
  2148.   ;; into buffer after point.  Set mark after inserted text.
  2149.   (push-mark (point) t)
  2150.   (apply 'call-process
  2151.      (mh-list* (mh-expand-file-name command mh-progs) nil t display
  2152.            (mh-list-to-string args)))
  2153.   (exchange-point-and-mark))
  2154.  
  2155.  
  2156. (defun mh-exec-cmd-demon (command &rest args)
  2157.   ;; Execute MH command COMMAND with ARGS.  Any output from command is
  2158.   ;; displayed in an asynchronous pop-up window.
  2159.   (let ((process (apply 'start-process
  2160.             (mh-list* "mh-output" nil
  2161.                   (expand-file-name command mh-progs)
  2162.                   (mh-list-to-string args)))))
  2163.     (set-process-filter process 'mh-process-demon)))
  2164.  
  2165.  
  2166. (defun mh-process-demon (process output)
  2167.   ;; Process demon that puts output into a temporary buffer.
  2168.   (pop-to-buffer " *mh-temp*")
  2169.   (insert output)
  2170.   (other-window 1))
  2171.  
  2172.  
  2173. (defun mh-exec-lib-cmd-output (command &rest args)
  2174.   ;; Execute MH library command COMMAND with ARGS.  Put the output into
  2175.   ;; buffer after point.  Set mark after inserted text.
  2176.   (push-mark (point) t)
  2177.   (apply 'call-process
  2178.      (mh-list* (mh-expand-file-name command mh-lib) nil t nil
  2179.            (mh-list-to-string args)))
  2180.   (exchange-point-and-mark))
  2181.  
  2182.  
  2183. (defun mh-list-to-string (l)
  2184.   ;; Flattens the list L and makes every element of the new list into a string.
  2185.   (let ((new-list nil))
  2186.     (while l
  2187.       (cond ((null (car l)))
  2188.         ((symbolp (car l)) (mh-push (symbol-name (car l)) new-list))
  2189.         ((numberp (car l)) (mh-push (int-to-string (car l)) new-list))
  2190.         ((equal (car l) ""))
  2191.         ((stringp (car l)) (mh-push (car l) new-list))
  2192.         ((listp (car l))
  2193.          (setq new-list (nconc (nreverse (mh-list-to-string (car l)))
  2194.                    new-list)))
  2195.         (t (error "Bad argument %s" (car l))))
  2196.       (setq l (cdr l)))
  2197.     (nreverse new-list)))
  2198.  
  2199.  
  2200.  
  2201. ;;; Commands to annotate a message.
  2202.  
  2203. (defun mh-annotate-msg (msg buffer note &rest args)
  2204.   ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
  2205.   ;; the saved message with ARGS.
  2206.   (apply 'mh-exec-cmd (mh-list* "anno" buffer msg args))
  2207.   (save-excursion
  2208.     (set-buffer buffer)
  2209.     (if (symbolp msg)
  2210.     (mh-notate-seq msg note (+ mh-cmd-note 1))
  2211.     (mh-notate msg note (+ mh-cmd-note 1)))))
  2212.  
  2213.  
  2214. (defun mh-notate (msg notation offset)
  2215.   ;; Marks MESSAGE with the character NOTATION at position OFFSET.
  2216.   (save-excursion
  2217.     (if (mh-goto-msg msg t t)
  2218.     (let ((buffer-read-only nil)
  2219.           (folder-modified-flag (buffer-modified-p)))
  2220.       (beginning-of-line)
  2221.       (goto-char (+ (point) offset))
  2222.       (delete-char 1)
  2223.       (insert notation)
  2224.       (mh-set-folder-modified-p folder-modified-flag)))))
  2225.  
  2226.  
  2227.  
  2228. ;;; User prompting commands.
  2229.  
  2230. (defun mh-prompt-for-folder (prompt default can-create)
  2231.   ;; Prompt for a folder name with PROMPT.  Returns the folder's name.
  2232.   ;; DEFAULT is used if the folder exists and the user types return.
  2233.   ;; If the CAN-CREATE flag is t, then a non-existant folder is made.
  2234.   (let* ((prompt (format "%s folder%s" prompt
  2235.              (if (equal "" default)
  2236.                  "? "
  2237.                  (format " [%s]? " default))))
  2238.      name)
  2239.     (if (null mh-folder-list)
  2240.     (setq mh-folder-list (mh-make-folder-list)))
  2241.     (while (and (setq name (completing-read prompt mh-folder-list
  2242.                         nil nil "+"))
  2243.         (equal name "")
  2244.         (equal default "")))
  2245.     (cond ((or (equal name "") (equal name "+"))
  2246.        (setq name default))
  2247.       ((not (equal (substring name 0 1) "+"))
  2248.        (setq name (format "+%s" name))))
  2249.     (let ((new-file-p (not (file-exists-p (mh-expand-file-name name)))))
  2250.       (cond ((and new-file-p
  2251.           (y-or-n-p
  2252.            (format "Folder %s does not exist. Create it? " name)))
  2253.          (message "Creating %s" name)
  2254.          (call-process "mkdir" nil nil nil (mh-expand-file-name name))
  2255.          (message "Creating %s...done" name)
  2256.          (mh-push (list name) mh-folder-list)
  2257.          (mh-push (list (substring name 1 nil)) mh-folder-list))
  2258.         (new-file-p
  2259.          (error ""))
  2260.         (t
  2261.          (when (null (assoc name mh-folder-list))
  2262.            (mh-push (list name) mh-folder-list)
  2263.            (mh-push (list (substring name 1 nil)) mh-folder-list)))))
  2264.     name))
  2265.  
  2266.  
  2267. (defun mh-make-folder-list ()
  2268.   "Return a list of the user's folders.
  2269. Result is in a form suitable for completing read."
  2270.   (interactive)
  2271.   (message "Collecting folder names...")
  2272.   (save-window-excursion
  2273.     (mh-exec-cmd-quiet " *mh-temp*" "folders" "-fast" "-norecurse")
  2274.     (goto-char (point-min))
  2275.     (let ((list nil))
  2276.       (while (not (eobp))
  2277.     (let ((start (point)))
  2278.       (search-forward "\n" nil t)
  2279.       (let ((folder (buffer-substring start (- (point) 1))))
  2280.         (mh-push (list (format "+%s" folder)) list))))
  2281.       (message "Collecting folder names...done")
  2282.       list)))
  2283.  
  2284.  
  2285. (defun mh-remove-folder-from-folder-list (folder)
  2286.   ;; Remove FOLDER from the list of folders.
  2287.   (setq mh-folder-list
  2288.     (delq (assoc (substring folder 1 nil) mh-folder-list)
  2289.           mh-folder-list)))
  2290.  
  2291.  
  2292.  
  2293. ;;; Misc. functions.
  2294.  
  2295. (defun mh-get-msg-num (error-if-no-message)
  2296.   ;; Return the message number of the displayed message.  If the argument
  2297.   ;; ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not
  2298.   ;; pointing to a message.
  2299.   (save-excursion
  2300.     (beginning-of-line)
  2301.     (cond ((looking-at "^[ ]*\\([0-9]+\\)")
  2302.        (string-to-int (buffer-substring (match-beginning 1)
  2303.                         (match-end 1))))
  2304.       (error-if-no-message
  2305.        (error "Cursor not pointing to message"))
  2306.       (t nil))))
  2307.  
  2308.  
  2309. (defun mh-msg-search-pat (n)
  2310.   ;; Return a search pattern for message N in the scan listing.
  2311.   (format "^[^0-9]*%d[^0-9]" n))
  2312.  
  2313.  
  2314. (defun mh-msg-filename (msg)
  2315.   ;; Returns a string containing the file name of the MESSAGE.
  2316.   (mh-expand-file-name (int-to-string msg) mh-folder-filename))
  2317.  
  2318.  
  2319. (defun mh-msg-filenames (msgs folder)
  2320.   ;; Return a string of filenames for MSGS in FOLDER.
  2321.   (mapconcat (function (lambda (msg) (concat folder msg))) msgs " "))
  2322.  
  2323.  
  2324. (defun mh-find-path ()
  2325.   ;; Set mh-user-path, mh-draft-folder, and mh-unseen-seq from  ~/.mh_profile.
  2326.   (save-window-excursion
  2327.     (let ((profile (or (getenv "MH") "~/.mh_profile")))
  2328.       (if (not (file-exists-p profile))
  2329.       (error "Cannot find ~/.mh_profile"))
  2330.       (switch-to-buffer " *mh-temp*")
  2331.       (erase-buffer)
  2332.       (insert-file-contents profile)
  2333.       (setq mh-draft-folder (mh-get-field "Draft-Folder:" ))
  2334.       (cond ((equal mh-draft-folder "")
  2335.          (setq mh-draft-folder nil))
  2336.         ((not (equal (substring mh-draft-folder 0 1) "+"))
  2337.          (setq mh-draft-folder (format "+%s" mh-draft-folder))))
  2338.       (setq mh-user-path (mh-get-field "Path:"))
  2339.       (if (equal mh-user-path "")
  2340.       (setq mh-user-path "Mail"))
  2341.       (setq mh-user-path
  2342.         (file-name-as-directory
  2343.          (expand-file-name mh-user-path (expand-file-name "~"))))
  2344.       (if (and mh-draft-folder
  2345.            (not (file-exists-p (mh-expand-file-name mh-draft-folder))))
  2346.       (error "Draft folder does not exist.  Create it and try again."))
  2347.       (setq mh-unseen-seq (mh-get-field "Unseen-Sequence:"))
  2348.       (if (equal mh-unseen-seq "")
  2349.       (setq mh-unseen-seq 'unseen)
  2350.       (setq mh-unseen-seq (intern mh-unseen-seq))))))
  2351.  
  2352.  
  2353. (defun mh-expand-file-name (filename &optional default)
  2354.   "Just like expand-file-name, but also handles MH folder names.
  2355. Assumes that any filename that starts with '+' is a folder name."
  2356.    (if (string-equal (substring filename 0 1) "+")
  2357.        (expand-file-name (substring filename 1) mh-user-path)
  2358.      (expand-file-name filename default)))
  2359.  
  2360.  
  2361. (defun mh-get-field (field)
  2362.   ;; Find and return the value of field FIELD in the current buffer.
  2363.   ;; Returns the empty string if the field is not in the message.
  2364.   (let ((case-fold-search t))
  2365.     (goto-char (point-min))
  2366.     (cond ((not (search-forward field nil t)) "")
  2367.       ((looking-at "[\t ]*$") "")
  2368.       (t
  2369.        (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
  2370.        (let ((field (buffer-substring (match-beginning 1)
  2371.                       (match-end 1)))
  2372.          (end-of-match (point)))
  2373.          (forward-line)
  2374.          (while (looking-at "[ \t]") (forward-line 1))
  2375.          (backward-char 1)
  2376.          (if (<= (point) end-of-match)
  2377.          field
  2378.          (format "%s%s"
  2379.              field
  2380.              (buffer-substring end-of-match (point)))))))))
  2381.  
  2382.  
  2383. (defun mh-insert-fields (&rest name-values)
  2384.   ;; Insert the NAME-VALUE pairs in the current buffer.
  2385.   ;; Do not insert any pairs whose value is the empty string.
  2386.   (let ((case-fold-search t))
  2387.     (while name-values
  2388.       (let ((field-name (car name-values))
  2389.         (value (car (cdr name-values))))
  2390.     (when (not (equal value ""))
  2391.       (goto-char (point-min))
  2392.       (cond ((not (re-search-forward (format "^%s" field-name) nil t))
  2393.          (mh-goto-header-end 0)
  2394.          (insert field-name " " value "\n"))
  2395.         (t
  2396.          (end-of-line)
  2397.          (insert " " value))))
  2398.     (setq name-values (cdr (cdr name-values)))))))
  2399.  
  2400.  
  2401. (defun mh-position-on-field (field set-mark)
  2402.   ;; Set point to the end of the line beginning with FIELD.
  2403.   ;; Set the mark to the old value of point, if SET-MARK is non-nil.
  2404.   (let ((case-fold-search t))
  2405.     (if set-mark (push-mark))
  2406.     (goto-char (point-min))
  2407.     (mh-goto-header-end 0)
  2408.     (if (re-search-backward (format "^%s" field) nil t)
  2409.     (progn (end-of-line) t)
  2410.     nil)))
  2411.  
  2412.  
  2413. (defun mh-goto-header-end (arg)
  2414.   ;; Find the end of the message header in the current buffer and position
  2415.   ;; the cursor at the ARG'th newline after the header.
  2416.   (if (re-search-forward "^$\\|^-+$" nil nil)
  2417.       (forward-line arg)))
  2418.  
  2419.  
  2420.  
  2421. ;;; Build the folder-mode keymap:
  2422.  
  2423. (suppress-keymap mh-folder-mode-map)
  2424. (define-key mh-folder-mode-map "q" 'mh-restore-window-config)
  2425. (define-key mh-folder-mode-map "b" 'mh-restore-window-config)
  2426. (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
  2427. (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
  2428. (define-key mh-folder-mode-map "\ea" 'mh-edit-again)
  2429. (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
  2430. (define-key mh-folder-mode-map "\C-Xn" 'mh-narrow-to-seq)
  2431. (define-key mh-folder-mode-map "\C-Xw" 'mh-widen)
  2432. (define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
  2433. (define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
  2434. (define-key mh-folder-mode-map "\e " 'mh-page-digest)
  2435. (define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
  2436. (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
  2437. (define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
  2438. (define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
  2439. (define-key mh-folder-mode-map "\el" 'mh-list-folders)
  2440. (define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
  2441. (define-key mh-folder-mode-map "\es" 'mh-search-folder)
  2442. (define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
  2443. (define-key mh-folder-mode-map "l" 'mh-print-msg)
  2444. (define-key mh-folder-mode-map "t" 'mh-toggle-summarize)
  2445. (define-key mh-folder-mode-map "c" 'mh-copy-msg)
  2446. (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
  2447. (define-key mh-folder-mode-map "i" 'mh-inc-folder)
  2448. (define-key mh-folder-mode-map "x" 'mh-execute-commands)
  2449. (define-key mh-folder-mode-map "e" 'mh-execute-commands)
  2450. (define-key mh-folder-mode-map "r" 'mh-redistribute)
  2451. (define-key mh-folder-mode-map "f" 'mh-forward)
  2452. (define-key mh-folder-mode-map "s" 'mh-send)
  2453. (define-key mh-folder-mode-map "m" 'mh-send)
  2454. (define-key mh-folder-mode-map "a" 'mh-reply)
  2455. (define-key mh-folder-mode-map "j" 'mh-goto-msg)
  2456. (define-key mh-folder-mode-map "g" 'mh-goto-msg)
  2457. (define-key mh-folder-mode-map "\177" 'mh-previous-page)
  2458. (define-key mh-folder-mode-map " " 'mh-page-msg)
  2459. (define-key mh-folder-mode-map "." 'mh-show)
  2460. (define-key mh-folder-mode-map "u" 'mh-undo)
  2461. (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
  2462. (define-key mh-folder-mode-map "^" 'mh-refile-msg)
  2463. (define-key mh-folder-mode-map "d" 'mh-delete-msg)
  2464. (define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
  2465. (define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
  2466.  
  2467.  
  2468. ;;; Build the letter-mode keymap:
  2469.  
  2470. (define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field)
  2471. (define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field)
  2472. (define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-field)
  2473. (define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field)
  2474. (define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field)
  2475. (define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field)
  2476. (define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field)
  2477. (define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-field)
  2478. (define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field)
  2479. (define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field)
  2480. (define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft)
  2481. (define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom)
  2482. (define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter)
  2483. (define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg)
  2484. (define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature)
  2485. (define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter)
  2486.  
  2487.  
  2488. ;;; Build the pick-mode keymap:
  2489.  
  2490. (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
  2491. (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
  2492. (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
  2493. (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
  2494. (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
  2495. (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
  2496. (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
  2497. (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
  2498. (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
  2499. (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
  2500. (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)
  2501. (define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom)
  2502.