/[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.2.4.4 by miles, Tue Apr 27 14:11:00 2004 UTC revision 1.2.4.5 by miles, Sat Jul 17 02:51:48 2004 UTC
# Line 1  Line 1 
1  ;;; mh-e.el --- GNU Emacs interface to the MH mail system  ;;; mh-e.el --- GNU Emacs interface to the MH mail system
2    
3  ;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999,  ;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999,
4  ;;  2000, 01, 02, 2003 Free Software Foundation, Inc.  ;;  2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
5    
6  ;; Author: Bill Wohler <wohler@newt.com>  ;; Author: Bill Wohler <wohler@newt.com>
7  ;; Maintainer: Bill Wohler <wohler@newt.com>  ;; Maintainer: Bill Wohler <wohler@newt.com>
8  ;; Version: 7.3  ;; Version: 7.4.4
9  ;; Keywords: mail  ;; Keywords: mail
10    
11  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 82  Line 82 
82    
83  ;;; Code:  ;;; Code:
84    
85  (require 'cl)  (provide 'mh-e)
86    (require 'mh-utils)
87    (mh-require-cl)
88    
89  (defvar recursive-load-depth-limit)  (defvar recursive-load-depth-limit)
90  (eval-when (compile load eval)  (eval-when (compile load eval)
# Line 92  Line 94 
94        (setq recursive-load-depth-limit 50)))        (setq recursive-load-depth-limit 50)))
95    
96  (require 'mh-inc)  (require 'mh-inc)
 (require 'mh-utils)  
97  (require 'gnus-util)  (require 'gnus-util)
98  (require 'easymenu)  (require 'easymenu)
 (if mh-xemacs-flag  
     (require 'mh-xemacs-compat))  
99    
100  ;; Shush the byte-compiler  ;; Shush the byte-compiler
101  (defvar font-lock-auto-fontify)  (defvar font-lock-auto-fontify)
102  (defvar font-lock-defaults)  (defvar font-lock-defaults)
103    
104  (defconst mh-version "7.3" "Version number of MH-E.")  (defconst mh-version "7.4.4" "Version number of MH-E.")
105    
106  ;;; Autoloads  ;;; Autoloads
107  (autoload 'Info-goto-node "info")  (autoload 'Info-goto-node "info")
# Line 283  third should match the user name.") Line 282  third should match the user name.")
282           '(3 mh-folder-scan-format-face))           '(3 mh-folder-scan-format-face))
283     ;; Current message line     ;; Current message line
284     (list mh-scan-cur-msg-regexp     (list mh-scan-cur-msg-regexp
285           '(1 mh-folder-cur-msg-face prepend t))           '(1 mh-folder-cur-msg-face prepend t)))
    ;; Unseen messages in bold  
    '(mh-folder-font-lock-unseen (1 'bold append t)))  
286    "Regexp keywords used to fontify the MH-Folder buffer.")    "Regexp keywords used to fontify the MH-Folder buffer.")
287    
288  (defvar mh-scan-cmd-note-width 1  (defvar mh-scan-cmd-note-width 1
# Line 399  On nmh systems.") Line 396  On nmh systems.")
396                  (goto-char (point-min))                  (goto-char (point-min))
397                  (sort (mh-read-msg-list) '<)))))))))                  (sort (mh-read-msg-list) '<)))))))))
398    
399  (defvar mh-folder-unseen-seq-cache nil  (defmacro mh-generate-sequence-font-lock (seq prefix face)
400    "Internal cache variable used for font-lock in MH-E.    "Generate the appropriate code to fontify messages in SEQ.
401    PREFIX is used to generate unique names for the variables and functions
402    defined by the macro. So a different prefix should be provided for every
403    invocation.
404    FACE is the font-lock face used to display the matching scan lines."
405      (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
406            (func (intern (format "mh-folder-font-lock-%s" prefix))))
407        `(progn
408           (defvar ,cache nil
409             "Internal cache variable used for font-lock in MH-E.
410  Should only be non-nil through font-lock stepping, and nil once font-lock  Should only be non-nil through font-lock stepping, and nil once font-lock
411  is done highlighting.")  is done highlighting.")
412  (make-variable-buffer-local 'mh-folder-unseen-seq-cache)         (make-variable-buffer-local ',cache)
413    
414           (defun ,func (limit)
415             "Return unseen message lines to font-lock between point and LIMIT."
416             (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
417             (let ((cur-msg (mh-get-msg-num nil)))
418               (cond ((not ,cache)
419                      nil)
420                     ((>= (point) limit)              ;Presumably at end of buffer
421                      (setq ,cache nil)
422                      nil)
423                     ((member cur-msg ,cache)
424                      (let ((bpoint (progn (beginning-of-line)(point)))
425                            (epoint (progn (forward-line 1)(point))))
426                        (if (<= limit (point)) (setq  ,cache nil))
427                        (set-match-data (list bpoint epoint bpoint epoint))
428                        t))
429                     (t
430                      ;; move forward one line at a time, checking each message
431                      (while (and (= 0 (forward-line 1))
432                                  (> limit (point))
433                                  (not (member (mh-get-msg-num nil) ,cache))))
434                      ;; Examine how we must have exited the loop...
435                      (let ((cur-msg (mh-get-msg-num nil)))
436                        (cond ((or (<= limit (point))
437                                   (not (member cur-msg ,cache)))
438                               (setq ,cache nil)
439                               nil)
440                              ((member cur-msg ,cache)
441                               (let ((bpoint (progn (beginning-of-line) (point)))
442                                     (epoint (progn (forward-line 1) (point))))
443                                 (if (<= limit (point)) (setq ,cache nil))
444                                 (set-match-data
445                                  (list bpoint epoint bpoint epoint))
446                                 t))))))))
447    
448           (setq mh-folder-font-lock-keywords
449                 (append mh-folder-font-lock-keywords
450                         (list (list ',func (list 1 '',face 'prepend t))))))))
451    
452  (defun mh-folder-font-lock-unseen (limit)  (mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
453    "Return unseen message lines to font-lock between point and LIMIT."  (mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick-face)
   (if (not mh-folder-unseen-seq-cache)  
       (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))  
   (let ((cur-msg (mh-get-msg-num nil)))  
     (cond  
      ((not mh-folder-unseen-seq-cache)  
       nil)  
      ((>= (point) limit)                 ;Presumably at end of buffer  
       (setq mh-folder-unseen-seq-cache nil)  
       nil)  
      ((member cur-msg mh-folder-unseen-seq-cache)  
       (let ((bpoint (progn (beginning-of-line)(point)))  
             (epoint (progn (forward-line 1)(point))))  
         (if (<= limit (point))  
             (setq  mh-folder-unseen-seq-cache nil))  
         (set-match-data (list bpoint epoint bpoint epoint))  
         t))  
      (t  
       ;; move forward one line at a time, checking each message number.  
       (while (and  
               (= 0 (forward-line 1))  
               (> limit (point))  
               (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))  
       ;; Examine how we must have exited the loop...  
       (let ((cur-msg (mh-get-msg-num nil)))  
         (cond  
          ((or (<= limit (point))  
               (not (member cur-msg mh-folder-unseen-seq-cache)))  
           (setq mh-folder-unseen-seq-cache nil)  
           nil)  
          ((member cur-msg mh-folder-unseen-seq-cache)  
           (let ((bpoint (progn (beginning-of-line)(point)))  
                 (epoint (progn (forward-line 1)(point))))  
             (if (<= limit (point))  
                 (setq  mh-folder-unseen-seq-cache nil))  
             (set-match-data (list bpoint epoint bpoint epoint))  
             t))))))))  
454    
455    
456    
# Line 464  is done highlighting.") Line 472  is done highlighting.")
472    
473  (defvar mh-next-direction 'forward)     ;Direction to move to next message.  (defvar mh-next-direction 'forward)     ;Direction to move to next message.
474    
 (defvar mh-narrowed-to-seq nil)         ;Sequence display is narrowed to or  
                                         ;nil if not narrowed.  
   
 (defvar mh-tick-seq-changed-when-narrowed-flag nil)  
                                         ;Has tick sequence changed while the  
                                         ;folder was narrowed to it?  
   
475  (defvar mh-view-ops ())                 ;Stack of ops that change the folder  (defvar mh-view-ops ())                 ;Stack of ops that change the folder
476                                          ;view (such as narrowing or threading).                                          ;view (such as narrowing or threading).
477    (defvar mh-folder-view-stack ())        ;Stack of previous folder views.
478    
479  (defvar mh-index-data nil)              ;Info about index search results  (defvar mh-index-data nil)              ;Info about index search results
480  (defvar mh-index-previous-search nil)  (defvar mh-index-previous-search nil)
481  (defvar mh-index-msg-checksum-map nil)  (defvar mh-index-msg-checksum-map nil)
482  (defvar mh-index-checksum-origin-map nil)  (defvar mh-index-checksum-origin-map nil)
483    (defvar mh-index-sequence-search-flag nil)
484    
485  (defvar mh-first-msg-num nil)           ;Number of first msg in buffer.  (defvar mh-first-msg-num nil)           ;Number of first msg in buffer.
486    
# Line 485  is done highlighting.") Line 488  is done highlighting.")
488    
489  (defvar mh-mode-line-annotation nil)    ;Message range displayed in buffer.  (defvar mh-mode-line-annotation nil)    ;Message range displayed in buffer.
490    
491    (defvar mh-sequence-notation-history nil)
492                                            ;Rememeber original notation that
493                                            ;is overwritten by `mh-note-seq'.
494    
495  ;;; Macros and generic functions:  ;;; Macros and generic functions:
496    
497  (defun mh-mapc (function list)  (defun mh-mapc (function list)
# Line 494  is done highlighting.") Line 501  is done highlighting.")
501      (setq list (cdr list))))      (setq list (cdr list))))
502    
503  (defun mh-scan-format ()  (defun mh-scan-format ()
504    "Return \"-format\" argument for the scan program."    "Return the output format argument for the scan program."
505    (if (equal mh-scan-format-file t)    (if (equal mh-scan-format-file t)
506        (list "-format" (if mh-nmh-flag        (list "-format" (if mh-nmh-flag
507                            (list (mh-update-scan-format                            (list (mh-update-scan-format
# Line 502  is done highlighting.") Line 509  is done highlighting.")
509                          (list (mh-update-scan-format                          (list (mh-update-scan-format
510                                 mh-scan-format-mh mh-cmd-note))))                                 mh-scan-format-mh mh-cmd-note))))
511      (if (not (equal mh-scan-format-file nil))      (if (not (equal mh-scan-format-file nil))
512          (list "-format" mh-scan-format-file))))          (list "-form" mh-scan-format-file))))
513    
514    
515    
# Line 536  the Emacs front end to the MH mail syste Line 543  the Emacs front end to the MH mail syste
543    
544  ;;; User executable MH-E commands:  ;;; User executable MH-E commands:
545    
546  (defun mh-delete-msg (msg-or-seq)  (defun mh-delete-msg (range)
547    "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.    "Mark the specified RANGE for subsequent deletion and move to the next.
548  Default is the displayed message.  Default is the displayed message.
 If optional prefix argument is provided, then prompt for the message sequence.  
 If variable `transient-mark-mode' is non-nil and the mark is active, then the  
 selected region is marked for deletion.  
 In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a  
 region in a cons cell, or a sequence."  
   (interactive (list (mh-interactive-msg-or-seq "Delete")))  
   (mh-delete-msg-no-motion msg-or-seq)  
   (mh-next-msg))  
549    
550  (defun mh-delete-msg-no-motion (msg-or-seq)  Check the documentation of `mh-interactive-range' to see how RANGE is read in
551    "Mark the specified MSG-OR-SEQ for subsequent deletion.  interactive use."
552  Default is the displayed message.    (interactive (list (mh-interactive-range "Delete")))
553  If optional prefix argument is provided, then prompt for the message sequence.    (mh-delete-msg-no-motion range)
554  If variable `transient-mark-mode' is non-nil and the mark is active, then the    (if (looking-at mh-scan-deleted-msg-regexp) (mh-next-msg)))
555  selected region is marked for deletion.  
556  In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a  (defun mh-delete-msg-no-motion (range)
557  region in a cons cell, or a sequence."    "Mark the specified RANGE for subsequent deletion.
558    (interactive (list (mh-interactive-msg-or-seq "Delete")))  
559    (mh-iterate-on-msg-or-seq () msg-or-seq  Check the documentation of `mh-interactive-range' to see how RANGE is read in
560    interactive use."
561      (interactive (list (mh-interactive-range "Delete")))
562      (mh-iterate-on-range () range
563      (mh-delete-a-msg nil)))      (mh-delete-a-msg nil)))
564    
565  (defun mh-execute-commands ()  (defun mh-execute-commands ()
566    "Process outstanding delete and refile requests."    "Process outstanding delete and refile requests."
567    (interactive)    (interactive)
568    (if mh-narrowed-to-seq (mh-widen))    (if mh-folder-view-stack (mh-widen t))
569    (mh-process-commands mh-current-folder)    (mh-process-commands mh-current-folder)
570    (mh-set-scan-mode)    (mh-set-scan-mode)
571    (mh-goto-cur-msg)                    ; after mh-set-scan-mode for efficiency    (mh-goto-cur-msg)                    ; after mh-set-scan-mode for efficiency
# Line 626  Do not call this function from outside M Line 628  Do not call this function from outside M
628                 (save-excursion                 (save-excursion
629                   (goto-char (point-min))                   (goto-char (point-min))
630                   (or (null mh-large-folder)                   (or (null mh-large-folder)
631                       (not (equal (forward-line mh-large-folder) 0))                       (not (equal (forward-line (1+ mh-large-folder)) 0))
632                       (and (message "Not threading since the number of messages exceeds `mh-large-folder'")                       (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
633                            nil))))                            nil))))
634        (mh-toggle-threads))        (mh-toggle-threads))
# Line 673  Takes the address in the From: header fi Line 675  Takes the address in the From: header fi
675  Returns nil if the address was not found in either place or if the variable  Returns nil if the address was not found in either place or if the variable
676  `mh-default-folder-must-exist-flag' is nil and the folder does not exist."  `mh-default-folder-must-exist-flag' is nil and the folder does not exist."
677    ;; Loop for all entries in mh-default-folder-list    ;; Loop for all entries in mh-default-folder-list
678    (save-excursion    (save-restriction
679      (let ((folder-name      (goto-char (point-min))
680             (car      (re-search-forward "\n\n" nil t)
681              (delq nil      (narrow-to-region (point-min) (point))
682                    (mapcar      (let ((to/cc (concat (or (message-fetch-field "to") "") ", "
683                     (lambda (list)                           (or (message-fetch-field "cc") "")))
684                       (let ((address-regexp (nth 0 list))            (from (or (message-fetch-field "from") ""))
685                             (folder (nth 1 list))            folder-name)
686                             (to-flag (nth 2 list)))        (setq folder-name
687                         (when (or              (loop for list in mh-default-folder-list
688                                (mh-goto-header-field (if to-flag "To:" "From:"))                    when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
689                                ; if the To: field is missing, try Cc:                    return (nth 1 list)
690                                (and to-flag (mh-goto-header-field "cc:")))                    finally return nil))
                          (let ((endfield (save-excursion  
                                            (mh-header-field-end)(point))))  
                            (if (re-search-forward address-regexp endfield t)  
                                folder  
                              (when to-flag ;Try Cc: as well  
                                (mh-goto-header-field "cc:")  
                                (let ((endfield (save-excursion  
                                                  (mh-header-field-end)(point))))  
                                  (when (re-search-forward  
                                         address-regexp endfield t)  
                                    folder))))))))  
                    mh-default-folder-list)))))  
691    
692        ;; Make sure a result from `mh-default-folder-list' begins with "+"        ;; Make sure a result from `mh-default-folder-list' begins with "+"
693        ;; since 'mh-expand-file-name below depends on it        ;; since 'mh-expand-file-name below depends on it
# Line 746  Otherwise, a default folder name is gene Line 736  Otherwise, a default folder name is gene
736             "")))             "")))
737     t))     t))
738    
739  (defun mh-refile-msg (msg-or-seq folder  (defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
740                        &optional dont-update-last-destination-flag)    "Refile RANGE into FOLDER.
741    "Refile MSG-OR-SEQ into FOLDER.  
742  Default is the displayed message.  Check the documentation of `mh-interactive-range' to see how RANGE is read in
743  If optional prefix argument is provided, then prompt for the message sequence.  interactive use.
 If variable `transient-mark-mode' is non-nil and the mark is active, then the  
 selected region is marked for refiling.  
 In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a  
 region in a cons cell, or a sequence.  
744    
745  If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the  If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the
746  variables `mh-last-destination' and `mh-last-destination-folder' are not  variables `mh-last-destination' and `mh-last-destination-folder' are not
747  updated."  updated."
748    (interactive (list (mh-interactive-msg-or-seq "Refile")    (interactive (list (mh-interactive-range "Refile")
749                       (intern (mh-prompt-for-refile-folder))))                       (intern (mh-prompt-for-refile-folder))))
750    (unless dont-update-last-destination-flag    (unless dont-update-last-destination-flag
751      (setq mh-last-destination (cons 'refile folder)      (setq mh-last-destination (cons 'refile folder)
752            mh-last-destination-folder mh-last-destination))            mh-last-destination-folder mh-last-destination))
753    (mh-iterate-on-msg-or-seq () msg-or-seq    (mh-iterate-on-range () range
754      (mh-refile-a-msg nil folder))      (mh-refile-a-msg nil folder))
755    (mh-next-msg))    (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
756    
757  (defun mh-refile-or-write-again (message)  (defun mh-refile-or-write-again (message)
758    "Re-execute the last refile or write command on the given MESSAGE.    "Re-execute the last refile or write command on the given MESSAGE.
# Line 1015  end of buffer is reached) and save it." Line 1001  end of buffer is reached) and save it."
1001    (when (consp part-index) (setq part-index (car part-index)))    (when (consp part-index) (setq part-index (car part-index)))
1002    (mh-folder-mime-action part-index #'mh-mime-save-part nil))    (mh-folder-mime-action part-index #'mh-mime-save-part nil))
1003    
1004    (defvar mh-thread-scan-line-map-stack)
1005    
1006  (defun mh-reset-threads-and-narrowing ()  (defun mh-reset-threads-and-narrowing ()
1007    "Reset all variables pertaining to threads and narrowing.    "Reset all variables pertaining to threads and narrowing.
1008  Also removes all content from the folder buffer."  Also removes all content from the folder buffer."
1009    (setq mh-view-ops ())    (setq mh-view-ops ())
1010    (setq mh-narrowed-to-seq nil)    (setq mh-folder-view-stack ())
1011      (setq mh-thread-scan-line-map-stack ())
1012    (let ((buffer-read-only nil)) (erase-buffer)))    (let ((buffer-read-only nil)) (erase-buffer)))
1013    
1014  (defun mh-rescan-folder (&optional range dont-exec-pending)  (defun mh-rescan-folder (&optional range dont-exec-pending)
# Line 1029  messages to display. Otherwise show the Line 1018  messages to display. Otherwise show the
1018  If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and  If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1019  refiles aren't carried out."  refiles aren't carried out."
1020    (interactive (list (if current-prefix-arg    (interactive (list (if current-prefix-arg
1021                           (mh-read-msg-range mh-current-folder t)                           (mh-read-range "Rescan" mh-current-folder t nil t
1022                                            mh-interpret-number-as-range-flag)
1023                         nil)))                         nil)))
1024    (setq mh-next-direction 'forward)    (setq mh-next-direction 'forward)
1025    (let ((threaded-flag (memq 'unthread mh-view-ops)))    (let ((threaded-flag (memq 'unthread mh-view-ops)))
# Line 1073  Otherwise send the entire message includ Line 1063  Otherwise send the entire message includ
1063        (mh-set-scan-mode)        (mh-set-scan-mode)
1064      (mh-show)))      (mh-show)))
1065    
1066  (defun mh-undo (msg-or-seq)  (defun mh-undo (range)
1067    "Undo the pending deletion or refile of the specified MSG-OR-SEQ.    "Undo the pending deletion or refile of the specified RANGE.
1068  Default is the displayed message.  
1069  If optional prefix argument is provided, then prompt for the message sequence.  Check the documentation of `mh-interactive-range' to see how RANGE is read in
1070  If variable `transient-mark-mode' is non-nil and the mark is active, then the  interactive use."
1071  selected region is unmarked.    (interactive (list (mh-interactive-range "Undo")))
1072  In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a    (cond ((numberp range)
 region in a cons cell, or a sequence."  
   (interactive (list (mh-interactive-msg-or-seq "Undo")))  
   (cond ((numberp msg-or-seq)  
1073           (let ((original-position (point)))           (let ((original-position (point)))
1074             (beginning-of-line)             (beginning-of-line)
1075             (while (not (or (looking-at mh-scan-deleted-msg-regexp)             (while (not (or (looking-at mh-scan-deleted-msg-regexp)
# Line 1098  region in a cons cell, or a sequence." Line 1085  region in a cons cell, or a sequence."
1085                   (mh-maybe-show))                   (mh-maybe-show))
1086               (goto-char original-position)               (goto-char original-position)
1087               (error "Nothing to undo"))))               (error "Nothing to undo"))))
1088          (t (mh-iterate-on-msg-or-seq () msg-or-seq          (t (mh-iterate-on-range () range
1089               (mh-undo-msg nil))))               (mh-undo-msg nil))))
1090    (if (not (mh-outstanding-commands-p))    (if (not (mh-outstanding-commands-p))
1091        (mh-set-folder-modified-p nil)))        (mh-set-folder-modified-p nil)))
# Line 1200  used to avoid problems in corner cases i Line 1187  used to avoid problems in corner cases i
1187                (setq folder (substring folder 0 (1- (length folder)))))                (setq folder (substring folder 0 (1- (length folder)))))
1188              (values (format "+%s" folder) (car unseen) (car total))))))))              (values (format "+%s" folder) (car unseen) (car total))))))))
1189    
1190  (defun mh-folder-size (folder)  (defun mh-folder-size-folder (folder)
1191    "Find size of FOLDER."    "Find size of FOLDER using `folder'."
1192      (with-temp-buffer
1193        (let ((u (length (cdr (assoc mh-unseen-seq
1194                                     (mh-read-folder-sequences folder nil))))))
1195          (call-process (expand-file-name "folder" mh-progs) nil t nil
1196                        "-norecurse" folder)
1197          (goto-char (point-min))
1198          (if (re-search-forward " has \\([0-9]+\\) " nil t)
1199              (values (car (read-from-string (match-string 1))) u folder)
1200            (values 0 u folder)))))
1201    
1202    (defun mh-folder-size-flist (folder)
1203      "Find size of FOLDER using `flist'."
1204    (with-temp-buffer    (with-temp-buffer
1205      (call-process (expand-file-name "flist" mh-progs) nil t nil      (call-process (expand-file-name "flist" mh-progs) nil t nil
1206                    "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))                    "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
# Line 1211  used to avoid problems in corner cases i Line 1210  used to avoid problems in corner cases i
1210           (buffer-substring (point) (line-end-position)))           (buffer-substring (point) (line-end-position)))
1211        (values total unseen folder))))        (values total unseen folder))))
1212    
1213    (defun mh-folder-size (folder)
1214      "Find size of FOLDER."
1215      (if mh-flists-present-flag
1216          (mh-folder-size-flist folder)
1217        (mh-folder-size-folder folder)))
1218    
1219  (defun mh-visit-folder (folder &optional range index-data)  (defun mh-visit-folder (folder &optional range index-data)
1220    "Visit FOLDER and display RANGE of messages.    "Visit FOLDER and display RANGE of messages.
1221  Do not call this function from outside MH-E; see \\[mh-rmail] instead.  Do not call this function from outside MH-E; see \\[mh-rmail] instead.
# Line 1225  A prefix argument will cause a prompt fo Line 1230  A prefix argument will cause a prompt fo
1230  regardless of the size of the `mh-large-folder' variable."  regardless of the size of the `mh-large-folder' variable."
1231    (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))    (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
1232                   (list folder-name                   (list folder-name
1233                         (mh-read-msg-range folder-name current-prefix-arg))))                         (mh-read-range "Scan" folder-name t nil
1234                                          current-prefix-arg
1235                                          mh-interpret-number-as-range-flag))))
1236    (let ((config (current-window-configuration))    (let ((config (current-window-configuration))
1237          (current-buffer (current-buffer))          (current-buffer (current-buffer))
1238          (threaded-view-flag mh-show-threads-flag))          (threaded-view-flag mh-show-threads-flag))
# Line 1238  regardless of the size of the `mh-large- Line 1245  regardless of the size of the `mh-large-
1245        (setq mh-index-data (car index-data)        (setq mh-index-data (car index-data)
1246              mh-index-msg-checksum-map (make-hash-table :test #'equal)              mh-index-msg-checksum-map (make-hash-table :test #'equal)
1247              mh-index-checksum-origin-map (make-hash-table :test #'equal))              mh-index-checksum-origin-map (make-hash-table :test #'equal))
1248        (mh-index-update-maps folder (cadr index-data)))        (mh-index-update-maps folder (cadr index-data))
1249          (mh-index-create-sequences))
1250      (mh-scan-folder folder (or range "all"))      (mh-scan-folder folder (or range "all"))
1251      (cond ((and threaded-view-flag      (cond ((and threaded-view-flag
1252                  (save-excursion                  (save-excursion
1253                    (goto-char (point-min))                    (goto-char (point-min))
1254                    (or (null mh-large-folder)                    (or (null mh-large-folder)
1255                        (not (equal (forward-line mh-large-folder) 0))                        (not (equal (forward-line (1+ mh-large-folder)) 0))
1256                        (and (message "Not threading since the number of messages exceeds `mh-large-folder'")                        (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1257                             nil))))                             nil))))
1258             (mh-toggle-threads))             (mh-toggle-threads))
# Line 1405  If MSG is nil then act on the message at Line 1413  If MSG is nil then act on the message at
1413    
1414  ;;; The folder data abstraction.  ;;; The folder data abstraction.
1415    
1416    (defvar mh-index-data-file ".mhe_index"
1417      "MH-E specific file where index seach info is stored.")
1418    
1419  (defun mh-make-folder (name)  (defun mh-make-folder (name)
1420    "Create a new mail folder called NAME.    "Create a new mail folder called NAME.
1421  Make it the current folder."  Make it the current folder."
# Line 1417  Make it the current folder." Line 1428  Make it the current folder."
1428    (mh-folder-mode)    (mh-folder-mode)
1429    (mh-set-folder-modified-p nil)    (mh-set-folder-modified-p nil)
1430    (setq buffer-file-name mh-folder-filename)    (setq buffer-file-name mh-folder-filename)
1431      (when (and (not mh-index-data)
1432                 (file-exists-p (concat buffer-file-name mh-index-data-file)))
1433        (mh-index-read-data))
1434    (mh-make-folder-mode-line))    (mh-make-folder-mode-line))
1435    
1436  ;;; Ensure new buffers won't get this mode if default-major-mode is nil.  ;;; Ensure new buffers won't get this mode if default-major-mode is nil.
# Line 1437  Make it the current folder." Line 1451  Make it the current folder."
1451      ["List Sequences in Folder..."      mh-list-sequences t]      ["List Sequences in Folder..."      mh-list-sequences t]
1452      ["Delete Sequence..."               mh-delete-seq t]      ["Delete Sequence..."               mh-delete-seq t]
1453      ["Narrow to Sequence..."            mh-narrow-to-seq t]      ["Narrow to Sequence..."            mh-narrow-to-seq t]
1454      ["Widen from Sequence"              mh-widen mh-narrowed-to-seq]      ["Widen from Sequence"              mh-widen mh-folder-view-stack]
1455      "--"      "--"
1456      ["Narrow to Subject Sequence"       mh-narrow-to-subject t]      ["Narrow to Subject Sequence"       mh-narrow-to-subject t]
1457      ["Narrow to Tick Sequence"          mh-narrow-to-tick      ["Narrow to Tick Sequence"          mh-narrow-to-tick
# Line 1512  Make it the current folder." Line 1526  Make it the current folder."
1526           (set-specifier horizontal-scrollbar-visible-p nil           (set-specifier horizontal-scrollbar-visible-p nil
1527                          (cons (current-buffer) nil)))))                          (cons (current-buffer) nil)))))
1528    
 ;; Avoid compiler warnings in XEmacs and GNU Emacs 20  
 (eval-when-compile (defvar tool-bar-mode))  
   
1529  (defmacro mh-write-file-functions-compat ()  (defmacro mh-write-file-functions-compat ()
1530    "Return `write-file-functions' if it exists.    "Return `write-file-functions' if it exists.
1531  Otherwise return `local-write-file-hooks'. This macro exists purely for  Otherwise return `local-write-file-hooks'. This macro exists purely for
# Line 1524  is used in previous versions and XEmacs. Line 1535  is used in previous versions and XEmacs.
1535        ''write-file-functions            ;Emacs 21.4        ''write-file-functions            ;Emacs 21.4
1536      ''local-write-file-hooks))          ;<Emacs 21.4, XEmacs      ''local-write-file-hooks))          ;<Emacs 21.4, XEmacs
1537    
1538  ;; Avoid compiler warning  ;; Avoid compiler warnings in non-bleeding edge versions of Emacs.
1539  (defvar tool-bar-map)  (eval-when-compile
1540      (defvar tool-bar-mode)
1541      (defvar tool-bar-map)
1542      (defvar desktop-save-buffer))         ;Emacs 21.4
1543    
1544  (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"  (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
1545    "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>    "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
# Line 1564  When a folder is visited, the hook `mh-f Line 1578  When a folder is visited, the hook `mh-f
1578     'mh-seq-list nil                     ; Alist of (seq . msgs) nums     'mh-seq-list nil                     ; Alist of (seq . msgs) nums
1579     'mh-seen-list nil                    ; List of displayed messages     'mh-seen-list nil                    ; List of displayed messages
1580     'mh-next-direction 'forward          ; Direction to move to next message     'mh-next-direction 'forward          ; Direction to move to next message
    'mh-narrowed-to-seq nil              ; Sequence display is narrowed to  
    'mh-tick-seq-changed-when-narrowed-flag nil  
                                         ; Tick seq changed while narrowed  
1581     'mh-view-ops ()                      ; Stack that keeps track of the order     'mh-view-ops ()                      ; Stack that keeps track of the order
1582                                          ; in which narrowing/threading has been                                          ; in which narrowing/threading has been
1583                                          ; carried out.                                          ; carried out.
1584       'mh-folder-view-stack ()             ; Stack of previous views of the
1585                                            ; folder.
1586     'mh-index-data nil                   ; If the folder was created by a call     'mh-index-data nil                   ; If the folder was created by a call
1587                                          ; to mh-index-search this contains info                                          ; to mh-index-search this contains info
1588                                          ; about the search results.                                          ; about the search results.
1589     'mh-index-previous-search nil        ; Previous folder and search-regexp     'mh-index-previous-search nil        ; Previous folder and search-regexp
1590     'mh-index-msg-checksum-map nil       ; msg -> checksum map     'mh-index-msg-checksum-map nil       ; msg -> checksum map
1591     'mh-index-checksum-origin-map nil    ; checksum -> ( orig-folder, orig-msg )     'mh-index-checksum-origin-map nil    ; checksum -> ( orig-folder, orig-msg )
1592       'mh-index-sequence-search-flag nil   ; folder resulted from sequence search
1593     'mh-first-msg-num nil                ; Number of first msg in buffer     'mh-first-msg-num nil                ; Number of first msg in buffer
1594     'mh-last-msg-num nil                 ; Number of last msg in buffer     'mh-last-msg-num nil                 ; Number of last msg in buffer
1595     'mh-msg-count nil                    ; Number of msgs in buffer     'mh-msg-count nil                    ; Number of msgs in buffer
1596     'mh-mode-line-annotation nil         ; Indicates message range     'mh-mode-line-annotation nil         ; Indicates message range
1597       'mh-sequence-notation-history (make-hash-table)
1598                                            ; Remember what is overwritten by
1599                                            ; mh-note-seq.
1600     'mh-previous-window-config nil)      ; Previous window configuration     'mh-previous-window-config nil)      ; Previous window configuration
1601    (mh-remove-xemacs-horizontal-scrollbar)    (mh-remove-xemacs-horizontal-scrollbar)
1602    (setq truncate-lines t)    (setq truncate-lines t)
# Line 1597  When a folder is visited, the hook `mh-f Line 1614  When a folder is visited, the hook `mh-f
1614    (easy-menu-add mh-folder-sequence-menu)    (easy-menu-add mh-folder-sequence-menu)
1615    (easy-menu-add mh-folder-message-menu)    (easy-menu-add mh-folder-message-menu)
1616    (easy-menu-add mh-folder-folder-menu)    (easy-menu-add mh-folder-folder-menu)
1617    (if (and (boundp 'tool-bar-mode) tool-bar-mode)    (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
       (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))  
1618    (mh-funcall-if-exists mh-toolbar-init :folder)    (mh-funcall-if-exists mh-toolbar-init :folder)
1619    (if (and mh-xemacs-flag    (if (and mh-xemacs-flag
1620             font-lock-auto-fontify)             font-lock-auto-fontify)
# Line 1611  When a folder is visited, the hook `mh-f Line 1627  When a folder is visited, the hook `mh-f
1627      (set (make-local-variable (car pairs)) (car (cdr pairs)))      (set (make-local-variable (car pairs)) (car (cdr pairs)))
1628      (setq pairs (cdr (cdr pairs)))))      (setq pairs (cdr (cdr pairs)))))
1629    
1630    ;;;###autoload
1631    (defun mh-restore-desktop-buffer (desktop-buffer-file-name
1632                                      desktop-buffer-name
1633                                      desktop-buffer-misc)
1634      "Restore an MH folder buffer specified in a desktop file."
1635      (mh-find-path)
1636      (mh-visit-folder desktop-buffer-name)
1637      (current-buffer))
1638    
1639  (defun mh-scan-folder (folder range &optional dont-exec-pending)  (defun mh-scan-folder (folder range &optional dont-exec-pending)
1640    "Scan the FOLDER over the RANGE.    "Scan the FOLDER over the RANGE.
1641  If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and  If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
# Line 1651  If UPDATE, append the scan lines, otherw Line 1676  If UPDATE, append the scan lines, otherw
1676          (range (if (and range (atom range)) (list range) range))          (range (if (and range (atom range)) (list range) range))
1677          scan-start)          scan-start)
1678      (message "Scanning %s..." folder)      (message "Scanning %s..." folder)
1679        (mh-remove-all-notation)
1680      (with-mh-folder-updating (nil)      (with-mh-folder-updating (nil)
1681        (if update        (if update
1682            (goto-char (point-max))            (goto-char (point-max))
# Line 1742  Return in the current buffer." Line 1768  Return in the current buffer."
1768          (message "inc %s..." folder))          (message "inc %s..." folder))
1769        (setq mh-next-direction 'forward)        (setq mh-next-direction 'forward)
1770        (goto-char (point-max))        (goto-char (point-max))
1771          (mh-remove-all-notation)
1772        (let ((start-of-inc (point)))        (let ((start-of-inc (point)))
         (mh-remove-cur-notation)  
1773          (if maildrop-name          (if maildrop-name
1774              ;; I think MH 5 used "-ms-file" instead of "-file",              ;; I think MH 5 used "-ms-file" instead of "-file",
1775              ;; which would make inc'ing from maildrops fail.              ;; which would make inc'ing from maildrops fail.
# Line 1763  Return in the current buffer." Line 1789  Return in the current buffer."
1789                   (re-search-forward "^inc: no mail" nil t))                   (re-search-forward "^inc: no mail" nil t))
1790                 (message "No new mail%s%s" (if maildrop-name " in " "")                 (message "No new mail%s%s" (if maildrop-name " in " "")
1791                          (if maildrop-name maildrop-name "")))                          (if maildrop-name maildrop-name "")))
1792                ((and (when mh-narrowed-to-seq                ((and (when mh-folder-view-stack
1793                        (let ((saved-text (buffer-substring-no-properties                        (let ((saved-text (buffer-substring-no-properties
1794                                           start-of-inc (point-max))))                                           start-of-inc (point-max))))
1795                          (delete-region start-of-inc (point-max))                          (delete-region start-of-inc (point-max))
1796                          (unwind-protect (mh-widen)                          (unwind-protect (mh-widen t)
1797                              (mh-remove-all-notation)
1798                            (goto-char (point-max))                            (goto-char (point-max))
1799                            (setq start-of-inc (point))                            (setq start-of-inc (point))
1800                            (insert saved-text)                            (insert saved-text)
# Line 1789  Return in the current buffer." Line 1816  Return in the current buffer."
1816          (setq mh-seq-list (mh-read-folder-sequences folder t))          (setq mh-seq-list (mh-read-folder-sequences folder t))
1817          (when (equal (point-max) start-of-inc)          (when (equal (point-max) start-of-inc)
1818            (mh-notate-cur))            (mh-notate-cur))
         (mh-notate-user-sequences)  
1819          (if new-mail-flag          (if new-mail-flag
1820              (progn              (progn
1821                (mh-make-folder-mode-line)                (mh-make-folder-mode-line)
# Line 1798  Return in the current buffer." Line 1824  Return in the current buffer."
1824                (when (memq 'unthread mh-view-ops)                (when (memq 'unthread mh-view-ops)
1825                  (mh-thread-inc folder start-of-inc))                  (mh-thread-inc folder start-of-inc))
1826                (mh-goto-cur-msg))                (mh-goto-cur-msg))
1827            (goto-char point-before-inc))))))            (goto-char point-before-inc))
1828            (mh-notate-user-sequences)
1829            (mh-notate-deleted-and-refiled)))))
1830    
1831  (defun mh-make-folder-mode-line (&optional ignored)  (defun mh-make-folder-mode-line (&optional ignored)
1832    "Set the fields of the mode line for a folder buffer.    "Set the fields of the mode line for a folder buffer.
# Line 1841  in what is now stored in the buffer-loca Line 1869  in what is now stored in the buffer-loca
1869                                    (""))))))                                    (""))))))
1870        (mh-logo-display))))        (mh-logo-display))))
1871    
1872    ;;; XXX: Remove this function, if no one uses it any more...
1873  (defun mh-unmark-all-headers (remove-all-flags)  (defun mh-unmark-all-headers (remove-all-flags)
1874    "Remove all '+' flags from the folder listing.    "Remove all '+' flags from the folder listing.
1875  With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.  With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
1876  Optimized for speed (i.e., no regular expressions)."  Optimized for speed (i.e., no regular expressions).
1877    
1878    This function is deprecated. Use `mh-remove-all-notation' instead."
1879    (save-excursion    (save-excursion
1880      (let ((case-fold-search nil)      (let ((case-fold-search nil)
1881            (last-line (1- (point-max)))            (last-line (1- (point-max)))
# Line 1869  Optimized for speed (i.e., no regular ex Line 1900  Optimized for speed (i.e., no regular ex
1900                      (insert " ")))))                      (insert " ")))))
1901          (forward-line)))))          (forward-line)))))
1902    
1903    (defun mh-add-sequence-notation (msg internal-seq-flag)
1904      "Add sequence notation to the MSG on the current line.
1905    If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the
1906    current line, so that font-lock would automatically refontify it."
1907      (with-mh-folder-updating (t)
1908        (save-excursion
1909          (beginning-of-line)
1910          (if internal-seq-flag
1911              (mh-notate nil nil mh-cmd-note)
1912            (forward-char (1+ mh-cmd-note))
1913            (let ((stack (gethash msg mh-sequence-notation-history)))
1914              (setf (gethash msg mh-sequence-notation-history)
1915                    (cons (char-after) stack)))
1916            (mh-notate nil mh-note-seq (1+ mh-cmd-note))))))
1917    
1918    (defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
1919      "Remove sequence notation from the MSG on the current line.
1920    If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to highlight the
1921    sequence. In that case, no notation needs to be removed. Otherwise the effect
1922    of inserting `mh-note-seq' needs to be reversed.
1923    If ALL is non-nil, then all sequence marks on the scan line are removed."
1924      (with-mh-folder-updating (t)
1925        ;; This takes care of internal sequences...
1926        (mh-notate nil nil mh-cmd-note)
1927        (unless internal-seq-flag
1928          ;; ... and this takes care of user sequences.
1929          (let ((stack (gethash msg mh-sequence-notation-history)))
1930            (while (and all (cdr stack))
1931              (setq stack (cdr stack)))
1932            (when stack
1933              (mh-notate nil (car stack) (1+ mh-cmd-note)))
1934            (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
1935    
1936  (defun mh-remove-cur-notation ()  (defun mh-remove-cur-notation ()
1937    "Remove old cur notation."    "Remove old cur notation."
1938    (let ((cur-msg (car (mh-seq-to-msgs 'cur))))    (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
# Line 1884  Optimized for speed (i.e., no regular ex Line 1948  Optimized for speed (i.e., no regular ex
1948    (save-excursion    (save-excursion
1949      (setq overlay-arrow-position nil)      (setq overlay-arrow-position nil)
1950      (goto-char (point-min))      (goto-char (point-min))
1951      (while (not (eobp))      (mh-iterate-on-range msg (cons (point-min) (point-max))
1952        (unless (or (equal (char-after) ?+) (eolp))        (mh-notate nil ?  mh-cmd-note)
1953          (mh-notate nil ?  mh-cmd-note)        (mh-remove-sequence-notation msg nil t))
1954          (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))      (clrhash mh-sequence-notation-history)))
           (mh-notate nil ?  (1+ mh-cmd-note))))  
       (forward-line))))  
1955    
1956  ;;;###mh-autoload  ;;;###mh-autoload
1957  (defun mh-goto-cur-msg (&optional minimal-changes-flag)  (defun mh-goto-cur-msg (&optional minimal-changes-flag)
# Line 1934  with no arguments, before the commands a Line 1996  with no arguments, before the commands a
1996      ;; Update the unseen sequence if it exists      ;; Update the unseen sequence if it exists
1997      (mh-update-unseen)      (mh-update-unseen)
1998    
1999      (let ((redraw-needed-flag mh-index-data))      (let ((redraw-needed-flag mh-index-data)
2000              (folders-changed (list mh-current-folder))
2001              (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
2002                            (mh-create-sequence-map mh-seq-list)))
2003              (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
2004                             (make-hash-table))))
2005        ;; Remove invalid scan lines if we are in an index folder and then remove        ;; Remove invalid scan lines if we are in an index folder and then remove
2006        ;; the real messages        ;; the real messages
2007        (when mh-index-data        (when mh-index-data
2008          (mh-index-delete-folder-headers)          (mh-index-delete-folder-headers)
2009          (mh-index-execute-commands))          (setq folders-changed
2010                  (append folders-changed (mh-index-execute-commands))))
2011    
2012        ;; Then refile messages        ;; Then refile messages
2013        (mh-mapc #'(lambda (folder-msg-list)        (mh-mapc #'(lambda (folder-msg-list)
2014                     (let ((dest-folder (symbol-name (car folder-msg-list)))                     (let* ((dest-folder (symbol-name (car folder-msg-list)))
2015                           (msgs (cdr folder-msg-list)))                            (last (car (mh-translate-range dest-folder "last")))
2016                              (msgs (cdr folder-msg-list)))
2017                         (push dest-folder folders-changed)
2018                       (setq redraw-needed-flag t)                       (setq redraw-needed-flag t)
2019                       (apply #'mh-exec-cmd                       (apply #'mh-exec-cmd
2020                              "refile" "-src" folder dest-folder                              "refile" "-src" folder dest-folder
2021                              (mh-coalesce-msg-list msgs))                              (mh-coalesce-msg-list msgs))
2022                       (mh-delete-scan-msgs msgs)))                       (mh-delete-scan-msgs msgs)
2023                         ;; Preserve sequences in destination folder...
2024                         (when (and mh-refile-preserves-sequences-flag
2025                                    (numberp last))
2026                           (clrhash dest-map)
2027                           (loop for i from (1+ last)
2028                                 for msg in (sort (copy-sequence msgs) #'<)
2029                                 do (loop for seq-name in (gethash msg seq-map)
2030                                          do (push i (gethash seq-name dest-map))))
2031                           (maphash
2032                            #'(lambda (seq msgs)
2033                                ;; Run it in the background, since we don't care
2034                                ;; about the results.
2035                                (apply #'mh-exec-cmd-daemon "mark" #'ignore
2036                                       "-sequence" (symbol-name seq) dest-folder
2037                                       "-add" (mapcar #'(lambda (x) (format "%s" x))
2038                                                      (mh-coalesce-msg-list msgs))))
2039                            dest-map))))
2040                 mh-refile-list)                 mh-refile-list)
2041        (setq mh-refile-list ())        (setq mh-refile-list ())
2042    
# Line 1969  with no arguments, before the commands a Line 2056  with no arguments, before the commands a
2056        ;; Redraw folder buffer if needed        ;; Redraw folder buffer if needed
2057        (when (and redraw-needed-flag)        (when (and redraw-needed-flag)
2058          (when (mh-speed-flists-active-p)          (when (mh-speed-flists-active-p)
2059            (mh-speed-flists t mh-current-folder))            (apply #'mh-speed-flists t folders-changed))
2060          (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))          (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
2061                (mh-index-data (mh-index-insert-folder-headers)))))                (mh-index-data (mh-index-insert-folder-headers)))))
2062    
# Line 1980  with no arguments, before the commands a Line 2067  with no arguments, before the commands a
2067           (mh-invalidate-show-buffer))           (mh-invalidate-show-buffer))
2068    
2069      (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))      (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
2070      (mh-unmark-all-headers t)      (mh-remove-all-notation)
2071      (mh-notate-user-sequences)      (mh-notate-user-sequences)
2072      (message "Processing deletes and refiles for %s...done" folder)))      (message "Processing deletes and refiles for %s...done" folder)))
2073    
# Line 2115  Expands ranges into set of individual nu Line 2202  Expands ranges into set of individual nu
2202               (setq msgs (cons num msgs)))))               (setq msgs (cons num msgs)))))
2203      msgs))      msgs))
2204    
2205  (defun mh-notate-user-sequences (&optional msg-or-seq)  (defun mh-notate-user-sequences (&optional range)
2206    "Mark user-defined sequences in the messages specified by MSG-OR-SEQ.    "Mark user-defined sequences in the messages specified by RANGE.
2207  The optional argument MSG-OR-SEQ can be a message number, a list of message  The optional argument RANGE can be a message number, a list of message
2208  numbers, a sequence, a region in a cons cell, or nil in which case all  numbers, a sequence, a region in a cons cell. If nil all messages are notated."
2209  messages in the folder buffer are notated."    (unless range
2210    (unless msg-or-seq      (setq range (cons (point-min) (point-max))))
     (setq msg-or-seq (cons (point-min) (point-max))))  
2211    (let ((seqs mh-seq-list)    (let ((seqs mh-seq-list)
2212          (msg-hash (make-hash-table))          (msg-hash (make-hash-table)))
         (tick-msgs (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))))  
2213      (dolist (seq seqs)      (dolist (seq seqs)
2214        (unless (mh-internal-seq (mh-seq-name seq))        (dolist (msg (mh-seq-msgs seq))
2215          (dolist (msg (mh-seq-msgs seq))          (push (car seq) (gethash msg msg-hash))))
2216            (setf (gethash msg msg-hash) t))))      (mh-iterate-on-range msg range
2217      (mh-iterate-on-msg-or-seq msg msg-or-seq        (loop for seq in (gethash msg msg-hash)
2218        (when (gethash msg msg-hash)              do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
2219          (mh-notate nil mh-note-seq (1+ mh-cmd-note)))  
2220        (mh-notate-tick msg tick-msgs))))  (defvar mh-internal-seqs '(answered cur deleted forwarded printed))
2221    
2222  (defun mh-internal-seq (name)  (defun mh-internal-seq (name)
2223    "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."
2224    (or (memq name '(answered cur deleted forwarded printed))    (or (memq name mh-internal-seqs)
2225        (eq name mh-unseen-seq)        (eq name mh-unseen-seq)
2226        (and mh-tick-seq (eq name mh-tick-seq))        (and mh-tick-seq (eq name mh-tick-seq))
2227        (eq name mh-previous-seq)        (eq name mh-previous-seq)
2228        (mh-folder-name-p name)))        (mh-folder-name-p name)))
2229    
2230  (defun mh-delete-msg-from-seq (msg-or-seq sequence &optional internal-flag)  (defun mh-valid-seq-p (name)
2231    "Delete MSG-OR-SEQ from SEQUENCE.    "Return non-nil if NAME is a valid MH sequence name."
2232  Default value of MSG-OR-SEQ is the displayed message.    (and (symbolp name)
2233  If optional prefix argument is provided, then prompt for the message sequence.         (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
2234  If variable `transient-mark-mode' is non-nil and the mark is active, then the  
2235  selected region is deleted from SEQUENCE..  (defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
2236  In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a    "Delete RANGE from SEQUENCE.
2237  region in a cons cell, or a sequence; optional third arg INTERNAL-FLAG non-nil  
2238  means do not inform MH of the change."  Check the documentation of `mh-interactive-range' to see how RANGE is read in
2239    (interactive (list (mh-interactive-msg-or-seq "Delete")  interactive use.
2240    
2241    Optional third arg INTERNAL-FLAG non-nil means do not inform MH of the
2242    change."
2243      (interactive (list (mh-interactive-range "Delete")
2244                       (mh-read-seq-default "Delete from" t)                       (mh-read-seq-default "Delete from" t)
2245                       nil))                       nil))
2246    (let ((entry (mh-find-seq sequence)))    (let ((entry (mh-find-seq sequence))
2247            (user-sequence-flag (not (mh-internal-seq sequence)))
2248            (folders-changed (list mh-current-folder))
2249            (msg-list ()))
2250      (when entry      (when entry
2251        (mh-iterate-on-msg-or-seq msg msg-or-seq        (mh-iterate-on-range msg range
2252          (when (memq msg (mh-seq-msgs entry))          (push msg msg-list)
2253            (mh-notate nil ?  (1+ mh-cmd-note)))          ;; Calling "mark" repeatedly takes too long. So we will pretend here
2254          (mh-delete-a-msg-from-seq msg sequence internal-flag)          ;; that we are just modifying an internal sequence...
2255          (mh-clear-text-properties nil))          (when (memq msg (cdr entry))
2256        (mh-notate-user-sequences msg-or-seq)            (mh-remove-sequence-notation msg (not user-sequence-flag)))
2257            (mh-delete-a-msg-from-seq msg sequence t))
2258          ;; ... and here we will "mark" all the messages at one go.
2259          (unless internal-flag (mh-undefine-sequence sequence msg-list))
2260          (when (and mh-index-data (not internal-flag))
2261            (setq folders-changed
2262                  (append folders-changed
2263                          (mh-index-delete-from-sequence sequence msg-list))))
2264        (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))        (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
2265          (mh-speed-flists t mh-current-folder)))))          (apply #'mh-speed-flists t folders-changed)))))
2266    
2267  (defun mh-delete-a-msg-from-seq (msg sequence internal-flag)  (defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
2268    "Delete MSG from SEQUENCE.    "Delete MSG from SEQUENCE.
# Line 2174  If INTERNAL-FLAG is non-nil, then do not Line 2273  If INTERNAL-FLAG is non-nil, then do not
2273            (mh-undefine-sequence sequence (list msg)))            (mh-undefine-sequence sequence (list msg)))
2274        (setcdr entry (delq msg (mh-seq-msgs entry))))))        (setcdr entry (delq msg (mh-seq-msgs entry))))))
2275    
 (defun mh-clear-text-properties (message)  
   "Clear all text properties (except mh-tick) from the scan line for MESSAGE."  
   (save-excursion  
     (with-mh-folder-updating (t)  
       (when (or (not message) (mh-goto-msg message t t))  
         (beginning-of-line)  
         (let ((tick-property (get-text-property (point) 'mh-tick)))  
           (set-text-properties (point) (line-end-position) nil)  
           (when tick-property  
             (add-text-properties (point) (line-end-position)  
                                  `(mh-tick ,tick-property))))))))  
   
2276  (defun mh-undefine-sequence (seq msgs)  (defun mh-undefine-sequence (seq msgs)
2277    "Remove from the SEQ the list of MSGS."    "Remove from the SEQ the list of MSGS."
2278    (prog1 (mh-exec-cmd "mark" mh-current-folder "-delete"    (when (and (mh-valid-seq-p seq) msgs)
2279                        "-sequence" (symbol-name seq)      (apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
2280                        (mh-coalesce-msg-list msgs))             "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
     (when (and (eq seq mh-unseen-seq) (mh-speed-flists-active-p))  
       (mh-speed-flists t mh-current-folder))))  
2281    
2282  (defun mh-define-sequence (seq msgs)  (defun mh-define-sequence (seq msgs)
2283    "Define the SEQ to contain the list of MSGS.    "Define the SEQ to contain the list of MSGS.
2284  Do not mark pseudo-sequences or empty sequences.  Do not mark pseudo-sequences or empty sequences.
2285  Signals an error if SEQ is an illegal name."  Signals an error if SEQ is an illegal name."
2286    (if (and msgs    (if (and msgs
2287               (mh-valid-seq-p seq)
2288             (not (mh-folder-name-p seq)))             (not (mh-folder-name-p seq)))
2289        (save-excursion        (save-excursion
2290          (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"          (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
# Line 2237  If INCLUDE-INTERNAL-FLAG non-nil, includ Line 2323  If INCLUDE-INTERNAL-FLAG non-nil, includ
2323    
2324    
2325    
 ;;; User prompting commands.  
   
 (defun mh-read-msg-range (folder &optional always-prompt-flag)  
   "Prompt for message range from FOLDER.  
 If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for  
 range."  
   (multiple-value-bind (total unseen) (mh-folder-size folder)  
     (cond  
      ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))  
       (list (symbol-name mh-unseen-seq)))  
      ((or (null mh-large-folder) (not (numberp total)))  
       (list "all"))  
      ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))  
       (let* ((prompt  
               (format "Range or number of messages to read (default: %s): "  
                       total))  
              (in (read-string prompt nil nil (number-to-string total))))  
         (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)  
                (list (format "last:%s" (car (read-from-string in)))))  
               ((equal in "") (list "all"))  
               (t (split-string in)))))  
      (t (list "all")))))  
   
   
   
2326  ;;; Build the folder-mode keymap:  ;;; Build the folder-mode keymap:
2327    
2328  (suppress-keymap mh-folder-mode-map)  (suppress-keymap mh-folder-mode-map)
# Line 2319  range." Line 2380  range."
2380    
2381  (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)  (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
2382    "?"           mh-prefix-help    "?"           mh-prefix-help
2383      "'"           mh-index-ticked-messages
2384    "S"           mh-sort-folder    "S"           mh-sort-folder
2385    "f"           mh-alt-visit-folder    "f"           mh-alt-visit-folder
2386    "i"           mh-index-search    "i"           mh-index-search
# Line 2327  range." Line 2389  range."
2389    "n"           mh-index-new-messages    "n"           mh-index-new-messages
2390    "o"           mh-alt-visit-folder    "o"           mh-alt-visit-folder
2391    "p"           mh-pack-folder    "p"           mh-pack-folder
2392      "q"           mh-index-sequenced-messages
2393    "r"           mh-rescan-folder    "r"           mh-rescan-folder
2394    "s"           mh-search-folder    "s"           mh-search-folder
2395    "u"           mh-undo-folder    "u"           mh-undo-folder
# Line 2340  range." Line 2403  range."
2403    "w"           mh-junk-whitelist)    "w"           mh-junk-whitelist)
2404    
2405  (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)  (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
2406      "'"           mh-narrow-to-tick
2407    "?"           mh-prefix-help    "?"           mh-prefix-help
2408    "d"           mh-delete-msg-from-seq    "d"           mh-delete-msg-from-seq
2409    "k"           mh-delete-seq    "k"           mh-delete-seq
# Line 2361  range." Line 2425  range."
2425  (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)  (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
2426    "'"           mh-narrow-to-tick    "'"           mh-narrow-to-tick
2427    "?"           mh-prefix-help    "?"           mh-prefix-help
2428      "c"           mh-narrow-to-cc
2429      "f"           mh-narrow-to-from
2430      "r"           mh-narrow-to-range
2431    "s"           mh-narrow-to-subject    "s"           mh-narrow-to-subject
2432      "t"           mh-narrow-to-to
2433    "w"           mh-widen)    "w"           mh-widen)
2434    
2435  (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)  (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
# Line 2411  range." Line 2479  range."
2479           "[d]elete, [o]refile, e[x]ecute,\n"           "[d]elete, [o]refile, e[x]ecute,\n"
2480           "[s]end, [r]eply.\n"           "[s]end, [r]eply.\n"
2481           "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"           "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
2482           "\n [T]hread, / Limit, e[X]tract, [D]igest, [I]nc spools.")           "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
2483    
2484      (?F "[l]ist, [v]isit folder;\n"      (?F "[l]ist; [v]isit folder;\n"
2485          "[t]hread; [s]earch; [i]ndexed search;\n"          "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
2486          "[p]ack; [S]ort; [r]escan; [k]ill")          "[p]ack; [S]ort; [r]escan; [k]ill")
2487      (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"      (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
2488          "[s]equences, [l]ist,\n"          "[s]equences, [l]ist,\n"
2489          "[d]elete message from sequence, [k]ill sequence")          "[d]elete message from sequence, [k]ill sequence")
2490      (?T "[t]oggle, [d]elete, [o]refile thread")      (?T "[t]oggle, [d]elete, [o]refile thread")
2491      (?/ "Limit to [s]ubject; [w]iden")      (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden")
2492      (?X "un[s]har, [u]udecode message")      (?X "un[s]har, [u]udecode message")
2493      (?D "[b]urst digest")      (?D "[b]urst digest")
2494      (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"      (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
# Line 2443  well.") Line 2511  well.")
2511                  "^There is no other window$"))                  "^There is no other window$"))
2512    (add-to-list 'debug-ignored-errors mess))    (add-to-list 'debug-ignored-errors mess))
2513    
 ;;;;  Desktop support  
   
 ;;;###autoload  
 (defun mh-restore-desktop-buffer (desktop-buffer-file-name  
                                   desktop-buffer-name  
                                   desktop-buffer-misc)  
   "Restore an mh folder buffer specified in a desktop file."  
   (mh-find-path)  
   (mh-visit-folder desktop-buffer-name)  
   (current-buffer))  
   
2514  (provide 'mh-e)  (provide 'mh-e)
2515    
2516  ;;; Local Variables:  ;;; Local Variables:

Legend:
Removed from v.1.2.4.4  
changed lines
  Added in v.1.2.4.5

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