;;; 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.

(defun vm-mark-status (markp count)
  (cond ((and markp (= vm-mark-count count))
	 (message "%d message%s marked" count (if (= 1 count) "" "s")))
	(markp
	 (message "%d message%s marked (total %d)"
		  count (if (= 1 count) "" "s") vm-mark-count))
	(t
	 (message "%d message%s unmarked (%d remaining)"
		  count (if (= 1 count) "" "s") vm-mark-count))))

(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))))
  (let ((omc vm-mark-count))
    (setq vm-mark-count 0)
    (vm-mark-status nil omc))
  (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))))
  (setq vm-mark-count (length vm-message-list))
  (vm-mark-status t vm-mark-count)
  (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))
	(omc vm-mark-count)
	;;(oldmp vm-message-pointer) ;unused
	(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-increment vm-mark-count)
	    (vm-mark-for-summary-update (car vm-message-pointer) t)))
      (vm-decrement count)
      (if (not (zerop count))
	  (vm-move-message-pointer direction)))
    (vm-mark-status t (- vm-mark-count omc)))
  (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))
	(omc vm-mark-count))
    (while mlist
      (if (vm-mark-of (car mlist))
	  (progn
	    (vm-set-mark-of (car mlist) nil)
	    (vm-decrement vm-mark-count)
	    (vm-mark-for-summary-update (car mlist) t)))
      (setq mlist (cdr mlist)))
    (vm-mark-status nil (- omc vm-mark-count)))
  (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 (if vm-mark-search-whole-folder
		   vm-message-list
		 vm-message-pointer))
	(virtual (eq major-mode 'vm-virtual-mode))
	(arglist (if arg (list arg) nil))
	(count 0)
	(omc vm-mark-count))
    (setq selector (intern (concat "vm-vs-" (symbol-name selector))))
    (while mlist
      (if (and (not (eq val (vm-mark-of (car mlist)))) ; already (un)marked
	       (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)
	    (if val
		(vm-increment vm-mark-count)
	      (vm-decrement vm-mark-count))
	    (vm-mark-for-summary-update (car mlist) t)
	    (vm-increment count)))
      (setq mlist (cdr mlist)))
    (vm-mark-status val (vm-abs (- omc vm-mark-count))))
  (vm-display nil nil
	      '(vm-mark-matching-messages vm-unmark-matching-messages)
	      (list this-command 'marking-message))
  (vm-update-summary-and-mode-line))

(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 the 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 the 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)))
	(omc vm-mark-count)
	subject-sym id-sym)
    (while list
      (if (not (eq (vm-mark-of (car list)) mark))
	  (progn
	    (vm-set-mark-of (car list) mark)
	    (if mark
		(vm-increment vm-mark-count)
	      (vm-decrement vm-mark-count))
	    (vm-mark-for-summary-update (car list))))
      (setq id-sym (car (vm-last (vm-th-thread-list (car list)))))
      (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-mark-status mark (vm-abs (- omc vm-mark-count))))
  (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-mark-or-unmark-messages-same-subject-or-author t nil))

(defun vm-unmark-messages-same-subject ()
  "Unmark all messages with the same subject as the current message."
  (interactive)
  (vm-mark-or-unmark-messages-same-subject-or-author nil nil))

(defun vm-mark-messages-same-author ()
  "Mark all messages with the same author as the current message."
  (interactive)
  (vm-mark-or-unmark-messages-same-subject-or-author t t))

(defun vm-unmark-messages-same-author ()
  "Unmark all messages with the same author as the current message."
  (interactive)
  (vm-mark-or-unmark-messages-same-subject-or-author nil t))

(defun vm-mark-or-unmark-messages-same-subject-or-author (mark author-p)
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (let ((mp (if vm-mark-search-whole-folder
		vm-message-list
	      vm-message-pointer))
	(omc vm-mark-count)
	(subject (if (not author-p) (vm-so-sortable-subject
				     (car vm-message-pointer))))
	(name (if author-p (vm-su-full-name (car vm-message-pointer))))
	(from (if author-p (vm-su-from (car vm-message-pointer)))))
    (if (equal name "") (setq name nil)) ; don't match empty names
    (while mp
      (if (and (not (eq (vm-mark-of (car mp)) mark))
	       (if author-p
		   ;; I'm not quite sure what the right thing to do here is:
		   ;; my first thought was to match all messages with the same
		   ;; name or address as the current one.  But that means that
		   ;;    Mailer-Daemon@foo.com (Mail Delivery Subsystem)
		   ;; will match
		   ;;    Mailer-Daemon@bar.com (Mail Delivery Subsystem)
		   ;; which I don't necessarily want.  So let's only match the
		   ;; address.
		   (string-equal from (vm-su-from (car mp)))
		   ;;(or (and name
		   ;;        (string-equal name (vm-su-full-name (car mp))))
		   ;;    (string-equal from (vm-su-from (car mp))))
		 (string-equal subject (vm-so-sortable-subject (car mp)))))
	  (progn
	    (vm-set-mark-of (car mp) mark)
	    (if mark
		(vm-increment vm-mark-count)
	      (vm-decrement vm-mark-count))
	    (vm-mark-for-summary-update (car mp) t)))
      (setq mp (cdr mp)))
    (vm-mark-status mark (vm-abs (- omc vm-mark-count))))
  (vm-display nil nil
	      '(vm-mark-messages-same-subject
		vm-mark-messages-same-author
		vm-unmark-messages-same-subject
		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)
  (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, ..."))