Mercurial > emacs
diff lisp/mh-e/mh-seq.el @ 89966:d8411455de48
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-32
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-486
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-487
Tweak permissions
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-488
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-489
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-490
Update from CVS: man/fixit.texi (Spelling): Fix typo.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-491
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-494
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-495
Update from CVS: Add missing lisp/mh-e files
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-496
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-499
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-500
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-513
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Fri, 27 Aug 2004 07:00:34 +0000 |
parents | 97905c4f1a42 e9a6cbc8ca5e |
children | f042e7c0fe20 |
line wrap: on
line diff
--- a/lisp/mh-e/mh-seq.el Wed Aug 18 06:38:14 2004 +0000 +++ b/lisp/mh-e/mh-seq.el Fri Aug 27 07:00:34 2004 +0000 @@ -70,7 +70,7 @@ ;;; Code: -(require 'mh-utils) +(eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-e) @@ -78,15 +78,15 @@ (defvar tool-bar-mode) ;;; Data structures (used in message threading)... -(defstruct (mh-thread-message (:conc-name mh-message-) - (:constructor mh-thread-make-message)) +(mh-defstruct (mh-thread-message (:conc-name mh-message-) + (:constructor mh-thread-make-message)) (id nil) (references ()) (subject "") (subject-re-p nil)) -(defstruct (mh-thread-container (:conc-name mh-container-) - (:constructor mh-thread-make-container)) +(mh-defstruct (mh-thread-container (:conc-name mh-container-) + (:constructor mh-thread-make-container)) message parent children (real-child-p t)) @@ -201,12 +201,15 @@ ;;;###mh-autoload (defun mh-msg-is-in-seq (message) - "Display the sequences that contain MESSAGE. -Default is the displayed message." - (interactive (list (mh-get-msg-num t))) + "Display the sequences in which the current message appears. +Use a prefix argument to display the sequences in which another MESSAGE +appears." + (interactive "P") + (if (not message) + (setq message (mh-get-msg-num t))) (let* ((dest-folder (loop for seq in mh-refile-list - until (member message (cdr seq)) - finally return (car seq))) + when (member message (cdr seq)) return (car seq) + finally return nil)) (deleted-flag (unless dest-folder (member message mh-delete-list)))) (message "Message %d%s is in sequences: %s" message @@ -269,12 +272,11 @@ (let* ((internal-seq-flag (mh-internal-seq sequence)) (original-msgs (mh-seq-msgs (mh-find-seq sequence))) (folders (list mh-current-folder)) - (msg-list ())) + (msg-list (mh-range-to-msg-list range))) + (mh-add-msgs-to-seq msg-list sequence nil t) (mh-iterate-on-range m range - (push m msg-list) (unless (memq m original-msgs) (mh-add-sequence-notation m internal-seq-flag))) - (mh-add-msgs-to-seq msg-list sequence nil t) (if (not internal-seq-flag) (setq mh-last-seq-used sequence)) (when mh-index-data @@ -292,10 +294,8 @@ ;;;###mh-autoload (defun mh-widen (&optional all-flag) - "Remove last restriction from current folder. -If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning -of the view stack thereby showing all messages that the buffer originally -contained." + "Restore the previous limit. +If optional prefix argument ALL-FLAG is non-nil, remove all limits." (interactive "P") (let ((msg (mh-get-msg-num nil))) (when mh-folder-view-stack @@ -533,28 +533,6 @@ (rplaca old-seq new-name))) ;;;###mh-autoload -(defun mh-map-to-seq-msgs (func seq &rest args) - "Invoke the FUNC at each message in the SEQ. -SEQ can either be a list of messages or a MH sequence. The remaining ARGS are -passed as arguments to FUNC." - (save-excursion - (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq)))) - (while msgs - (if (mh-goto-msg (car msgs) t t) - (apply func (car msgs) args)) - (setq msgs (cdr msgs)))))) - -;;;###mh-autoload -(defun mh-notate-seq (seq notation offset) - "Mark the scan listing. -All messages in SEQ are marked with NOTATION at OFFSET from the beginning of -the line." - (let ((msg-list (mh-seq-to-msgs seq))) - (mh-iterate-on-messages-in-region msg (point-min) (point-max) - (when (member msg msg-list) - (mh-notate nil notation offset))))) - -;;;###mh-autoload (defun mh-notate-cur () "Mark the MH sequence cur. In addition to notating the current message with `mh-note-cur' the function @@ -577,14 +555,6 @@ "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))) -;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes -;; that the folder buffer is sorted. However in this case that assumption -;; doesn't hold. So we will do this the dumb way. -;(defun mh-copy-seq-to-point (seq location) -; ;; Copy the scan listing of the messages in SEQUENCE to after the point -; ;; LOCATION in the current buffer. -; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location)) - (defvar mh-thread-last-ancestor) (defun mh-copy-seq-to-eob (seq) @@ -614,21 +584,6 @@ (mh-index-data (mh-index-insert-folder-headers))))))) -(defun mh-copy-line-to-point (msg location) - "Copy current message line to a specific location. -The argument MSG is not used. The message in the current line is copied to -LOCATION." - ;; msg is not used? - ;; Copy the current line to the LOCATION in the current buffer. - (beginning-of-line) - (save-excursion - (let ((beginning-of-line (point)) - end) - (forward-line 1) - (setq end (point)) - (goto-char location) - (insert-buffer-substring (current-buffer) beginning-of-line end)))) - ;;;###mh-autoload (defmacro mh-iterate-on-messages-in-region (var begin end &rest body) "Iterate over region. @@ -702,7 +657,7 @@ (nreverse msg-list))) ;;;###mh-autoload -(defun mh-interactive-range (range-prompt) +(defun mh-interactive-range (range-prompt &optional default) "Return interactive specification for message, sequence, range or region. By convention, the name of this argument is RANGE. @@ -715,24 +670,17 @@ If a MH range is given, say something like last:20, then a list containing the messages in that range is returned. +If DEFAULT non-nil then it is returned. + Otherwise, the message number at point is returned. This function is usually used with `mh-iterate-on-range' in order to provide a uniform interface to MH-E functions." (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) (current-prefix-arg (mh-read-range range-prompt nil nil t t)) + (default default) (t (mh-get-msg-num t)))) -;;;###mh-autoload -(defun mh-region-to-msg-list (begin end) - "Return a list of messages within the region between BEGIN and END." - ;; If end is end of buffer back up one position - (setq end (if (equal end (point-max)) (1- end) end)) - (let ((result)) - (mh-iterate-on-messages-in-region index begin end - (when (numberp index) (push index result))) - result)) - ;;; Commands to handle new 'subject sequence. @@ -772,7 +720,7 @@ (if (or (not (looking-at mh-scan-subject-regexp)) (not (match-string 3)) (string-equal "" (match-string 3))) - (progn (message "No subject line.") + (progn (message "No subject line") nil) (let ((subject (match-string-no-properties 3)) (list)) @@ -835,61 +783,57 @@ (mh-container-message (gethash (gethash msg mh-thread-index-id-map) mh-thread-id-table))))) -;;;###mh-autoload -(defun mh-narrow-to-subject () - "Narrow to a sequence containing all following messages with same subject." - (interactive) - (let ((num (mh-get-msg-num nil)) - (count (mh-subject-to-sequence t))) - (cond - ((not count) ; No subject line, delete msg anyway - nil) - ((= 0 count) ; No other msgs, delete msg anyway. - (message "No other messages with same Subject following this one.") - nil) - (t ; We have a subject sequence. - (message "Found %d messages for subject sequence." count) - (mh-narrow-to-seq 'subject) - (if (numberp num) - (mh-goto-msg num t t)))))) - -(defun mh-read-pick-regexp (default) - "With prefix arg read a pick regexp. +(defun mh-edit-pick-expr (default) + "With prefix arg edit a pick expression. If no prefix arg is given, then return DEFAULT." (let ((default-string (loop for x in default concat (format " %s" x)))) (if (or current-prefix-arg (equal default-string "")) - (delete "" (split-string (read-string "Pick regexp: " default-string))) + (delete "" (split-string (read-string "Pick expression: " + default-string))) default))) ;;;###mh-autoload -(defun mh-narrow-to-from (&optional regexp) - "Limit to messages with the same From header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." +(defun mh-narrow-to-subject (&optional pick-expr) + "Limit to messages with same subject. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive - (list (mh-read-pick-regexp (mh-current-message-header-field 'from)))) - (mh-narrow-to-header-field 'from regexp)) + (list (mh-edit-pick-expr (mh-current-message-header-field 'subject)))) + (mh-narrow-to-header-field 'subject pick-expr)) + +;;;###mh-autoload +(defun mh-narrow-to-from (&optional pick-expr) + "Limit to messages with the same `From:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." + (interactive + (list (mh-edit-pick-expr (mh-current-message-header-field 'from)))) + (mh-narrow-to-header-field 'from pick-expr)) ;;;###mh-autoload -(defun mh-narrow-to-cc (&optional regexp) - "Limit to messages with the same Cc header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." +(defun mh-narrow-to-cc (&optional pick-expr) + "Limit to messages with the same `Cc:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive - (list (mh-read-pick-regexp (mh-current-message-header-field 'cc)))) - (mh-narrow-to-header-field 'cc regexp)) + (list (mh-edit-pick-expr (mh-current-message-header-field 'cc)))) + (mh-narrow-to-header-field 'cc pick-expr)) ;;;###mh-autoload -(defun mh-narrow-to-to (&optional regexp) - "Limit to messages with the same To header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." +(defun mh-narrow-to-to (&optional pick-expr) + "Limit to messages with the same `To:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive - (list (mh-read-pick-regexp (mh-current-message-header-field 'to)))) - (mh-narrow-to-header-field 'to regexp)) + (list (mh-edit-pick-expr (mh-current-message-header-field 'to)))) + (mh-narrow-to-header-field 'to pick-expr)) -(defun mh-narrow-to-header-field (header-field regexp) - "Limit to messages whose HEADER-FIELD match REGEXP. +(defun mh-narrow-to-header-field (header-field pick-expr) + "Limit to messages whose HEADER-FIELD match PICK-EXPR. The MH command pick is used to do the match." (let ((folder mh-current-folder) (original (mh-coalesce-msg-list @@ -897,7 +841,7 @@ (msg-list ())) (with-temp-buffer (apply #'mh-exec-cmd-output "pick" nil folder - (append original (list "-list") regexp)) + (append original (list "-list") pick-expr)) (goto-char (point-min)) (while (not (eobp)) (let ((num (read-from-string @@ -939,7 +883,9 @@ "Limit to messages in RANGE. Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use." +interactive use. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive (list (mh-interactive-range "Narrow to"))) (when (assoc 'range mh-seq-list) (mh-delete-seq 'range)) (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range) @@ -958,7 +904,7 @@ ((not count) ; No subject line, delete msg anyway (mh-delete-msg (mh-get-msg-num t))) ((= 0 count) ; No other msgs, delete msg anyway. - (message "No other messages with same Subject following this one.") + (message "No other messages with same Subject following this one") (mh-delete-msg (mh-get-msg-num t))) (t ; We have a subject sequence. (message "Marked %d messages for deletion" count) @@ -1078,13 +1024,12 @@ message) (container (setf (mh-container-message container) - (mh-thread-make-message :subject subject - :subject-re-p subject-re-p - :id id :references refs))) - (t (let ((message (mh-thread-make-message - :subject subject - :subject-re-p subject-re-p - :id id :references refs))) + (mh-thread-make-message :id id :references refs + :subject subject + :subject-re-p subject-re-p))) + (t (let ((message (mh-thread-make-message :id id :references refs + :subject-re-p subject-re-p + :subject subject))) (prog1 message (mh-thread-get-message-container message))))))) @@ -1450,8 +1395,7 @@ (cur-scan-line (and mh-thread-scan-line-map (gethash msg mh-thread-scan-line-map))) (old-scan-lines (loop for map in mh-thread-scan-line-map-stack - collect (and map (gethash msg map)))) - (notation (if (stringp notation) (aref notation 0) notation))) + collect (and map (gethash msg map))))) (when cur-scan-line (setf (aref (car cur-scan-line) offset) notation)) (dolist (line old-scan-lines) @@ -1486,7 +1430,8 @@ (setf (gethash msg mh-thread-scan-line-map) v)))) (when (> (hash-table-count mh-thread-scan-line-map) 0) (insert (if (bobp) "" "\n") (car x) "\n") - (mh-thread-generate-scan-lines thread-tree -2))))))) + (mh-thread-generate-scan-lines thread-tree -2)))) + (mh-index-create-imenu-index)))) (defun mh-thread-folder () "Generate thread view of folder." @@ -1711,11 +1656,12 @@ (push msg unticked) (setcdr tick-seq (delq msg (cdr tick-seq))) (when (null (cdr tick-seq)) (setq mh-last-seq-used nil)) - (mh-remove-sequence-notation msg t)) + (mh-remove-sequence-notation msg (mh-colors-in-use-p))) (t (push msg ticked) (setq mh-last-seq-used mh-tick-seq) - (mh-add-sequence-notation msg t)))) + (let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list))) + (mh-add-sequence-notation msg (mh-colors-in-use-p)))))) (mh-add-msgs-to-seq ticked mh-tick-seq nil t) (mh-undefine-sequence mh-tick-seq unticked) (when mh-index-data @@ -1724,16 +1670,16 @@ ;;;###mh-autoload (defun mh-narrow-to-tick () - "Restrict display of this folder to just messages in `mh-tick-seq'. + "Limit to messages in `mh-tick-seq'. + Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive) (cond ((not mh-tick-seq) (error "Enable ticking by customizing `mh-tick-seq'")) ((null (mh-seq-msgs (mh-find-seq mh-tick-seq))) - (message "No messages in tick sequence")) + (message "No messages in %s sequence" mh-tick-seq)) (t (mh-narrow-to-seq mh-tick-seq)))) - (provide 'mh-seq) ;;; Local Variables: