[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
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-seq.el |
Date: |
Fri, 04 Apr 2003 01:22:39 -0500 |
Index: emacs/lisp/mh-e/mh-seq.el
diff -c emacs/lisp/mh-e/mh-seq.el:1.1 emacs/lisp/mh-e/mh-seq.el:1.2
*** emacs/lisp/mh-e/mh-seq.el:1.1 Sat Jan 25 21:38:37 2003
--- emacs/lisp/mh-e/mh-seq.el Mon Feb 3 15:55:30 2003
***************
*** 48,73 ****
;; -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
;; I would really appreciate it if someone would help me with this.
;;
! ;; (2) Implement heuristics to recognize message-id's in In-Reply-To:
! ;; header. Right now it just assumes that the last text between angles
! ;; (< and >) is the message-id. There is the chance that this will
! ;; incorrectly use an email address like a message-id.
;;
! ;; (3) Error checking of found message-id's should be done.
;;
;; (4) Since this breaks the assumption that message indices increase as
;; one goes down the buffer, the binary search based mh-goto-msg
;; doesn't work. I have a simpler replacement which may be less
;; efficient.
;;
! ;; (5) Better canonicalizing for message-id and subject strings.
;;
;; Internal support for MH-E package.
;;; Change Log:
! ;; $Id: mh-seq.el,v 1.1 2003/01/26 02:38:37 wohler Exp $
;;; Code:
--- 48,74 ----
;; -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
;; I would really appreciate it if someone would help me with this.
;;
! ;; (2) Implement heuristics to recognize message identifiers in
! ;; In-Reply-To: header. Right now it just assumes that the last text
! ;; between angles (< and >) is the message identifier. There is the
! ;; chance that this will incorrectly use an email address like a
! ;; message identifier.
;;
! ;; (3) Error checking of found message identifiers should be done.
;;
;; (4) Since this breaks the assumption that message indices increase as
;; one goes down the buffer, the binary search based mh-goto-msg
;; doesn't work. I have a simpler replacement which may be less
;; efficient.
;;
! ;; (5) Better canonicalizing for message identifier and subject strings.
;;
;; Internal support for MH-E package.
;;; Change Log:
! ;; $Id: mh-seq.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
;;; Code:
***************
*** 100,114 ****
;;; Maps and hashes...
(defvar mh-thread-id-hash nil
! "Hashtable used to canonicalize message-id strings.")
(defvar mh-thread-subject-hash nil
"Hashtable used to canonicalize subject strings.")
(defvar mh-thread-id-table nil
! "Thread ID table maps from message-id's to message containers.")
(defvar mh-thread-id-index-map nil
! "Table to lookup message index number from message-id.")
(defvar mh-thread-index-id-map nil
! "Table to lookup message-id from message index.")
(defvar mh-thread-scan-line-map nil
"Map of message index to various parts of the scan line.")
(defvar mh-thread-old-scan-line-map nil
--- 101,115 ----
;;; Maps and hashes...
(defvar mh-thread-id-hash nil
! "Hashtable used to canonicalize message identifiers.")
(defvar mh-thread-subject-hash nil
"Hashtable used to canonicalize subject strings.")
(defvar mh-thread-id-table nil
! "Thread ID table maps from message identifiers to message containers.")
(defvar mh-thread-id-index-map nil
! "Table to look up message index number from message identifier.")
(defvar mh-thread-index-id-map nil
! "Table to look up message identifier from message index.")
(defvar mh-thread-scan-line-map nil
"Map of message index to various parts of the scan line.")
(defvar mh-thread-old-scan-line-map nil
***************
*** 117,123 ****
(defvar mh-thread-subject-container-hash nil
"Hashtable used to group messages by subject.")
(defvar mh-thread-duplicates nil
! "Hashtable used to remember multiple messages with the same message-id.")
(defvar mh-thread-history ()
"Variable to remember the transformations to the thread tree.
When new messages are added, these transformations are rewound, then the
--- 118,124 ----
(defvar mh-thread-subject-container-hash nil
"Hashtable used to group messages by subject.")
(defvar mh-thread-duplicates nil
! "Hashtable used to associate messages with the same message identifier.")
(defvar mh-thread-history ()
"Variable to remember the transformations to the thread tree.
When new messages are added, these transformations are rewound, then the
***************
*** 141,150 ****
(defun mh-delete-seq (sequence)
"Delete the SEQUENCE."
(interactive (list (mh-read-seq-default "Delete" t)))
! (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
! sequence)
! (mh-undefine-sequence sequence '("all"))
! (mh-delete-seq-locally sequence))
;; Avoid compiler warnings
(defvar view-exit-action)
--- 142,153 ----
(defun mh-delete-seq (sequence)
"Delete the SEQUENCE."
(interactive (list (mh-read-seq-default "Delete" t)))
! (let ((msg-list (mh-seq-to-msgs sequence)))
! (mh-undefine-sequence sequence '("all"))
! (mh-delete-seq-locally sequence)
! (mh-iterate-on-messages-in-region msg (point-min) (point-max)
! (when (and (member msg msg-list) (not (mh-seq-containing-msg msg nil)))
! (mh-notate nil ? (1+ mh-cmd-note))))))
;; Avoid compiler warnings
(defvar view-exit-action)
***************
*** 154,160 ****
"List the sequences defined in the folder being visited."
(interactive)
(let ((folder mh-current-folder)
! (temp-buffer mh-temp-sequences-buffer)
(seq-list mh-seq-list)
(max-len 0))
(with-output-to-temp-buffer temp-buffer
--- 157,163 ----
"List the sequences defined in the folder being visited."
(interactive)
(let ((folder mh-current-folder)
! (temp-buffer mh-sequences-buffer)
(seq-list mh-seq-list)
(max-len 0))
(with-output-to-temp-buffer temp-buffer
***************
*** 223,229 ****
(narrow-to-region eob (point-max))
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)
! (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
(when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
(make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
(setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
--- 226,232 ----
(narrow-to-region eob (point-max))
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)
! (mh-notate-cur)
(when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
(make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
(setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
***************
*** 246,263 ****
the selected region is added to the sequence."
(interactive (list (cond
((mh-mark-active-p t)
! (mh-region-to-msg-list (region-beginning)
(region-end)))
(current-prefix-arg
(mh-read-seq-default "Add messages from" t))
(t
! (mh-get-msg-num t)))
(mh-read-seq-default "Add to" nil)))
! (if (not (mh-internal-seq sequence))
! (setq mh-last-seq-used sequence))
! (mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq))
! ((listp msg-or-seq) msg-or-seq)
! (t (mh-seq-to-msgs msg-or-seq)))
! sequence))
(defun mh-valid-view-change-operation-p (op)
"Check if the view change operation can be performed.
--- 249,276 ----
the selected region is added to the sequence."
(interactive (list (cond
((mh-mark-active-p t)
! (cons (region-beginning) (region-end)))
(current-prefix-arg
(mh-read-seq-default "Add messages from" t))
(t
! (cons (line-beginning-position) (line-end-position))))
(mh-read-seq-default "Add to" nil)))
! (let ((internal-seq-flag (mh-internal-seq sequence))
! msg-list)
! (cond ((and (consp msg-or-seq)
! (numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
! (mh-iterate-on-messages-in-region m (car msg-or-seq) (cdr
msg-or-seq)
! (push m msg-list)
! (unless internal-seq-flag
! (mh-notate nil mh-note-seq (1+ mh-cmd-note))))
! (mh-add-msgs-to-seq msg-list sequence internal-seq-flag t))
! ((or (numberp msg-or-seq) (listp msg-or-seq))
! (when (numberp msg-or-seq)
! (setq msg-or-seq (list msg-or-seq)))
! (mh-add-msgs-to-seq msg-or-seq sequence internal-seq-flag))
! (t (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) sequence)))
! (if (not internal-seq-flag)
! (setq mh-last-seq-used sequence))))
(defun mh-valid-view-change-operation-p (op)
"Check if the view change operation can be performed.
***************
*** 289,295 ****
(mh-goto-msg msg t t))
(mh-notate-deleted-and-refiled)
(mh-notate-user-sequences)
! (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
(mh-recenter nil)))
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
--- 302,308 ----
(mh-goto-msg msg t t))
(mh-notate-deleted-and-refiled)
(mh-notate-user-sequences)
! (mh-notate-cur)
(mh-recenter nil)))
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
***************
*** 301,315 ****
"Notate messages marked for deletion or refiling.
Messages to be deleted are given by `mh-delete-list' while messages to be
refiled are present in `mh-refile-list'."
! (mh-mapc #'(lambda (msg) (mh-notate msg mh-note-deleted mh-cmd-note))
! mh-delete-list)
! (mh-mapc #'(lambda (dest-msg-list)
! ;; foreach folder name, get the keyed sequence from mh-seq-list
! (let ((msg-list (cdr dest-msg-list)))
! (mh-mapc #'(lambda (msg)
! (mh-notate msg mh-note-refiled mh-cmd-note))
! msg-list)))
! mh-refile-list))
--- 314,331 ----
"Notate messages marked for deletion or refiling.
Messages to be deleted are given by `mh-delete-list' while messages to be
refiled are present in `mh-refile-list'."
! (let ((refiled-hash (make-hash-table))
! (deleted-hash (make-hash-table)))
! (dolist (msg mh-delete-list)
! (setf (gethash msg deleted-hash) t))
! (dolist (dest-msg-list mh-refile-list)
! (dolist (msg (cdr dest-msg-list))
! (setf (gethash msg refiled-hash) t)))
! (mh-iterate-on-messages-in-region msg (point-min) (point-max)
! (cond ((gethash msg refiled-hash)
! (mh-notate nil mh-note-refiled mh-cmd-note))
! ((gethash msg deleted-hash)
! (mh-notate nil mh-note-deleted mh-cmd-note))))))
***************
*** 380,386 ****
"Mark the scan listing.
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
the line."
! (mh-map-to-seq-msgs 'mh-notate seq notation offset))
;;;###mh-autoload
(defun mh-add-to-sequence (seq msgs)
--- 396,417 ----
"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
! uses `overlay-arrow-position' to put a marker in the fringe."
! (let ((cur (car (mh-seq-to-msgs 'cur))))
! (when (and cur (mh-goto-msg cur t t))
! (mh-notate nil mh-note-cur mh-cmd-note)
! (beginning-of-line)
! (setq mh-arrow-marker (set-marker mh-arrow-marker (point)))
! (setq overlay-arrow-position mh-arrow-marker))))
;;;###mh-autoload
(defun mh-add-to-sequence (seq msgs)
***************
*** 449,466 ****
(insert-buffer-substring (current-buffer) beginning-of-line end))))
;;;###mh-autoload
(defun mh-region-to-msg-list (begin end)
"Return a list of messages within the region between BEGIN and END."
! (save-excursion
! ;; If end is end of buffer back up one position
! (setq end (if (equal end (point-max)) (1- end) end))
! (goto-char begin)
! (let ((result ()))
! (while (<= (point) end)
! (let ((index (mh-get-msg-num nil)))
! (when (numberp index) (push index result)))
! (forward-line 1))
! result)))
--- 480,511 ----
(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.
+ VAR is bound to the message on the current line as we loop starting from BEGIN
+ till END. In each step BODY is executed.
+
+ If VAR is nil then the loop is executed without any binding."
+ (unless (symbolp var)
+ (error "Can not bind the non-symbol %s" var))
+ (let ((binding-needed-flag var))
+ `(save-excursion
+ (goto-char ,begin)
+ (while (and (<= (point) ,end) (not (eobp)))
+ (when (looking-at mh-scan-valid-regexp)
+ (let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())
+ ,@body))
+ (forward-line 1)))))
+
+ ;;;###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))
***************
*** 877,889 ****
;;; Generate Threads...
(defun mh-thread-generate (folder msg-list)
"Scan FOLDER to get info for threading.
Only information about messages in MSG-LIST are added to the tree."
! (save-excursion
! (set-buffer (get-buffer-create "*mh-thread*"))
(mh-thread-set-tables folder)
- (erase-buffer)
(when msg-list
(apply
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil)
nil
--- 922,935 ----
;;; Generate Threads...
+ (defvar mh-message-id-regexp "^<address@hidden>$"
+ "Regexp to recognize whether a string is a message identifier.")
+
(defun mh-thread-generate (folder msg-list)
"Scan FOLDER to get info for threading.
Only information about messages in MSG-LIST are added to the tree."
! (with-temp-buffer
(mh-thread-set-tables folder)
(when msg-list
(apply
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil)
nil
***************
*** 917,923 ****
(multiple-value-setq (subject subject-re-p)
(mh-thread-prune-subject subject))
(setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
! (setq refs (append (split-string refs) in-reply-to))
(setq id (mh-thread-canonicalize-id id))
(mh-thread-update-id-index-maps id index)
(setq refs (mapcar #'mh-thread-canonicalize-id refs))
--- 963,971 ----
(multiple-value-setq (subject subject-re-p)
(mh-thread-prune-subject subject))
(setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
! (setq refs (loop for x in (append (split-string refs)
in-reply-to)
! when (string-match mh-message-id-regexp x)
! collect x))
(setq id (mh-thread-canonicalize-id id))
(mh-thread-update-id-index-maps id index)
(setq refs (mapcar #'mh-thread-canonicalize-id refs))
***************
*** 963,969 ****
(mh-thread-generate-scan-lines thread-tree -2))
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)
! (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
(set-buffer-modified-p old-buffer-modified-flag))))
(defvar mh-thread-last-ancestor)
--- 1011,1017 ----
(mh-thread-generate-scan-lines thread-tree -2))
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)
! (mh-notate-cur)
(set-buffer-modified-p old-buffer-modified-flag))))
(defvar mh-thread-last-ancestor)
***************
*** 997,1016 ****
(while (mh-container-parent mh-thread-last-ancestor)
(setq mh-thread-last-ancestor
(mh-container-parent mh-thread-last-ancestor))))
! (insert (car scan-line)
! (format (format "%%%ss"
! (if dupl-flag level new-level)) "")
! (if (and (mh-container-real-child-p tree) dupl-flag
! (not force-angle-flag))
! "[" "<")
! (cadr scan-line)
! (if (and (mh-container-real-child-p tree) dupl-flag
! (not force-angle-flag))
! "]" ">")
! (truncate-string-to-width
! (caddr scan-line) (- mh-thread-body-width
! (if dupl-flag level new-level)))
! "\n")
(setq increment-level-flag t)
(setq dupl-flag nil)))
(unless increment-level-flag (setq new-level level))
--- 1045,1063 ----
(while (mh-container-parent mh-thread-last-ancestor)
(setq mh-thread-last-ancestor
(mh-container-parent mh-thread-last-ancestor))))
! (let* ((lev (if dupl-flag level new-level))
! (square-flag (or (and (mh-container-real-child-p tree)
! (not force-angle-flag)
! dupl-flag)
! (equal lev 0))))
! (insert (car scan-line)
! (format (format "%%%ss" lev) "")
! (if square-flag "[" "<")
! (cadr scan-line)
! (if square-flag "]" ">")
! (truncate-string-to-width
! (caddr scan-line) (- mh-thread-body-width lev))
! "\n"))
(setq increment-level-flag t)
(setq dupl-flag nil)))
(unless increment-level-flag (setq new-level level))
***************
*** 1057,1107 ****
(message "Threading %s..." (buffer-name))
(mh-thread-initialize)
(goto-char (point-min))
! (while (not (eobp))
! (let ((index (mh-get-msg-num nil)))
! (when (numberp index)
! (setf (gethash index mh-thread-scan-line-map)
! (mh-thread-parse-scan-line))))
! (forward-line))
! (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num))
! (thread-tree (mh-thread-generate (buffer-name) (list range))))
! (delete-region (point-min) (point-max))
! (let ((mh-thread-body-width (- (window-width) mh-cmd-note
! (1- mh-scan-field-subject-start-offset)))
! (mh-thread-last-ancestor nil))
! (mh-thread-generate-scan-lines thread-tree -2))
! (mh-notate-user-sequences)
! (mh-notate-deleted-and-refiled)
! (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
! (message "Threading %s...done" (buffer-name))))
;;;###mh-autoload
(defun mh-toggle-threads ()
! "Toggle threaded view of folder.
! The conversion of normal view to threaded view is exact, that is the same
! messages are displayed in the folder buffer before and after threading.
However
! the conversion from threaded view to normal view is inexact. So more messages
! than were originally present may be shown as a result."
(interactive)
(let ((msg-at-point (mh-get-msg-num nil))
(old-buffer-modified-flag (buffer-modified-p))
(buffer-read-only nil))
! (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq)
! (unless (mh-valid-view-change-operation-p 'unthread)
! (error "Can't unthread folder"))
! (mh-scan-folder mh-current-folder
! (format "%s" mh-narrowed-to-seq)
! t)
! (when mh-index-data
! (mh-index-insert-folder-headers)))
! ((memq 'unthread mh-view-ops)
(unless (mh-valid-view-change-operation-p 'unthread)
(error "Can't unthread folder"))
! (mh-scan-folder mh-current-folder
! (format "%s-%s" mh-first-msg-num mh-last-msg-num)
! t)
(when mh-index-data
! (mh-index-insert-folder-headers)))
(t (mh-thread-folder)
(push 'unthread mh-view-ops)))
(when msg-at-point (mh-goto-msg msg-at-point t t))
--- 1104,1153 ----
(message "Threading %s..." (buffer-name))
(mh-thread-initialize)
(goto-char (point-min))
! (let ((msg-list ()))
! (while (not (eobp))
! (let ((index (mh-get-msg-num nil)))
! (when (numberp index)
! (push index msg-list)
! (setf (gethash index mh-thread-scan-line-map)
! (mh-thread-parse-scan-line))))
! (forward-line))
! (let* ((range (mh-coalesce-msg-list msg-list))
! (thread-tree (mh-thread-generate (buffer-name) range)))
! (delete-region (point-min) (point-max))
! (let ((mh-thread-body-width (- (window-width) mh-cmd-note
! (1- mh-scan-field-subject-start-offset)))
! (mh-thread-last-ancestor nil))
! (mh-thread-generate-scan-lines thread-tree -2))
! (mh-notate-user-sequences)
! (mh-notate-deleted-and-refiled)
! (mh-notate-cur)
! (message "Threading %s...done" (buffer-name)))))
;;;###mh-autoload
(defun mh-toggle-threads ()
! "Toggle threaded view of folder."
(interactive)
(let ((msg-at-point (mh-get-msg-num nil))
(old-buffer-modified-flag (buffer-modified-p))
(buffer-read-only nil))
! (cond ((memq 'unthread mh-view-ops)
(unless (mh-valid-view-change-operation-p 'unthread)
(error "Can't unthread folder"))
! (let ((msg-list ()))
! (goto-char (point-min))
! (while (not (eobp))
! (let ((index (mh-get-msg-num t)))
! (when index
! (push index msg-list)))
! (forward-line))
! (mh-scan-folder mh-current-folder
! (mapcar #'(lambda (x) (format "%s" x))
! (mh-coalesce-msg-list msg-list))
! t))
(when mh-index-data
! (mh-index-insert-folder-headers)
! (mh-notate-cur)))
(t (mh-thread-folder)
(push 'unthread mh-view-ops)))
(when msg-at-point (mh-goto-msg msg-at-point t t))
***************
*** 1244,1271 ****
(error "Folder isn't threaded"))
((eobp)
(error "No message at point"))
! (t (mh-delete-msg
! (apply #'mh-region-to-msg-list (mh-thread-find-children))))))
- ;; This doesn't handle mh-default-folder-for-message-function. We should
- ;; refactor that code so that we don't copy it.
;;;###mh-autoload
(defun mh-thread-refile (folder)
"Mark current message and all its children for refiling to FOLDER."
! (interactive (list
! (intern (mh-prompt-for-folder
! "Destination"
! (cond ((eq 'refile (car mh-last-destination-folder))
! (symbol-name (cdr
mh-last-destination-folder)))
! (t ""))
! t))))
(cond ((not (memq 'unthread mh-view-ops))
(error "Folder isn't threaded"))
((eobp)
(error "No message at point"))
! (t (mh-refile-msg
! (apply #'mh-region-to-msg-list (mh-thread-find-children))
! folder))))
(provide 'mh-seq)
--- 1290,1312 ----
(error "Folder isn't threaded"))
((eobp)
(error "No message at point"))
! (t (let ((region (mh-thread-find-children)))
! (mh-iterate-on-messages-in-region () (car region) (cadr region)
! (mh-delete-a-msg nil))
! (mh-next-msg)))))
;;;###mh-autoload
(defun mh-thread-refile (folder)
"Mark current message and all its children for refiling to FOLDER."
! (interactive (list (intern (mh-prompt-for-refile-folder))))
(cond ((not (memq 'unthread mh-view-ops))
(error "Folder isn't threaded"))
((eobp)
(error "No message at point"))
! (t (let ((region (mh-thread-find-children)))
! (mh-iterate-on-messages-in-region () (car region) (cadr region)
! (mh-refile-a-msg nil folder))
! (mh-next-msg)))))
(provide 'mh-seq)
- [Emacs-diffs] Changes to emacs/lisp/mh-e/mh-seq.el,
Miles Bader <=