emacs-diffs
[Top][All Lists]
Advanced

[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:




reply via email to

[Prev in Thread] Current Thread [Next in Thread]