Mercurial > emacs
changeset 3220:77a302be84da
Version 3.8.1 from Gildea.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Fri, 28 May 1993 21:29:37 +0000 |
| parents | 1aa8fa0a569e |
| children | 8e605e107faa |
| files | lisp/=mh-e.el |
| diffstat | 1 files changed, 196 insertions(+), 157 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/=mh-e.el Fri May 28 21:22:17 1993 +0000 +++ b/lisp/=mh-e.el Fri May 28 21:29:37 1993 +0000 @@ -1,13 +1,13 @@ -;;; mh-e.el --- GNU Emacs interface to the MH mailer - -;;; Copyright (C) 1985, 86, 87, 88, 89, 92 Free Software Foundation - -;; Author: James Larus <larus@ginger.berkeley.edu> -;; Version: 3.7 +;;; mh-e.el --- GNU Emacs interface to the MH mail system + +;;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93 Free Software Foundation + +(defconst mh-e-time-stamp "Time-stamp: <93/05/27 18:02:50 gildea>") + +;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu> +;; Version: 3.8.1 ;; Keywords: mail -(defvar mh-e-RCS-id) - ;; GNU Emacs is distributed in the hope that it will be useful, ;; but without any warranty. No author or distributor ;; accepts responsibility to anyone for the consequences of using it @@ -24,17 +24,31 @@ ;;; Commentary: -;;; This file contains mh-e, a GNU Emacs front end to the MH mail system -;;; (specifically, for use with MH.5 and MH.6). - -;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. -;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. -;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu -;;; Modified by Stephen Gildea 1988. gildea@bbn.com - -;;; NB. MH must have been compiled with the MHE compiler flag or several -;;; features necessary mh-e will be missing from MH commands, specifically -;;; the -build switch to repl and forw. +;;; mh-e works with Emacs 18 or 19, and MH 5 or 6. + +;;; HOW TO USE: +;;; M-x mh-rmail to read mail. Type C-h m there for a list of commands. +;;; C-u M-x mh-rmail to visit any folder. +;;; M-x mh-smail to send mail. From within the mail reader, "m" works, too. +;;; Your .emacs might benefit from these bindings: +;;; (global-set-key "\C-xm" 'mh-smail) +;;; (global-set-key "\C-x4m" 'mh-smail-other-window) +;;; (global-set-key "\C-cr" 'mh-rmail) + +;;; MH (Message Handler) is a powerful mail reader. The MH newsgroup +;;; is comp.mail.mh; the mailing list is mh-users@ics.uci.edu (send to +;;; mh-users-request to be added). See the monthly Frequently Asked +;;; Questions posting there for information on getting MH. + +;;; NB. MH must have been compiled with the MHE compiler flag or several +;;; features necessary mh-e will be missing from MH commands, specifically +;;; the -build switch to repl and forw. + +;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. +;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. +;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu +;;; Modified by Stephen Gildea 1988. gildea@bbn.com +(defconst mh-e-RCS-id "$Header: mh-e.el,v 3.9 93/01/11 11:49:18 gildea Exp $") ;;; Code: @@ -47,7 +61,7 @@ ;;;(defvar mh-progs "/usr/new/mh/" "Directory containing MH commands.") ;;;(defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library.") -(defvar mh-redist-full-contents t +(defvar mh-redist-full-contents nil "Non-nil if the `dist' command needs whole letter for redistribution. This is the case when `send' is compiled with the BERK option.") @@ -70,8 +84,11 @@ (defvar mh-inc-folder-hook nil "Invoked after incorporating mail into a folder with \\[mh-inc-folder].") +(defvar mh-before-quit-hook nil + "Invoked by \\[mh-quit] before quitting mh-e. See also mh-quit-hook") + (defvar mh-quit-hook nil - "Invoked after quitting mh-e with \\[mh-quit].") + "Invoked after quitting mh-e by \\[mh-quit]. See also mh-before-quit-hook") (defvar mh-ins-string nil @@ -118,12 +135,12 @@ otherwise, your output may be truncated.") (defvar mh-summary-height 4 - "*Number of lines in summary window.") + "*Number of lines in summary window (including the mode line).") (defvar mh-recenter-summary-p nil "*Recenter summary window when the show window is toggled off if non-nil.") -(defvar mh-ins-buf-prefix ">> " +(defvar mh-ins-buf-prefix "> " "*String to put before each non-blank line of a yanked or inserted message. Used when the message is inserted in an outgoing letter.") @@ -141,7 +158,7 @@ (defvar mh-yank-from-start-of-msg t "*Controls which part of a message is yanked by \\[mh-yank-cur-msg]. -If non-nil, include the entire message. If the symbol `body, then yank the +If non-nil, include the entire message. If the symbol `body', then yank the message minus the header. If nil, yank only the portion of the message following the point. If the show buffer has a region, this variable is ignored.") @@ -154,9 +171,12 @@ (defvar mh-recursive-folders nil "*If non-nil, then commands which operate on folders do so recursively.") +(defvar mh-unshar-default-directory "" + "*Default for directory name prompted for by mh-unshar-msg.") + ;;; Parameterize mh-e to work with different scan formats. The defaults work -;;; the standard MH scan listings. +;;; with the standard MH scan listings. (defvar mh-cmd-note 4 "Offset to insert notation.") @@ -214,7 +234,10 @@ If `mh-visible-headers' is non-nil, it is used instead to specify what to keep.") -(defvar mh-rejected-letter-start "^ ----- Unsent message follows -----$" +(defvar mh-rejected-letter-start + (concat "^ ----- Unsent message follows -----$" ;from mail system + "\\|^------- Unsent Draft$" ;from MH itself + "\\|^ --- The unsent message follows ---$") ;from AIX mail system "Regexp specifying the beginning of the wrapper around a returned letter. This wrapper is generated by the mail system when rejecting a letter.") @@ -240,6 +263,9 @@ (defvar mh-pick-mode-map (make-sparse-keymap) "Keymap for searching folder.") +(defvar mh-searching-folder nil + "Folder this pick is searching.") + (defvar mh-letter-mode-syntax-table nil "Syntax table used while in mh-e letter mode.") @@ -266,9 +292,6 @@ (defvar mh-previous-seq nil "Name of the sequence to which a message was last added.") -(defvar mh-signature-file-name "~/.signature" - "Name of file containing the user's signature.") - ;;; Macros and generic functions: @@ -413,13 +436,13 @@ (config (current-window-configuration)) (draft (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) - (find-file (mh-msg-filename msg)) + (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) (rename-buffer (format "draft-%d" msg)) (buffer-name)) (t (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) (mh-clean-msg-header (point-min) - "^Date:\\|^Received:\\|^Message-Id:\\|^From:" + "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Delivery-Date:" nil) (goto-char (point-min)) (set-buffer-modified-p nil) @@ -450,7 +473,7 @@ (forward-char 1) (delete-region (point-min) (point)) (mh-clean-msg-header (point-min) - "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:" + "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Return-Path:" nil)) (t (message "Does not appear to be a rejected letter."))) @@ -517,7 +540,7 @@ Non-nil second argument means do not signal an error if message does not exist. Non-nil third argument means not to show the message. Return non-nil if cursor is at message." - (interactive "NMessage number? ") + (interactive "NGoto message: ") (let ((cur-msg (mh-get-msg-num nil)) (starting-place (point)) (msg-pattern (mh-msg-search-pat number))) @@ -544,7 +567,7 @@ (defun mh-inc-folder (&optional maildrop-name) "Inc(orporate) new mail into +inbox. Optional prefix argument specifies an alternate maildrop from the default. -If this is given, mail is incorporated into the current folder, rather +If this is given, incorporate mail into the current folder, rather than +inbox. Run `mh-inc-folder-hook' after incorporating new mail." (interactive (list (if current-prefix-arg (expand-file-name @@ -573,7 +596,8 @@ (mh-remove-folder-from-folder-list folder) (message "Folder %s removed" folder) (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain - (kill-buffer mh-show-buffer) + (if (get-buffer mh-show-buffer) + (kill-buffer mh-show-buffer)) (kill-buffer folder)) (message "Folder not removed"))) @@ -594,7 +618,9 @@ (switch-to-buffer " *mh-temp*") (erase-buffer) (message "Listing folders...") - (mh-exec-cmd-output "folders" t) + (mh-exec-cmd-output "folders" t (if mh-recursive-folders + "-recurse" + "-norecurse")) (goto-char (point-min)) (message "Listing folders...done")))) @@ -660,7 +686,7 @@ (interactive (list current-prefix-arg (read-string "Shell command on message: "))) (save-excursion - (set-buffer mh-show-buffer) + (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer (goto-char (point-min)) (if (not prefix-provided) (search-forward "\n\n")) (shell-command-on-region (point) (point-max) command nil))) @@ -721,7 +747,7 @@ (message "Composing a reply...") (cond ((or (equal reply-to "from") (equal reply-to "")) (apply 'mh-exec-cmd - "repl" "-build" + "repl" "-build" "-noquery" "-nodraftfolder" mh-current-folder msg "-nocc" "all" @@ -729,7 +755,7 @@ (list "-filter" "mhl.reply")))) ((equal reply-to "to") (apply 'mh-exec-cmd - "repl" "-build" + "repl" "-build" "-noquery" "-nodraftfolder" mh-current-folder msg "-cc" "to" @@ -737,7 +763,7 @@ (list "-filter" "mhl.reply")))) ((or (equal reply-to "cc") (equal reply-to "all")) (apply 'mh-exec-cmd - "repl" "-build" + "repl" "-build" "-noquery" "-nodraftfolder" mh-current-folder msg "-cc" "all" "-nocc" "me" @@ -764,9 +790,11 @@ (defun mh-quit () - "Restore the previous window configuration, if one exists. -Finish by running mh-quit-hook." + "Quit mh-e. +Start by running mh-before-quit-hook. Restore the previous window +configuration, if one exists. Finish by running mh-quit-hook." (interactive) + (run-hooks 'mh-before-quit-hook) (if mh-previous-window-config (set-window-configuration mh-previous-window-config)) (run-hooks 'mh-quit-hook)) @@ -903,7 +931,7 @@ (mh-add-msgs-to-seq from to)) -(defun mh-rescan-folder (range) +(defun mh-rescan-folder (&optional range) "Rescan a folder after optionally processing the outstanding commands. If optional prefix argument is provided, prompt for the range of messages to display. Otherwise show the entire folder." @@ -987,7 +1015,10 @@ (defun mh-send (to cc subject) - "Compose and send a letter." + "Compose and send a letter. +The letter is composed in mh-letter-mode; see its documentation for more +details. If `mh-compose-letter-function' is defined, it is called on the +draft and passed three arguments: to, subject, and cc." (interactive "sTo: \nsCc: \nsSubject: ") (let ((config (current-window-configuration))) (delete-other-windows) @@ -1042,14 +1073,15 @@ (mh-show-message-in-other-window) (mh-display-msg msg folder)) (other-window -1) - (shrink-window (- (window-height) mh-summary-height)) + (if (not (= (1+ (window-height)) (screen-height))) ;not horizontally split + (shrink-window (- (window-height) mh-summary-height))) (mh-recenter nil) (if (not (memq msg mh-seen-list)) (mh-push msg mh-seen-list))) (defun mh-sort-folder () "Sort the messages in the current folder by date." - (interactive "") + (interactive) (mh-process-or-undo-commands mh-current-folder) (setq mh-next-direction 'forward) (mh-set-folder-modified-p t) ; lock folder while sorting @@ -1075,21 +1107,30 @@ (if current-prefix-arg (mh-read-seq-default "Undo" t) (mh-get-msg-num t)))) - (cond (prefix-provided (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq))) - ((or (looking-at mh-deleted-msg-regexp) - (looking-at mh-refiled-msg-regexp)) - (mh-undo-msg (mh-get-msg-num t))) (t - (error "Nothing to undo"))) + (let ((original-position (point))) + (beginning-of-line) + (while (not (or (looking-at mh-deleted-msg-regexp) + (looking-at mh-refiled-msg-regexp) + (and (eq mh-next-direction 'forward) (bobp)) + (and (eq mh-next-direction 'backward) + (save-excursion (forward-line) (eobp))))) + (forward-line (if (eq mh-next-direction 'forward) -1 1))) + (if (or (looking-at mh-deleted-msg-regexp) + (looking-at mh-refiled-msg-regexp)) + (progn + (mh-undo-msg (mh-get-msg-num t)) + (mh-maybe-show)) + (goto-char original-position) + (error "Nothing to undo"))))) ;; update the mh-refile-list so mh-outstanding-commands-p will work (mh-mapc (function (lambda (elt) (if (not (mh-seq-to-msgs elt)) (setq mh-refile-list (delq elt mh-refile-list))))) mh-refile-list) - (if (not (mh-outstanding-commands-p)) (mh-set-folder-modified-p nil))) @@ -1098,18 +1139,17 @@ ;; Undo the deletion or refile of one MESSAGE. (cond ((memq msg mh-delete-list) (setq mh-delete-list (delq msg mh-delete-list)) - (mh-remove-msg-from-seq msg 'deleted t) - (mh-notate msg ? mh-cmd-note)) + (mh-remove-msg-from-seq msg 'deleted t)) (t (mh-mapc (function (lambda (dest) (mh-remove-msg-from-seq msg dest t))) - mh-refile-list) - (mh-notate msg ? mh-cmd-note)))) + mh-refile-list))) + (mh-notate msg ? mh-cmd-note)) (defun mh-undo-folder (&rest ignore) "Undo all commands in current folder." - (interactive "") + (interactive) (cond ((or mh-do-not-confirm (yes-or-no-p "Undo all commands in folder? ")) (setq mh-delete-list nil @@ -1123,22 +1163,57 @@ (sit-for 2)))) +(defun mh-unshar-msg (dir) + "Unpack the shar file contained in the current message into directory DIR." + (interactive (list (read-file-name "Unshar message in directory: " + mh-unshar-default-directory + mh-unshar-default-directory nil))) + (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer + (mh-unshar-buffer dir)) + +(defun mh-unshar-buffer (dir) + ;; Unpack the shar file contained in the current buffer into directory DIR. + (goto-char (point-min)) + (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t) + (and (re-search-forward "^[^a-z0-9\"]*cut here\b" nil t) + (forward-line 1)) + (re-search-forward "^#" nil t) + (re-search-forward "^: " nil t)) + (let ((default-directory (expand-file-name dir)) + (start (progn (beginning-of-line) (point))) + (log-buffer (get-buffer-create "*Unshar Output*"))) + (save-excursion + (set-buffer log-buffer) + (setq default-directory (expand-file-name dir)) + (erase-buffer) + (if (file-directory-p default-directory) + (insert "cd " dir "\n") + (insert "mkdir " dir "\n") + (call-process "mkdir" nil log-buffer t default-directory))) + (set-window-start (display-buffer log-buffer) 0) ;so can watch progress + (call-process-region start (point-max) "sh" nil log-buffer t)) + (error "Cannot find start of shar."))) + + (defun mh-visit-folder (folder &optional range) - "Visit FOLDER and display RANGE of messages." + "Visit FOLDER and display RANGE of messages. +Assumes mh-e has already been initialized." (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t) (mh-read-msg-range "Range [all]? "))) (let ((config (current-window-configuration))) (mh-scan-folder folder (or range "all")) - (setq mh-previous-window-config config))) + (setq mh-previous-window-config config)) + nil) (defun mh-widen () "Remove restrictions from the current folder, thereby showing all messages." - (interactive "") - (with-mh-folder-updating (t) - (delete-region (point-min) (point-max)) - (widen) - (mh-make-folder-mode-line)) + (interactive) + (if mh-narrowed-to-seq + (with-mh-folder-updating (t) + (delete-region (point-min) (point-max)) + (widen) + (mh-make-folder-mode-line))) (setq mh-narrowed-to-seq nil)) @@ -1160,7 +1235,7 @@ (defun mh-refile-a-msg (msg destination) - ;; Refile MESSAGE in FOLDER. + ;; Refile MESSAGE in FOLDER. FOLDER is a symbol, not a string. (save-excursion (mh-goto-msg msg nil t) (cond ((looking-at mh-deleted-msg-regexp) @@ -1184,6 +1259,7 @@ (defun mh-display-msg (msg-num folder) ;; Display message NUMBER of FOLDER. + ;; Sets the current buffer to the show buffer. (set-buffer folder) ;; Bind variables in folder buffer in case they are local (let ((formfile mhl-formfile) @@ -1253,7 +1329,7 @@ (save-restriction (goto-char start) (if (search-forward "\n\n" nil t) - (backward-char 2)) + (backward-char 1)) (narrow-to-region start (point)) (goto-char (point-min)) (if visible-headers @@ -1293,7 +1369,7 @@ ;; reused. (cond (mh-draft-folder (let ((orig-default-dir default-directory)) - (pop-to-buffer (find-file-noselect (mh-new-draft-name) t)) + (pop-to-buffer (find-file-noselect (mh-new-draft-name)) t) (rename-buffer (format "draft-%s" (buffer-name))) (setq default-directory orig-default-dir))) (t @@ -1436,9 +1512,9 @@ a messages is toggled off. mh-summary-height (4) - Number of lines in the summary window. - - mh-ins-buf-prefix (\">> \") + Number of lines in the summary window including the mode line. + + mh-ins-buf-prefix (\"> \") String to insert before each non-blank line of a message as it is inserted in a draft letter. @@ -1464,6 +1540,7 @@ 'mh-first-msg-num nil ; Number of first msg in buffer 'mh-last-msg-num nil ; Number of last msg in buffer 'mh-previous-window-config nil) ; Previous window configuration + (setq truncate-lines t) (auto-save-mode -1) (setq buffer-offer-save t) (make-local-variable 'write-file-hooks) @@ -1696,7 +1773,7 @@ (save-excursion (mh-first-msg) (while (and msgs (< (point) (point-max))) - (cond ((= (mh-get-msg-num nil) (car msgs)) + (cond ((equal (mh-get-msg-num nil) (car msgs)) (delete-region (point) (save-excursion (forward-line) (point))) (setq msgs (cdr msgs))) (t @@ -1769,7 +1846,10 @@ (mh-set-mode-name "mh-e letter") (set-syntax-table mh-letter-mode-syntax-table) (run-hooks 'text-mode-hook 'mh-letter-mode-hook) - (mh-when auto-fill-function + (mh-when (and (boundp 'auto-fill-hook) auto-fill-hook) ;emacs 18 + (make-local-variable 'auto-fill-hook) + (setq auto-fill-hook 'mh-auto-fill-for-letter)) + (mh-when (and (boundp 'auto-fill-function) auto-fill-function) ;emacs 19 (make-local-variable 'auto-fill-function) (setq auto-fill-function 'mh-auto-fill-for-letter))) @@ -1797,7 +1877,7 @@ "Move point to the end of a specified header field. The field is indicated by the previous keystroke. Create the field if it does not exist. Set the mark to point before moving." - (interactive "") + (interactive) (expand-abbrev) (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices))) (case-fold-search t)) @@ -1805,9 +1885,10 @@ (let ((eol (point))) (skip-chars-backward " \t") (delete-region (point) eol)) - (if (save-excursion - (backward-char 1) - (not (looking-at "[:,]"))) + (if (and (not (eq (logior last-input-char ?`) ?s)) + (save-excursion + (backward-char 1) + (not (looking-at "[:,]")))) (insert ", ") (insert " "))) (t @@ -1833,8 +1914,8 @@ (defun mh-insert-signature () "Insert the file ~/.signature at the current point." - (interactive "") - (insert-file-contents mh-signature-file-name) + (interactive) + (insert-file-contents "~/.signature") (set-buffer-modified-p (buffer-modified-p))) ; force mode line update @@ -1883,7 +1964,7 @@ (interactive) (let ((pattern-buffer (buffer-name)) (searching-buffer mh-searching-folder) - (range) + range msgs (pattern nil) (new-buffer nil)) (save-excursion @@ -1997,7 +2078,7 @@ "-nodraftfolder" mh-send-args file-name) (mh-exec-cmd-output "send" t "-watch" "-nopush" "-nodraftfolder" file-name)) - (goto-char (point-max)) + (goto-char (point-max)) ; show the interesting part (recenter -1) (set-buffer draft-buffer)) ; for annotation below (mh-send-args @@ -2068,7 +2149,8 @@ (delete-windows-on mh-show-buffer)) (set-buffer mh-show-buffer) ; Find displayed message (let ((mh-ins-str (cond ((mark) - (buffer-substring (point) (mark))) + (buffer-substring (region-beginning) + (region-end))) ((eq 'body mh-yank-from-start-of-msg) (buffer-substring (save-excursion @@ -2102,7 +2184,7 @@ (defun mh-fully-kill-draft () "Kill the draft message file and the draft message buffer. Use \\[kill-buffer] if you don't want to delete the draft message file." - (interactive "") + (interactive) (if (y-or-n-p "Kill draft message? ") (let ((config mh-previous-window-config)) (if (file-exists-p (buffer-file-name)) @@ -2198,7 +2280,8 @@ (save-excursion (mh-exec-cmd-quiet " *mh-temp*" "mark" folder "-list") (goto-char (point-min)) - (while (re-search-forward "^[^:]+" nil t) + ;; look for name in line of form "cur: 4" or "myseq (private): 23" + (while (re-search-forward "^[^: ]+" nil t) (mh-push (mh-make-seq (intern (buffer-substring (match-beginning 0) (match-end 0))) (mh-read-msg-list)) @@ -2324,7 +2407,7 @@ (defun mh-folder-name-p (name) ;; Return non-NIL if NAME is possibly the name of a folder. - ;; A name can be a folder name if it begins with "+". + ;; A name (a string or symbol) can be a folder name if it begins with "+". (if (symbolp name) (eql (aref (symbol-name name) 0) ?+) (eql (aref name 0) ?+))) @@ -2458,10 +2541,11 @@ (save-excursion (set-buffer (get-buffer-create " *mh-temp*")) (erase-buffer)) - (let ((process (apply 'start-process - command nil - (expand-file-name command mh-progs) - (mh-list-to-string args)))) + (let* ((process-connection-type nil) + (process (apply 'start-process + command nil + (expand-file-name command mh-progs) + (mh-list-to-string args)))) (set-process-filter process 'mh-process-daemon))) @@ -2531,16 +2615,16 @@ ;;; User prompting commands. (defun mh-prompt-for-folder (prompt default can-create) - ;; Prompt for a folder name with PROMPT. Returns the folder's name. - ;; DEFAULT is used if the folder exists and the user types return. - ;; If the CAN-CREATE flag is t, then a non-existant folder is made. + ;; Prompt for a folder name with PROMPT. Returns the folder's name as a + ;; string. DEFAULT is used if the folder exists and the user types return. + ;; If the CAN-CREATE flag is t, then a non-existent folder is made. (let* ((prompt (format "%s folder%s" prompt (if (equal "" default) "? " (format " [%s]? " default)))) name) (if (null mh-folder-list) - (setq mh-folder-list (mh-make-folder-list))) + (mh-set-folder-list)) (while (and (setq name (completing-read prompt mh-folder-list nil nil "+")) (equal name "") @@ -2556,17 +2640,21 @@ (message "Creating %s" name) (call-process "mkdir" nil nil nil (mh-expand-file-name name)) (message "Creating %s...done" name) - (mh-push (list name) mh-folder-list) - (mh-push (list (substring name 1 nil)) mh-folder-list)) + (mh-push (list name) mh-folder-list)) (new-file-p (error "Folder %s is not created" name)) (t (mh-when (null (assoc name mh-folder-list)) - (mh-push (list name) mh-folder-list) - (mh-push (list (substring name 1 nil)) mh-folder-list))))) + (mh-push (list name) mh-folder-list))))) name)) +(defun mh-set-folder-list () + "Sets mh-folder-list correctly. +A useful function for the command line or for when you need to sync by hand." + (setq mh-folder-list (mh-make-folder-list))) + + (defun mh-make-folder-list () "Return a list of the user's folders. Result is in a form suitable for completing read." @@ -2687,21 +2775,15 @@ ;; Returns the empty string if the field is not in the message. (let ((case-fold-search t)) (goto-char (point-min)) - (cond ((not (search-forward field nil t)) "") + (cond ((not (re-search-forward (format "^%s" field) nil t)) "") ((looking-at "[\t ]*$") "") (t (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) - (let ((field (buffer-substring (match-beginning 1) - (match-end 1))) - (end-of-match (point))) - (forward-line) - (while (looking-at "[ \t]") (forward-line 1)) - (backward-char 1) - (if (<= (point) end-of-match) - field - (format "%s%s" - field - (buffer-substring end-of-match (point))))))))) + (let ((start (match-beginning 1))) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) + (buffer-substring start (1- (point)))))))) (defun mh-insert-fields (&rest name-values) @@ -2725,6 +2807,7 @@ (defun mh-position-on-field (field set-mark) ;; Set point to the end of the line beginning with FIELD. ;; Set the mark to the old value of point, if SET-MARK is non-nil. + ;; Returns non-nil iff the field was found. (let ((case-fold-search t)) (if set-mark (push-mark)) (goto-char (point-min)) @@ -2740,52 +2823,6 @@ (if (re-search-forward "^$\\|^-+$" nil nil) (forward-line arg))) - -(defun mh-unshar (dir) - "Unshar the current message in the directory given by DIR." - (interactive "DUnshar in directory: ") - (let ((default-directory default-directory) - (errbuf " *Unshar Output*") - (curbuf (current-buffer)) - (show-buffer mh-show-buffer) - start - ) - (setq dir (expand-file-name dir)) - (if (not (eq system-type 'vax-vms)) - (setq dir (file-name-as-directory dir))) - (mh-show nil) ;;; force showing of current message - (save-excursion - (set-buffer show-buffer) - (goto-char (point-min)) - (message "Looking for start of shar package ...") - (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t) - (and (re-search-forward "^[^a-z0-9\"]*cut here" nil t) - (forward-line 1)) - (re-search-forward "^#" nil t) - (re-search-forward "^: " nil t) - ) - (progn - (beginning-of-line) - (setq start (point)) - (set-buffer curbuf) - (pop-to-buffer errbuf) - (kill-region (point-max) (point-min)) - (insert (format "Unsharing in directory \"%s\" ...\n\n" dir)) - (message "Please wait ...") - (sit-for 0) - (set-buffer show-buffer) - (setq default-directory dir) - (call-process-region start (point-max) - "/bin/sh" nil errbuf t) - (pop-to-buffer curbuf) - (message "Unshar done") - ) - (error "Can't find start of shar file") - ) - ) - ) - ) - ;;; Build the folder-mode keymap: @@ -2808,7 +2845,7 @@ (define-key mh-folder-mode-map "\ef" 'mh-visit-folder) (define-key mh-folder-mode-map "\ek" 'mh-kill-folder) (define-key mh-folder-mode-map "\el" 'mh-list-folders) -(define-key mh-folder-mode-map "\en" 'mh-unshar) +(define-key mh-folder-mode-map "\en" 'mh-unshar-msg) (define-key mh-folder-mode-map "\eo" 'mh-write-msg-to-file) (define-key mh-folder-mode-map "\ep" 'mh-pack-folder) (define-key mh-folder-mode-map "\es" 'mh-search-folder) @@ -2826,6 +2863,7 @@ (define-key mh-folder-mode-map "m" 'mh-send) (define-key mh-folder-mode-map "a" 'mh-reply) (define-key mh-folder-mode-map "j" 'mh-goto-msg) +(define-key mh-folder-mode-map "<" 'mh-first-msg) (define-key mh-folder-mode-map "g" 'mh-goto-msg) (define-key mh-folder-mode-map "\177" 'mh-previous-page) (define-key mh-folder-mode-map " " 'mh-page-msg) @@ -2879,10 +2917,11 @@ ;;; For Gnu Emacs. ;;; Local Variables: *** -;;; eval: (put 'mh-when 'lisp-indent-function 1) *** -;;; eval: (put 'with-mh-folder-updating 'lisp-indent-function 1) *** +;;; eval: (put 'mh-when 'lisp-indent-hook 1) *** +;;; eval: (put 'with-mh-folder-updating 'lisp-indent-hook 1) *** ;;; End: *** (provide 'mh-e) ;;; mh-e.el ends here +