/[emacs]/emacs/lisp/mh-e/mh-e.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-e.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wohler, Sun Jan 26 02:38:37 2003 UTC revision 1.2 by wohler, Mon Feb 3 20:55:30 2003 UTC
# Line 4  Line 4 
4    
5  ;; Author: Bill Wohler <wohler@newt.com>  ;; Author: Bill Wohler <wohler@newt.com>
6  ;; Maintainer: Bill Wohler <wohler@newt.com>  ;; Maintainer: Bill Wohler <wohler@newt.com>
7  ;; Version: 7.1  ;; Version: 7.2
8  ;; Keywords: mail  ;; Keywords: mail
9    
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 102  Line 102 
102  (defvar font-lock-auto-fontify)  (defvar font-lock-auto-fontify)
103  (defvar font-lock-defaults)  (defvar font-lock-defaults)
104    
105  (defconst mh-version "7.1" "Version number of MH-E.")  (defconst mh-version "7.2" "Version number of MH-E.")
106    
107  ;;; Autoloads  ;;; Autoloads
108  (autoload 'Info-goto-node "info")  (autoload 'Info-goto-node "info")
# Line 457  is done highlighting.") Line 457  is done highlighting.")
457  (defvar mh-folder-mode-map (make-keymap)  (defvar mh-folder-mode-map (make-keymap)
458    "Keymap for MH folders.")    "Keymap for MH folders.")
459    
460    (defvar mh-arrow-marker nil)            ;Marker for arrow display in fringe.
461    
462  (defvar mh-delete-list nil)             ;List of msg numbers to delete.  (defvar mh-delete-list nil)             ;List of msg numbers to delete.
463    
464  (defvar mh-refile-list nil)             ;List of folder names in mh-seq-list.  (defvar mh-refile-list nil)             ;List of folder names in mh-seq-list.
# Line 512  the Emacs front end to the MH mail syste Line 514  the Emacs front end to the MH mail syste
514    (mh-find-path)    (mh-find-path)
515    (if arg    (if arg
516        (call-interactively 'mh-visit-folder)        (call-interactively 'mh-visit-folder)
517        (unless (get-buffer mh-inbox)
518          (mh-visit-folder mh-inbox (symbol-name mh-unseen-seq)))
519      (mh-inc-folder)))      (mh-inc-folder)))
520    
521  ;;;###autoload  ;;;###autoload
# Line 537  prompt for the message sequence. If vari Line 541  prompt for the message sequence. If vari
541  and the mark is active, then the selected region is marked for deletion."  and the mark is active, then the selected region is marked for deletion."
542    (interactive (list (cond    (interactive (list (cond
543                        ((mh-mark-active-p t)                        ((mh-mark-active-p t)
544                         (mh-region-to-msg-list (region-beginning) (region-end)))                         (cons (region-beginning) (region-end)))
545                        (current-prefix-arg                        (current-prefix-arg
546                         (mh-read-seq-default "Delete" t))                         (mh-read-seq-default "Delete" t))
547                        (t                        (t
548                         (mh-get-msg-num t)))))                         (cons (line-beginning-position) (line-end-position))))))
549    (mh-delete-msg-no-motion msg-or-seq)    (mh-delete-msg-no-motion msg-or-seq)
550    (mh-next-msg))    (mh-next-msg))
551    
# Line 552  then prompt for the message sequence." Line 556  then prompt for the message sequence."
556    (interactive (list (if current-prefix-arg    (interactive (list (if current-prefix-arg
557                           (mh-read-seq-default "Delete" t)                           (mh-read-seq-default "Delete" t)
558                         (mh-get-msg-num t))))                         (mh-get-msg-num t))))
559    (if (numberp msg-or-seq)    (cond ((numberp msg-or-seq)
560        (mh-delete-a-msg msg-or-seq)           (mh-delete-a-msg msg-or-seq))
561      (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))          ((and (consp msg-or-seq)
562                  (numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
563             (mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
564               (mh-delete-a-msg nil)))
565            (t (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))))
566    
567  (defun mh-execute-commands ()  (defun mh-execute-commands ()
568    "Process outstanding delete and refile requests."    "Process outstanding delete and refile requests."
# Line 585  Type \"\\[mh-show]\" to show the message Line 593  Type \"\\[mh-show]\" to show the message
593         (mh-invalidate-show-buffer))         (mh-invalidate-show-buffer))
594    (let ((mh-decode-mime-flag nil)    (let ((mh-decode-mime-flag nil)
595          (mhl-formfile nil)          (mhl-formfile nil)
596            (mh-decode-content-transfer-encoded-message-flag nil)
597          (mh-clean-message-header-flag nil))          (mh-clean-message-header-flag nil))
598      (mh-show-msg nil)      (mh-show-msg nil)
599      (mh-in-show-buffer (mh-show-buffer)      (mh-in-show-buffer (mh-show-buffer)
# Line 645  Do not call this function from outside M Line 654  Do not call this function from outside M
654          (t (forward-line -1)          (t (forward-line -1)
655             (message "No more undeleted messages"))))             (message "No more undeleted messages"))))
656    
657    (defun mh-folder-from-address ()
658      "Determine folder name from address in From field.
659    Takes the address in the From: header field, and returns one of:
660    
661      a) The folder name associated with the address in the alist
662         `mh-default-folder-list'.
663    
664      b) The address' corresponding alias from the user's personal
665         aliases file prefixed by `mh-default-folder-prefix'.
666    
667    Returns nil if the address was not found in either place or if the variable
668    `mh-default-folder-must-exist-flag' is nil and the folder does not exist."
669      ;; Is address in mh-default-folder-list?
670      (let* ((address
671              (nth 1 (mail-extract-address-components
672                      (mh-extract-from-header-value))))
673             (folder-name
674              (nth 1 (assoc-ignore-case address mh-default-folder-list))))
675    
676        ;; If not, is there an alias for the address?
677        (if (not folder-name)
678            (let* ((alias (mh-alias-address-to-alias address)))
679              (setq folder-name
680                    (and alias (concat "+" mh-default-folder-prefix alias)))))
681    
682        ;; If mh-default-folder-must-exist-flag set, check that folder exists.
683        (if (and folder-name
684                 (or (not mh-default-folder-must-exist-flag)
685                     (file-exists-p (mh-expand-file-name folder-name))))
686            folder-name)))
687    
688    (defun mh-prompt-for-refile-folder ()
689      "Prompt the user for a folder in which the message should be filed.
690    The folder is returned as a string.
691    
692    If `mh-default-folder-for-message-function' is a function then the message
693    being refiled is yanked into a temporary buffer and the function is called to
694    intelligently guess where the message is to be refiled.
695    
696    Otherwise, a default folder name is generated by `mh-folder-from-address'."
697      (mh-prompt-for-folder
698       "Destination"
699       (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
700         (save-excursion
701           (set-buffer (get-buffer-create mh-temp-buffer))
702           (erase-buffer)
703           (insert-file-contents refile-file)
704           (or (and mh-default-folder-for-message-function
705                    (let ((buffer-file-name refile-file))
706                      (funcall mh-default-folder-for-message-function)))
707               (mh-folder-from-address)
708               (and (eq 'refile (car mh-last-destination-folder))
709                    (symbol-name (cdr mh-last-destination-folder)))
710               "")))
711       t))
712    
713  (defun mh-refile-msg (msg-or-seq folder)  (defun mh-refile-msg (msg-or-seq folder)
714    "Refile MSG-OR-SEQ (default: displayed message) into FOLDER.    "Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
715  If optional prefix argument provided, then prompt for message sequence.  If optional prefix argument provided, then prompt for message sequence.
# Line 653  selected region is marked for refiling." Line 718  selected region is marked for refiling."
718    (interactive    (interactive
719     (list (cond     (list (cond
720            ((mh-mark-active-p t)            ((mh-mark-active-p t)
721             (mh-region-to-msg-list (region-beginning) (region-end)))             (cons (region-beginning) (region-end)))
722            (current-prefix-arg            (current-prefix-arg
723             (mh-read-seq-default "Refile" t))             (mh-read-seq-default "Refile" t))
724            (t            (t
725             (mh-get-msg-num t)))             (cons (line-beginning-position) (line-end-position))))
726           (intern           (intern (mh-prompt-for-refile-folder))))
           (mh-prompt-for-folder  
            "Destination"  
            (or (and mh-default-folder-for-message-function  
                     (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))  
                       (save-excursion  
                         (set-buffer (get-buffer-create mh-temp-buffer))  
                         (erase-buffer)  
                         (insert-file-contents refile-file)  
                         (let ((buffer-file-name refile-file))  
                           (funcall mh-default-folder-for-message-function)))))  
                (and (eq 'refile (car mh-last-destination-folder))  
                     (symbol-name (cdr mh-last-destination-folder)))  
                "")  
            t))))  
727    (setq mh-last-destination (cons 'refile folder)    (setq mh-last-destination (cons 'refile folder)
728          mh-last-destination-folder mh-last-destination)          mh-last-destination-folder mh-last-destination)
729    (if (numberp msg-or-seq)    (cond ((numberp msg-or-seq)
730        (mh-refile-a-msg msg-or-seq folder)           (mh-refile-a-msg msg-or-seq folder))
731      (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))          ((and (consp msg-or-seq)
732                  (numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
733             (mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
734               (mh-refile-a-msg nil folder)))
735            (t (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)))
736    (mh-next-msg))    (mh-next-msg))
737    
738  (defun mh-refile-or-write-again (message)  (defun mh-refile-or-write-again (message)
# Line 701  Restore the previous window configuratio Line 756  Restore the previous window configuratio
756  The value of `mh-before-quit-hook' is a list of functions to be called, with  The value of `mh-before-quit-hook' is a list of functions to be called, with
757  no arguments, immediately upon entry to this function.  no arguments, immediately upon entry to this function.
758  The value of `mh-quit-hook' is a list of functions to be called, with no  The value of `mh-quit-hook' is a list of functions to be called, with no
759  arguments, upon exit of this function."  arguments, upon exit of this function.
760    MH-E working buffers (whose name begins with \" *mh-\" or \"*MH-E \") are
761    killed."
762    (interactive)    (interactive)
763    (run-hooks 'mh-before-quit-hook)    (run-hooks 'mh-before-quit-hook)
764    (let ((show-buffer (get-buffer mh-show-buffer)))    (let ((show-buffer (get-buffer mh-show-buffer)))
# Line 710  arguments, upon exit of this function." Line 767  arguments, upon exit of this function."
767    (mh-update-sequences)    (mh-update-sequences)
768    (mh-destroy-postponed-handles)    (mh-destroy-postponed-handles)
769    (bury-buffer (current-buffer))    (bury-buffer (current-buffer))
770    (if (get-buffer mh-temp-buffer)  
771        (kill-buffer mh-temp-buffer))    ;; Delete all MH-E temporary and working buffers.
772    (if (get-buffer mh-temp-folders-buffer)    (dolist (buffer (buffer-list))
773        (kill-buffer mh-temp-folders-buffer))      (when (or (string-match "^ \\*mh-" (buffer-name buffer))
774    (if (get-buffer mh-temp-sequences-buffer)                (string-match "^\\*MH-E " (buffer-name buffer)))
775        (kill-buffer mh-temp-sequences-buffer))        (kill-buffer buffer)))
776    
777    (if mh-previous-window-config    (if mh-previous-window-config
778        (set-window-configuration mh-previous-window-config))        (set-window-configuration mh-previous-window-config))
779    (run-hooks 'mh-quit-hook))    (run-hooks 'mh-quit-hook))
# Line 985  If variable `transient-mark-mode' is non Line 1043  If variable `transient-mark-mode' is non
1043  selected region is unmarked."  selected region is unmarked."
1044    (interactive (list (cond    (interactive (list (cond
1045                        ((mh-mark-active-p t)                        ((mh-mark-active-p t)
1046                         (mh-region-to-msg-list (region-beginning) (region-end)))                         (cons (region-beginning) (region-end)))
1047                        (current-prefix-arg                        (current-prefix-arg
1048                         (mh-read-seq-default "Undo" t))                         (mh-read-seq-default "Undo" t))
1049                        (t                        (t
# Line 1006  selected region is unmarked." Line 1064  selected region is unmarked."
1064                   (mh-maybe-show))                   (mh-maybe-show))
1065               (goto-char original-position)               (goto-char original-position)
1066               (error "Nothing to undo"))))               (error "Nothing to undo"))))
1067            ((and (consp msg-or-seq)
1068                  (numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
1069             (mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
1070               (mh-undo-msg nil)))
1071          (t          (t
1072           (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))           (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
1073    (if (not (mh-outstanding-commands-p))    (if (not (mh-outstanding-commands-p))
# Line 1045  compiled then macro expansion happens at Line 1107  compiled then macro expansion happens at
1107    "Display version information about MH-E and the MH mail handling system."    "Display version information about MH-E and the MH mail handling system."
1108    (interactive)    (interactive)
1109    (mh-find-progs)    (mh-find-progs)
1110    (set-buffer (get-buffer-create mh-temp-buffer))    (set-buffer (get-buffer-create mh-info-buffer))
1111    (erase-buffer)    (erase-buffer)
1112    ;; MH-E version.    ;; MH-E version.
1113    (insert "MH-E " mh-version "\n\n")    (insert "MH-E " mh-version "\n\n")
# Line 1079  compiled then macro expansion happens at Line 1141  compiled then macro expansion happens at
1141        (call-process "uname" nil t nil "-a")        (call-process "uname" nil t nil "-a")
1142      (file-error))      (file-error))
1143    (goto-char (point-min))    (goto-char (point-min))
1144    (display-buffer mh-temp-buffer))    (display-buffer mh-info-buffer))
1145    
1146  (defun mh-parse-flist-output-line (line)  (defun mh-parse-flist-output-line (line &optional current-folder)
1147    "Parse LINE to generate folder name, unseen messages and total messages."    "Parse LINE to generate folder name, unseen messages and total messages.
1148    If CURRENT-FOLDER is non-nil then it contains the current folder name and it is
1149    used to avoid problems in corner cases involving folders whose names end with a
1150    '+' character."
1151    (with-temp-buffer    (with-temp-buffer
1152      (insert line)      (insert line)
1153      (goto-char (point-max))      (goto-char (point-max))
# Line 1096  compiled then macro expansion happens at Line 1161  compiled then macro expansion happens at
1161            (when (search-backward " has " (point-min) t)            (when (search-backward " has " (point-min) t)
1162              (setq unseen (read-from-string (buffer-substring-no-properties              (setq unseen (read-from-string (buffer-substring-no-properties
1163                                              (match-end 0) p)))                                              (match-end 0) p)))
1164              (while (or (eq (char-after) ?+) (eq (char-after) ? ))              (while (eq (char-after) ? )
1165                (backward-char))                (backward-char))
1166              (setq folder (buffer-substring-no-properties              (setq folder (buffer-substring-no-properties
1167                            (point-min) (1+ (point))))                            (point-min) (1+ (point))))
1168                (when (and (equal (aref folder (1- (length folder))) ?+)
1169                           (equal current-folder folder))
1170                  (setq folder (substring folder 0 (1- (length folder)))))
1171              (values (format "+%s" folder) (car unseen) (car total))))))))              (values (format "+%s" folder) (car unseen) (car total))))))))
1172    
1173  (defun mh-folder-size (folder)  (defun mh-folder-size (folder)
1174    "Find size of FOLDER."    "Find size of FOLDER."
1175    (with-temp-buffer    (with-temp-buffer
1176      (call-process (expand-file-name "flist" mh-progs) nil t nil      (call-process (expand-file-name "flist" mh-progs) nil t nil
1177                    "-norecurse" folder)                    "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
1178      (goto-char (point-min))      (goto-char (point-min))
1179      (multiple-value-bind (folder1 unseen total)      (multiple-value-bind (folder1 unseen total)
1180          (mh-parse-flist-output-line          (mh-parse-flist-output-line
1181           (buffer-substring (point) (line-end-position)))           (buffer-substring (point) (line-end-position)))
       (unless (equal folder folder1)  
         (error "Call to flist failed on folder %s" folder))  
1182        (values total unseen))))        (values total unseen))))
1183    
1184  (defun mh-visit-folder (folder &optional range index-data)  (defun mh-visit-folder (folder &optional range index-data)
# Line 1123  If RANGE is nil (the default if it is om Line 1189  If RANGE is nil (the default if it is om
1189  then all messages in FOLDER are displayed.  then all messages in FOLDER are displayed.
1190    
1191  If an index buffer is being created then INDEX-DATA is used to initialize the  If an index buffer is being created then INDEX-DATA is used to initialize the
1192  index buffer specific data structures."  index buffer specific data structures.
1193    
1194    A prefix argument will cause a prompt for the RANGE of messages
1195    regardless of the size of the `mh-large-folder' variable."
1196    (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))    (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
1197                   (list folder-name (mh-read-msg-range folder-name))))                   (list folder-name
1198                           (mh-read-msg-range folder-name current-prefix-arg))))
1199    (let ((config (current-window-configuration))    (let ((config (current-window-configuration))
1200          (threaded-view-flag mh-show-threads-flag))          (threaded-view-flag mh-show-threads-flag))
1201      (save-excursion      (save-excursion
# Line 1171  Flush MH-E's state out to MH. The messag Line 1241  Flush MH-E's state out to MH. The messag
1241            (mh-define-sequence 'cur (list new-cur))            (mh-define-sequence 'cur (list new-cur))
1242            (beginning-of-line)            (beginning-of-line)
1243            (if (looking-at mh-scan-good-msg-regexp)            (if (looking-at mh-scan-good-msg-regexp)
1244                (mh-notate nil mh-note-cur mh-cmd-note)))                (mh-notate-cur)))
1245        (or folder-set        (or folder-set
1246            (save-excursion            (save-excursion
1247              ;; psg - mh-current-folder is nil if mh-summary-height < 4 !              ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
# Line 1186  Flush MH-E's state out to MH. The messag Line 1256  Flush MH-E's state out to MH. The messag
1256    
1257  (defun mh-delete-a-msg (msg)  (defun mh-delete-a-msg (msg)
1258    "Delete the MSG.    "Delete the MSG.
1259    If MSG is nil then the message at point is deleted.
1260    
1261  The value of `mh-delete-msg-hook' is a list of functions to be called, with no  The value of `mh-delete-msg-hook' is a list of functions to be called, with no
1262  arguments, after the message has been deleted."  arguments, after the message has been deleted."
1263    (save-excursion    (save-excursion
1264      (mh-goto-msg msg nil t)      (if (numberp msg)
1265            (mh-goto-msg msg nil t)
1266          (beginning-of-line)
1267          (setq msg (mh-get-msg-num t)))
1268      (if (looking-at mh-scan-refiled-msg-regexp)      (if (looking-at mh-scan-refiled-msg-regexp)
1269          (error "Message %d is refiled.  Undo refile before deleting" msg))          (error "Message %d is refiled.  Undo refile before deleting" msg))
1270      (if (looking-at mh-scan-deleted-msg-regexp)      (if (looking-at mh-scan-deleted-msg-regexp)
1271          nil          nil
1272        (mh-set-folder-modified-p t)        (mh-set-folder-modified-p t)
1273        (setq mh-delete-list (cons msg mh-delete-list))        (setq mh-delete-list (cons msg mh-delete-list))
1274        (mh-notate msg mh-note-deleted mh-cmd-note)        (mh-notate nil mh-note-deleted mh-cmd-note)
1275        (run-hooks 'mh-delete-msg-hook))))        (run-hooks 'mh-delete-msg-hook))))
1276    
1277  (defun mh-refile-a-msg (msg folder)  (defun mh-refile-a-msg (msg folder)
1278    "Refile MSG in FOLDER.    "Refile MSG in FOLDER.
1279    If MSG is nil then the message at point is refiled.
1280    
1281  Folder is a symbol, not a string.  Folder is a symbol, not a string.
1282  The value of `mh-refile-msg-hook' is a list of functions to be called, with no  The value of `mh-refile-msg-hook' is a list of functions to be called, with no
1283  arguments, after the message has been refiled."  arguments, after the message has been refiled."
1284    (save-excursion    (save-excursion
1285      (mh-goto-msg msg nil t)      (if (numberp msg)
1286            (mh-goto-msg msg nil t)
1287          (beginning-of-line)
1288          (setq msg (mh-get-msg-num t)))
1289      (cond ((looking-at mh-scan-deleted-msg-regexp)      (cond ((looking-at mh-scan-deleted-msg-regexp)
1290             (error "Message %d is deleted.  Undo delete before moving" msg))             (error "Message %d is deleted.  Undo delete before moving" msg))
1291            ((looking-at mh-scan-refiled-msg-regexp)            ((looking-at mh-scan-refiled-msg-regexp)
# Line 1222  arguments, after the message has been re Line 1302  arguments, after the message has been re
1302                    (push (list folder msg) mh-refile-list))                    (push (list folder msg) mh-refile-list))
1303                   ((not (member msg (cdr (assoc folder mh-refile-list))))                   ((not (member msg (cdr (assoc folder mh-refile-list))))
1304                    (push msg (cdr (assoc folder mh-refile-list)))))                    (push msg (cdr (assoc folder mh-refile-list)))))
1305             (mh-notate msg mh-note-refiled mh-cmd-note)             (mh-notate nil mh-note-refiled mh-cmd-note)
1306             (run-hooks 'mh-refile-msg-hook)))))             (run-hooks 'mh-refile-msg-hook)))))
1307    
1308  (defun mh-next-msg ()  (defun mh-next-msg ()
# Line 1271  With optional argument COUNT, COUNT-1 un Line 1351  With optional argument COUNT, COUNT-1 un
1351        (mh-recenter nil)))        (mh-recenter nil)))
1352    
1353  (defun mh-undo-msg (msg)  (defun mh-undo-msg (msg)
1354    "Undo the deletion or refile of one MSG."    "Undo the deletion or refile of one MSG.
1355    (cond ((memq msg mh-delete-list)  If MSG is nil then act on the message at point"
1356           (setq mh-delete-list (delq msg mh-delete-list)))    (save-excursion
1357          (t      (if (numberp msg)
1358           (dolist (folder-msg-list mh-refile-list)          (mh-goto-msg msg t t)
1359             (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))        (beginning-of-line)
1360           (setq mh-refile-list (loop for x in mh-refile-list        (setq msg (mh-get-msg-num t)))
1361                                      unless (null (cdr x)) collect x))))      (cond ((memq msg mh-delete-list)
1362    (mh-notate msg ?  mh-cmd-note))             (setq mh-delete-list (delq msg mh-delete-list)))
1363              (t
1364               (dolist (folder-msg-list mh-refile-list)
1365                 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
1366               (setq mh-refile-list (loop for x in mh-refile-list
1367                                          unless (null (cdr x)) collect x))))
1368        (mh-notate nil ?  mh-cmd-note)))
1369    
1370    
1371    
# Line 1423  When a folder is visited, the hook `mh-f Line 1509  When a folder is visited, the hook `mh-f
1509     'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs     'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
1510     'mh-folder-filename                  ; e.g. "/usr/foobar/Mail/inbox/"     'mh-folder-filename                  ; e.g. "/usr/foobar/Mail/inbox/"
1511     (file-name-as-directory (mh-expand-file-name (buffer-name)))     (file-name-as-directory (mh-expand-file-name (buffer-name)))
1512       'mh-arrow-marker (make-marker)       ; Marker where arrow is displayed
1513       'overlay-arrow-position nil          ; Allow for simultaneous display in
1514       'overlay-arrow-string ">"            ;  different MH-E buffers.
1515     'mh-showing-mode nil                 ; Show message also?     'mh-showing-mode nil                 ; Show message also?
1516     'mh-delete-list nil                  ; List of msgs nums to delete     'mh-delete-list nil                  ; List of msgs nums to delete
1517     'mh-refile-list nil                  ; List of folder names in mh-seq-list     'mh-refile-list nil                  ; List of folder names in mh-seq-list
# Line 1489  Return in the folder's buffer." Line 1578  Return in the folder's buffer."
1578            (message "Folder %s is empty" folder)            (message "Folder %s is empty" folder)
1579          (message "No messages in %s, range %s" folder range))          (message "No messages in %s, range %s" folder range))
1580      (mh-goto-cur-msg))      (mh-goto-cur-msg))
1581    (save-excursion    (when dont-exec-pending
1582      (when dont-exec-pending      (mh-notate-deleted-and-refiled)))
       ;; Re-annotate messages to be refiled...  
       (dolist (folder-msg-list mh-refile-list)  
         (dolist (msg (cdr folder-msg-list))  
           (mh-notate msg mh-note-refiled mh-cmd-note)))  
       ;; Re-annotate messages to be deleted...  
       (dolist (msg mh-delete-list)  
         (mh-notate msg mh-note-deleted mh-cmd-note)))))  
1583    
1584  (defun mh-set-cmd-note (width)  (defun mh-set-cmd-note (width)
1585    "Set `mh-cmd-note' to WIDTH characters (minimum of 2).    "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
# Line 1655  Return in the current buffer." Line 1737  Return in the current buffer."
1737          (keep-lines mh-scan-valid-regexp) ; Flush random scan lines          (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
1738          (setq mh-seq-list (mh-read-folder-sequences folder t))          (setq mh-seq-list (mh-read-folder-sequences folder t))
1739          (when (equal (point-max) start-of-inc)          (when (equal (point-max) start-of-inc)
1740            (mh-notate-seq 'cur mh-note-cur mh-cmd-note))            (mh-notate-cur))
1741          (mh-notate-user-sequences)          (mh-notate-user-sequences)
1742          (if new-mail-flag          (if new-mail-flag
1743              (progn              (progn
# Line 1689  in what is now stored in the buffer-loca Line 1771  in what is now stored in the buffer-loca
1771                               (count-lines (point-min) (point-max))                               (count-lines (point-min) (point-max))
1772                             0))                             0))
1773        (setq mode-line-buffer-identification        (setq mode-line-buffer-identification
1774              (list (format "{%%b%s} %s msg%s"              (list (format "    {%%b%s} %s msg%s"
1775                            (if mh-mode-line-annotation                            (if mh-mode-line-annotation
1776                                (format "/%s" mh-mode-line-annotation)                                (format "/%s" mh-mode-line-annotation)
1777                              "")                              "")
# Line 1703  in what is now stored in the buffer-loca Line 1785  in what is now stored in the buffer-loca
1785                                             mh-last-msg-num))                                             mh-last-msg-num))
1786                                    (mh-first-msg-num                                    (mh-first-msg-num
1787                                     (format " (%d)" mh-first-msg-num))                                     (format " (%d)" mh-first-msg-num))
1788                                    ("")))))))))                                    (""))))))
1789          (mh-logo-display))))
1790    
1791  (defun mh-unmark-all-headers (remove-all-flags)  (defun mh-unmark-all-headers (remove-all-flags)
1792    "Remove all '+' flags from the folder listing.    "Remove all '+' flags from the folder listing.
# Line 1737  Optimized for speed (i.e., no regular ex Line 1820  Optimized for speed (i.e., no regular ex
1820    "Remove old cur notation."    "Remove old cur notation."
1821    (let ((cur-msg (car (mh-seq-to-msgs 'cur))))    (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1822      (save-excursion      (save-excursion
1823        (and cur-msg        (when (and cur-msg
1824             (mh-goto-msg cur-msg t t)                   (mh-goto-msg cur-msg t t)
1825             (looking-at mh-scan-cur-msg-number-regexp)                   (looking-at mh-scan-cur-msg-number-regexp))
1826             (mh-notate nil ?  mh-cmd-note)))))          (mh-notate nil ?  mh-cmd-note)
1827            (setq overlay-arrow-position nil)))))
1828    
1829  (defun mh-remove-all-notation ()  (defun mh-remove-all-notation ()
1830    "Remove all notations on all scan lines that MH-E introduces."    "Remove all notations on all scan lines that MH-E introduces."
1831    (save-excursion    (save-excursion
1832        (setq overlay-arrow-position nil)
1833      (goto-char (point-min))      (goto-char (point-min))
1834      (while (not (eobp))      (while (not (eobp))
1835        (unless (or (equal (char-after) ?+) (eolp))        (unless (or (equal (char-after) ?+) (eolp))
# Line 1762  recenter the folder buffer." Line 1847  recenter the folder buffer."
1847      (cond ((and cur-msg      (cond ((and cur-msg
1848                  (mh-goto-msg cur-msg t t))                  (mh-goto-msg cur-msg t t))
1849             (unless minimal-changes-flag             (unless minimal-changes-flag
1850               (mh-notate nil mh-note-cur mh-cmd-note)               (mh-notate-cur)
1851               (mh-recenter 0)               (mh-recenter 0)
1852               (mh-maybe-show cur-msg)))               (mh-maybe-show cur-msg)))
1853            (t            (t
1854               (setq overlay-arrow-position nil)
1855             (message "No current message")))))             (message "No current message")))))
1856    
1857  (defun mh-process-or-undo-commands (folder)  (defun mh-process-or-undo-commands (folder)
# Line 1976  Expands ranges into set of individual nu Line 2062  Expands ranges into set of individual nu
2062  (defun mh-notate-user-sequences ()  (defun mh-notate-user-sequences ()
2063    "Mark the scan listing of all messages in user-defined sequences."    "Mark the scan listing of all messages in user-defined sequences."
2064    (let ((seqs mh-seq-list)    (let ((seqs mh-seq-list)
2065          name)          (msg-hash (make-hash-table)))
2066      (while seqs      (dolist (seq seqs)
2067        (setq name (mh-seq-name (car seqs)))        (unless (mh-internal-seq (mh-seq-name seq))
2068        (if (not (mh-internal-seq name))          (dolist (msg (mh-seq-msgs seq))
2069            (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))            (setf (gethash msg msg-hash) t))))
2070        (setq seqs (cdr seqs)))))      (mh-iterate-on-messages-in-region msg (point-min) (point-max)
2071          (when (gethash msg msg-hash)
2072            (mh-notate nil mh-note-seq (1+ mh-cmd-note))))))
2073    
2074  (defun mh-internal-seq (name)  (defun mh-internal-seq (name)
2075    "Return non-nil if NAME is the name of an internal MH-E sequence."    "Return non-nil if NAME is the name of an internal MH-E sequence."

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26