--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/vm/vm-mark.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,309 @@
+;;; Commands for handling messages marks
+;;; Copyright (C) 1990, 1993, 1994 Kyle E. Jones
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(provide 'vm-mark)
+
+(defun vm-clear-all-marks ()
+  "Removes all message marks in the current folder."
+  (interactive)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (let ((mp vm-message-list))
+    (while mp
+      (if (vm-mark-of (car mp))
+	  (progn
+	    (vm-set-mark-of (car mp) nil)
+	    (vm-mark-for-summary-update (car mp) t)))
+      (setq mp (cdr mp))))
+  (vm-display nil nil '(vm-clear-all-marks)
+	      '(vm-clear-all-marks marking-message))
+  (vm-update-summary-and-mode-line))
+
+(defun vm-mark-all-messages ()
+  "Mark all messages in the current folder."
+  (interactive)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (let ((mp vm-message-list))
+    (while mp
+      (vm-set-mark-of (car mp) t)
+      (vm-mark-for-summary-update (car mp) t)
+      (setq mp (cdr mp))))
+  (vm-display nil nil '(vm-mark-all-messages)
+	      '(vm-mark-all-messages marking-message))
+  (vm-update-summary-and-mode-line))
+
+(defun vm-mark-message (count)
+  "Mark the current message.
+Numeric prefix argument N means mark the current message and the next
+N-1 messages.  A negative N means mark the current message and the
+previous N-1 messages."
+  (interactive "p")
+  (if (interactive-p)
+      (vm-follow-summary-cursor))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (let ((direction (if (< count 0) 'backward 'forward))
+	(count (vm-abs count))
+	(oldmp vm-message-pointer)
+	(vm-message-pointer vm-message-pointer))
+    (while (not (zerop count))
+      (if (not (vm-mark-of (car vm-message-pointer)))
+	  (progn
+	    (vm-set-mark-of (car vm-message-pointer) t)
+	    (vm-mark-for-summary-update (car vm-message-pointer) t)))
+      (vm-decrement count)
+      (if (not (zerop count))
+	  (vm-move-message-pointer direction))))
+  (vm-display nil nil '(vm-mark-message)
+	      '(vm-mark-message marking-message))
+  (vm-update-summary-and-mode-line))
+
+(defun vm-unmark-message (count)
+  "Remove the mark from the current message.
+Numeric prefix argument N means unmark the current message and the next
+N-1 messages.  A negative N means unmark the current message and the
+previous N-1 messages."
+  (interactive "p")
+  (if (interactive-p)
+      (vm-follow-summary-cursor))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (let ((mlist (vm-select-marked-or-prefixed-messages count)))
+    (while mlist
+      (if (vm-mark-of (car mlist))
+	  (progn
+	    (vm-set-mark-of (car mlist) nil)
+	    (vm-mark-for-summary-update (car mlist) t)))
+      (setq mlist (cdr mlist))))
+  (vm-display nil nil '(vm-unmark-message)
+	      '(vm-unmark-message marking-message))
+  (vm-update-summary-and-mode-line))
+
+(defun vm-mark-or-unmark-messages-with-selector (val selector arg)
+  (let ((mlist vm-message-list)
+	(virtual (eq major-mode 'vm-virtual-mode))
+	(arglist (if arg (list arg) nil))
+	(count 0))
+    (setq selector (intern (concat "vm-vs-" (symbol-name selector))))
+    (while mlist
+      (if (if virtual
+	      (save-excursion
+		(set-buffer
+		 (vm-buffer-of
+		  (vm-real-message-of
+		   (car mlist))))
+		(apply selector (vm-real-message-of (car mlist)) arglist))
+	    (apply selector (car mlist) arglist))
+	  (progn
+	    (vm-set-mark-of (car mlist) val)
+	    (vm-mark-for-summary-update (car mlist) t)
+	    (vm-increment count)))
+      (setq mlist (cdr mlist)))
+    (vm-display nil nil
+		'(vm-mark-matching-messages vm-unmark-matching-messages)
+		(list this-command 'marking-message))
+    (vm-update-summary-and-mode-line)
+    (message "%d message%s %smarked"
+	     count
+	     (if (= 1 count) "" "s")
+	     (if val "" "un"))))
+
+(defun vm-mark-matching-messages (selector &optional arg)
+  "Mark messages matching some criterion.
+You can use any of the virtual folder selectors, except for the
+`and', `or' and `not' selectors.  See the documentation for the
+variable vm-virtual-folder-alist for more information."
+  (interactive
+   (let ((last-command last-command)
+	 (this-command this-command))
+     (vm-select-folder-buffer)
+     (vm-read-virtual-selector "Mark messages: ")))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-messages-with-selector t selector arg))
+
+(defun vm-unmark-matching-messages (selector &optional arg)
+  "Unmark messages matching some criterion.
+You can use any of the virtual folder selectors, except for the
+`and', `or' and `not' selectors.  See the documentation for the
+variable vm-virtual-folder-alist for more information."
+  (interactive
+   (let ((last-command last-command)
+	 (this-command this-command))
+     (vm-select-folder-buffer)
+     (vm-read-virtual-selector "Unmark messages: ")))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-messages-with-selector nil selector arg))
+
+(defun vm-mark-thread-subtree ()
+  "Mark all messages in the thread tree rooted at the current message."
+  (interactive)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-thread-subtree t))
+
+(defun vm-unmark-thread-subtree ()
+  "Unmark all messages in the thread tree rooted at the current message."
+  (interactive)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-thread-subtree nil))
+
+(defun vm-mark-or-unmark-thread-subtree (mark)
+  (vm-build-threads-if-unbuilt)
+  (let ((list (list (car vm-message-pointer)))
+	(loop-obarray (make-vector 29 0))
+	subject-sym id-sym)
+    (while list
+      (if (not (eq (vm-mark-of (car list)) mark))
+	  (progn
+	    (vm-set-mark-of (car list) mark)
+	    (vm-mark-for-summary-update (car list))))
+      (setq id-sym (car (vm-last (vm-th-thread-list (car list)))))
+      (if (null (intern-soft (symbol-name id-sym) loop-obarray))
+	  (progn
+	    (intern (symbol-name id-sym) loop-obarray)
+	    (nconc list (copy-sequence (get id-sym 'children)))
+	    (setq subject-sym (intern (vm-so-sortable-subject (car list))
+				      vm-thread-subject-obarray))
+	    (if (and (boundp subject-sym) 
+		     (eq id-sym (aref (symbol-value subject-sym) 0)))
+		(nconc list (copy-sequence
+			     (aref (symbol-value subject-sym) 2))))))
+      (setq list (cdr list))))
+  (vm-display nil nil
+	      '(vm-mark-thread-subtree vm-unmark-thread-subtree)
+	      (list this-command 'marking-message))
+  (vm-update-summary-and-mode-line))
+
+(defun vm-mark-messages-same-subject ()
+  "Mark all messages with the same subject as the current message."
+  (interactive)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-messages-same-subject t))
+
+(defun vm-unmark-messages-same-subject ()
+  "Unmark all messages with the same subject as the current message."
+  (interactive)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-messages-same-subject nil))
+
+(defun vm-mark-or-unmark-messages-same-subject (mark)
+  (let ((mp vm-message-list)
+	(mark-count 0)
+	(subject (vm-so-sortable-subject (car vm-message-pointer))))
+    (while mp
+      (if (and (not (eq (vm-mark-of (car mp)) mark))
+	       (string-equal subject (vm-so-sortable-subject (car mp))))
+	  (progn
+	    (vm-set-mark-of (car mp) mark)
+	    (vm-increment mark-count)
+	    (vm-mark-for-summary-update (car mp) t)))
+      (setq mp (cdr mp)))
+    (if (zerop mark-count)
+	(message "No messages %smarked" (if mark "" "un"))
+      (message "%d message%s %smarked"
+	       mark-count
+	       (if (= 1 mark-count) "" "s")
+	       (if mark "" "un"))))
+  (vm-display nil nil
+	      '(vm-mark-messages-same-subject
+		vm-unmark-messages-same-subject)
+	      (list this-command 'marking-message))
+  (vm-update-summary-and-mode-line))
+
+(defun vm-mark-messages-same-author ()
+  "Mark all messages with the same author as the current message."
+  (interactive)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-messages-same-author t))
+
+(defun vm-unmark-messages-same-author ()
+  "Unmark all messages with the same author as the current message."
+  (interactive)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-mark-or-unmark-messages-same-author nil))
+
+(defun vm-mark-or-unmark-messages-same-author (mark)
+  (let ((mp vm-message-list)
+	(mark-count 0)
+	(author (vm-su-from (car vm-message-pointer))))
+    (while mp
+      (if (and (not (eq (vm-mark-of (car mp)) mark))
+	       (string-equal author (vm-su-from (car mp))))
+	  (progn
+	    (vm-set-mark-of (car mp) mark)
+	    (vm-increment mark-count)
+	    (vm-mark-for-summary-update (car mp) t)))
+      (setq mp (cdr mp)))
+    (if (zerop mark-count)
+	(message "No messages %smarked" (if mark "" "un"))
+      (message "%d message%s %smarked"
+	       mark-count
+	       (if (= 1 mark-count) "" "s")
+	       (if mark "" "un"))))
+  (vm-display nil nil
+	      '(vm-mark-messages-same-author
+		vm-unmark-messages-same-author)
+	      (list this-command 'marking-message))
+  (vm-update-summary-and-mode-line))
+
+(defun vm-next-command-uses-marks ()
+  "Does nothing except insure that the next VM command will operate only
+on the marked messages in the current folder."
+  (interactive)
+  (setq this-command 'vm-next-command-uses-marks)
+  (vm-unsaved-message "Next command uses marks...")
+  (vm-display nil nil '(vm-next-command-uses-marks)
+	      '(vm-next-command-uses-marks)))
+
+(defun vm-marked-messages ()
+  (let (list (mp vm-message-list))
+    (while mp
+      (if (vm-mark-of (car mp))
+	  (setq list (cons (car mp) list)))
+      (setq mp (cdr mp)))
+    (nreverse list)))
+
+(defun vm-mark-help ()
+  (interactive)
+  (vm-display nil nil '(vm-mark-help) '(vm-mark-help))
+  (message "MM = mark, MU = unmark, Mm = mark all, Mu = unmark all, MN = use marks, ..."))