[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-seq.el [lexbind]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-seq.el [lexbind] |
Date: |
Sat, 04 Sep 2004 05:42:57 -0400 |
Index: emacs/lisp/mh-e/mh-seq.el
diff -c emacs/lisp/mh-e/mh-seq.el:1.2.4.3 emacs/lisp/mh-e/mh-seq.el:1.2.4.4
*** emacs/lisp/mh-e/mh-seq.el:1.2.4.3 Sat Jul 17 02:51:49 2004
--- emacs/lisp/mh-e/mh-seq.el Sat Sep 4 09:22:56 2004
***************
*** 70,76 ****
;;; Code:
! (require 'mh-utils)
(mh-require-cl)
(require 'mh-e)
--- 70,76 ----
;;; Code:
! (eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
***************
*** 78,92 ****
(defvar tool-bar-mode)
;;; Data structures (used in message threading)...
! (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))
message parent children
(real-child-p t))
--- 78,92 ----
(defvar tool-bar-mode)
;;; Data structures (used in message threading)...
! (mh-defstruct (mh-thread-message (:conc-name mh-message-)
! (:constructor mh-thread-make-message))
(id nil)
(references ())
(subject "")
(subject-re-p nil))
! (mh-defstruct (mh-thread-container (:conc-name mh-container-)
! (:constructor mh-thread-make-container))
message parent children
(real-child-p t))
***************
*** 201,212 ****
;;;###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)))
(let* ((dest-folder (loop for seq in mh-refile-list
! until (member message (cdr seq))
! finally return (car seq)))
(deleted-flag (unless dest-folder (member message mh-delete-list))))
(message "Message %d%s is in sequences: %s"
message
--- 201,215 ----
;;;###mh-autoload
(defun mh-msg-is-in-seq (message)
! "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
! 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,280 ****
(let* ((internal-seq-flag (mh-internal-seq sequence))
(original-msgs (mh-seq-msgs (mh-find-seq sequence)))
(folders (list mh-current-folder))
! (msg-list ()))
(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
--- 272,282 ----
(let* ((internal-seq-flag (mh-internal-seq sequence))
(original-msgs (mh-seq-msgs (mh-find-seq sequence)))
(folders (list mh-current-folder))
! (msg-list (mh-range-to-msg-list range)))
! (mh-add-msgs-to-seq msg-list sequence nil t)
(mh-iterate-on-range m range
(unless (memq m original-msgs)
(mh-add-sequence-notation m internal-seq-flag)))
(if (not internal-seq-flag)
(setq mh-last-seq-used sequence))
(when mh-index-data
***************
*** 292,301 ****
;;;###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."
(interactive "P")
(let ((msg (mh-get-msg-num nil)))
(when mh-folder-view-stack
--- 294,301 ----
;;;###mh-autoload
(defun mh-widen (&optional all-flag)
! "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,560 ****
(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
--- 533,538 ----
***************
*** 577,590 ****
"-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)
--- 555,560 ----
***************
*** 614,634 ****
(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.
--- 584,589 ----
***************
*** 702,708 ****
(nreverse msg-list)))
;;;###mh-autoload
! (defun mh-interactive-range (range-prompt)
"Return interactive specification for message, sequence, range or region.
By convention, the name of this argument is RANGE.
--- 657,663 ----
(nreverse msg-list)))
;;;###mh-autoload
! (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,738 ****
If a MH range is given, say something like last:20, then a list containing
the messages in that range 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))
(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.
--- 670,686 ----
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))))
;;; Commands to handle new 'subject sequence.
***************
*** 772,778 ****
(if (or (not (looking-at mh-scan-subject-regexp))
(not (match-string 3))
(string-equal "" (match-string 3)))
! (progn (message "No subject line.")
nil)
(let ((subject (match-string-no-properties 3))
(list))
--- 720,726 ----
(if (or (not (looking-at mh-scan-subject-regexp))
(not (match-string 3))
(string-equal "" (match-string 3)))
! (progn (message "No subject line")
nil)
(let ((subject (match-string-no-properties 3))
(list))
***************
*** 835,895 ****
(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.
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)))
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."
(interactive
! (list (mh-read-pick-regexp (mh-current-message-header-field 'from))))
! (mh-narrow-to-header-field 'from regexp))
;;;###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."
(interactive
! (list (mh-read-pick-regexp (mh-current-message-header-field 'cc))))
! (mh-narrow-to-header-field 'cc regexp))
;;;###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."
(interactive
! (list (mh-read-pick-regexp (mh-current-message-header-field 'to))))
! (mh-narrow-to-header-field 'to regexp))
! (defun mh-narrow-to-header-field (header-field regexp)
! "Limit to messages whose HEADER-FIELD match REGEXP.
The MH command pick is used to do the match."
(let ((folder mh-current-folder)
(original (mh-coalesce-msg-list
--- 783,839 ----
(mh-container-message (gethash (gethash msg mh-thread-index-id-map)
mh-thread-id-table)))))
! (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 expression: "
! default-string)))
default)))
;;;###mh-autoload
! (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-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 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-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 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-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 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,903 ****
(msg-list ()))
(with-temp-buffer
(apply #'mh-exec-cmd-output "pick" nil folder
! (append original (list "-list") regexp))
(goto-char (point-min))
(while (not (eobp))
(let ((num (read-from-string
--- 841,847 ----
(msg-list ()))
(with-temp-buffer
(apply #'mh-exec-cmd-output "pick" nil folder
! (append original (list "-list") pick-expr))
(goto-char (point-min))
(while (not (eobp))
(let ((num (read-from-string
***************
*** 939,945 ****
"Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
! interactive use."
(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)
--- 883,891 ----
"Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
! 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,964 ****
((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.")
(mh-delete-msg (mh-get-msg-num t)))
(t ; We have a subject sequence.
(message "Marked %d messages for deletion" count)
--- 904,910 ----
((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")
(mh-delete-msg (mh-get-msg-num t)))
(t ; We have a subject sequence.
(message "Marked %d messages for deletion" count)
***************
*** 1078,1090 ****
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)))
(prog1 message
(mh-thread-get-message-container message)))))))
--- 1024,1035 ----
message)
(container
(setf (mh-container-message container)
! (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,1457 ****
(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)))
(when cur-scan-line
(setf (aref (car cur-scan-line) offset) notation))
(dolist (line old-scan-lines)
--- 1395,1401 ----
(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)))))
(when cur-scan-line
(setf (aref (car cur-scan-line) offset) notation))
(dolist (line old-scan-lines)
***************
*** 1486,1492 ****
(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)))))))
(defun mh-thread-folder ()
"Generate thread view of folder."
--- 1430,1437 ----
(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-index-create-imenu-index))))
(defun mh-thread-folder ()
"Generate thread view of folder."
***************
*** 1711,1721 ****
(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))
(t
(push msg ticked)
(setq mh-last-seq-used mh-tick-seq)
! (mh-add-sequence-notation msg t))))
(mh-add-msgs-to-seq ticked mh-tick-seq nil t)
(mh-undefine-sequence mh-tick-seq unticked)
(when mh-index-data
--- 1656,1667 ----
(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 (mh-colors-in-use-p)))
(t
(push msg ticked)
(setq mh-last-seq-used mh-tick-seq)
! (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,1739 ****
;;;###mh-autoload
(defun mh-narrow-to-tick ()
! "Restrict display of this folder to just 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"))
(t (mh-narrow-to-seq mh-tick-seq))))
-
(provide 'mh-seq)
;;; Local Variables:
--- 1670,1685 ----
;;;###mh-autoload
(defun mh-narrow-to-tick ()
! "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 %s sequence" mh-tick-seq))
(t (mh-narrow-to-seq mh-tick-seq))))
(provide 'mh-seq)
;;; Local Variables:
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/mh-e/mh-seq.el [lexbind],
Miles Bader <=