Allow using `gnus-parameters' while splitting mail
[gnus] / lisp / gnus-salt.el
index 7c3dfee..ce6bcd7 100644 (file)
@@ -1,14 +1,16 @@
 ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Copyright (C) 1996-1999, 2001-2014 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+(eval-when-compile
+  (when (featurep 'xemacs)
+    (require 'easy-mmode))) ; for `define-minor-mode'
+
 (require 'gnus)
 (require 'gnus-sum)
+(require 'gnus-win)
 
 ;;;
 ;;; gnus-pick-mode
 ;;;
 
-(defvar gnus-pick-mode nil
-  "Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
+(defcustom gnus-pick-display-summary nil
+  "*Display summary while reading."
+  :type 'boolean
+  :group 'gnus-summary-pick)
 
-(defvar gnus-pick-display-summary nil
-  "*Display summary while reading.")
+(defcustom gnus-pick-mode-hook nil
+  "Hook run in summary pick mode buffers."
+  :type 'hook
+  :group 'gnus-summary-pick)
 
-(defvar gnus-pick-mode-hook nil
-  "Hook run in summary pick mode buffers.")
+(when (featurep 'xemacs)
+  (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add))
 
-(defvar gnus-mark-unpicked-articles-as-read nil
-  "*If non-nil, mark all unpicked articles as read.")
+(defcustom gnus-mark-unpicked-articles-as-read nil
+  "*If non-nil, mark all unpicked articles as read."
+  :type 'boolean
+  :group 'gnus-summary-pick)
 
-(defvar gnus-pick-elegant-flow t
-  "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked.")
+(defcustom gnus-pick-elegant-flow t
+  "If non-nil, `gnus-pick-start-reading' runs
+ `gnus-summary-next-group' when no articles have been picked."
+  :type 'boolean
+  :group 'gnus-summary-pick)
 
-(defvar gnus-summary-pick-line-format
-  "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+(defcustom gnus-summary-pick-line-format
+  "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
   "*The format specification of the lines in pick buffers.
-It accepts the same format specs that `gnus-summary-line-format' does.")
+It accepts the same format specs that `gnus-summary-line-format' does."
+  :type 'string
+  :group 'gnus-summary-pick)
 
 ;;; Internal variables.
 
-(defvar gnus-pick-mode-map nil)
-
-(unless gnus-pick-mode-map
-  (setq gnus-pick-mode-map (make-sparse-keymap))
-
-  (gnus-define-keys
-   gnus-pick-mode-map
-   "t" gnus-uu-mark-thread
-   "T" gnus-uu-unmark-thread
-   " " gnus-pick-next-page
-   "u" gnus-summary-unmark-as-processable
-   "U" gnus-summary-unmark-all-processable
-   "v" gnus-uu-mark-over
-   "r" gnus-uu-mark-region
-   "R" gnus-uu-unmark-region
-   "e" gnus-uu-mark-by-regexp
-   "E" gnus-uu-mark-by-regexp
-   "b" gnus-uu-mark-buffer
-   "B" gnus-uu-unmark-buffer
-   "." gnus-pick-article
-   gnus-down-mouse-2 gnus-pick-mouse-pick-region
-   ;;gnus-mouse-2 gnus-pick-mouse-pick
-   "\r" gnus-pick-start-reading))
+(defvar gnus-pick-mode-map
+  (let ((map (make-sparse-keymap)))
+    (gnus-define-keys map
+      " " gnus-pick-next-page
+      "u" gnus-pick-unmark-article-or-thread
+      "." gnus-pick-article-or-thread
+      gnus-down-mouse-2 gnus-pick-mouse-pick-region
+      "\r" gnus-pick-start-reading)
+    map))
 
 (defun gnus-pick-make-menu-bar ()
   (unless (boundp 'gnus-pick-menu)
     (easy-menu-define
-     gnus-pick-menu gnus-pick-mode-map ""
-     '("Pick"
-       ("Pick"
-       ["Article" gnus-summary-mark-as-processable t]
-       ["Thread" gnus-uu-mark-thread t]
-       ["Region" gnus-uu-mark-region t]
-       ["Regexp" gnus-uu-mark-regexp t]
-       ["Buffer" gnus-uu-mark-buffer t])
-       ("Unpick"
-       ["Article" gnus-summary-unmark-as-processable t]
-       ["Thread" gnus-uu-unmark-thread t]
-       ["Region" gnus-uu-unmark-region t]
-       ["Regexp" gnus-uu-unmark-regexp t]
-       ["Buffer" gnus-uu-unmark-buffer t])
-       ["Start reading" gnus-pick-start-reading t]
-       ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
-
-(defun gnus-pick-mode (&optional arg)
+      gnus-pick-menu gnus-pick-mode-map ""
+      '("Pick"
+       ("Pick"
+        ["Article" gnus-summary-mark-as-processable t]
+        ["Thread" gnus-uu-mark-thread t]
+        ["Region" gnus-uu-mark-region t]
+        ["Regexp" gnus-uu-mark-by-regexp t]
+        ["Buffer" gnus-uu-mark-buffer t])
+       ("Unpick"
+        ["Article" gnus-summary-unmark-as-processable t]
+        ["Thread" gnus-uu-unmark-thread t]
+        ["Region" gnus-uu-unmark-region t]
+        ["Regexp" gnus-uu-unmark-by-regexp t]
+        ["Buffer" gnus-summary-unmark-all-processable t])
+       ["Start reading" gnus-pick-start-reading t]
+       ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
+
+(eval-when-compile
+  (when (featurep 'xemacs)
+    (defvar gnus-pick-mode-on-hook)
+    (defvar gnus-pick-mode-off-hook)))
+
+(define-minor-mode gnus-pick-mode
   "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
 
 \\{gnus-pick-mode-map}"
-  (interactive "P")
-  (when (eq major-mode 'gnus-summary-mode)
-    (when (set (make-local-variable 'gnus-pick-mode)
-              (if (null arg) (not gnus-pick-mode)
-                (> (prefix-numeric-value arg) 0)))
-      ;; Make sure that we don't select any articles upon group entry.
-      (set (make-local-variable 'gnus-auto-select-first) nil)
-      ;; Change line format.
-      (setq gnus-summary-line-format gnus-summary-pick-line-format)
-      (setq gnus-summary-line-format-spec nil)
-      (gnus-update-format-specifications nil 'summary)
-      (gnus-update-summary-mark-positions)
-      (set (make-local-variable 'gnus-summary-goto-unread) 'never)
-      ;; Set up the menu.
-      (when (and menu-bar-mode
-                (gnus-visual-p 'pick-menu 'menu))
-       (gnus-pick-make-menu-bar))
-      (unless (assq 'gnus-pick-mode minor-mode-alist)
-       (push '(gnus-pick-mode " Pick") minor-mode-alist))
-      (unless (assq 'gnus-pick-mode minor-mode-map-alist)
-       (push (cons 'gnus-pick-mode gnus-pick-mode-map)
-             minor-mode-map-alist))
-      (run-hooks 'gnus-pick-mode-hook))))
+  :lighter " Pick" :keymap gnus-pick-mode-map
+  (cond
+   ((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-pick-mode nil))
+   ((not gnus-pick-mode)
+    ;; FIXME: a buffer-local minor mode removing globally from a hook??
+    (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message))
+   (t
+    ;; Make sure that we don't select any articles upon group entry.
+    (set (make-local-variable 'gnus-auto-select-first) nil)
+    ;; Change line format.
+    (setq gnus-summary-line-format gnus-summary-pick-line-format)
+    (setq gnus-summary-line-format-spec nil)
+    (gnus-update-format-specifications nil 'summary)
+    (gnus-update-summary-mark-positions)
+    ;; FIXME: a buffer-local minor mode adding globally to a hook??
+    (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
+    (set (make-local-variable 'gnus-summary-goto-unread) 'never)
+    ;; Set up the menu.
+    (when (gnus-visual-p 'pick-menu 'menu)
+      (gnus-pick-make-menu-bar)))))
+
+(defun gnus-pick-setup-message ()
+  "Make Message do the right thing on exit."
+  (when (and (gnus-buffer-live-p gnus-summary-buffer)
+            (with-current-buffer gnus-summary-buffer
+              gnus-pick-mode))
+    (message-add-action
+     `(gnus-configure-windows ,gnus-current-window-configuration t)
+     'send 'exit 'postpone 'kill)))
 
 (defvar gnus-pick-line-number 1)
 (defun gnus-pick-line-number ()
@@ -138,33 +152,67 @@ If given a prefix, mark all unpicked articles as read."
   (interactive "P")
   (if gnus-newsgroup-processable
       (progn
-        (gnus-summary-limit-to-articles nil)
-        (when (or catch-up gnus-mark-unpicked-articles-as-read)
+       (gnus-summary-limit-to-articles nil)
+       (when (or catch-up gnus-mark-unpicked-articles-as-read)
          (gnus-summary-limit-mark-excluded-as-read))
-        (gnus-summary-first-article)
-        (gnus-configure-windows 
+       (gnus-summary-first-article)
+       (gnus-configure-windows
         (if gnus-pick-display-summary 'article 'pick) t))
     (if gnus-pick-elegant-flow
-       (if (gnus-group-quit-config gnus-newsgroup-name)
-           (gnus-summary-exit)
-         (gnus-summary-next-group))
+       (progn
+         (when (or catch-up gnus-mark-unpicked-articles-as-read)
+           (gnus-summary-catchup nil t))
+         (if (gnus-group-quit-config gnus-newsgroup-name)
+             (gnus-summary-exit)
+           (gnus-summary-next-group)))
       (error "No articles have been picked"))))
 
+(defun gnus-pick-goto-article (arg)
+  "Go to the article number indicated by ARG.
+If ARG is an invalid article number, then stay on current line."
+  (let (pos)
+    (save-excursion
+      (goto-char (point-min))
+      (when (zerop (forward-line (1- (prefix-numeric-value arg))))
+       (setq pos (point))))
+    (if (not pos)
+       (gnus-error 2 "No such line: %s" arg)
+      (goto-char pos))))
+
 (defun gnus-pick-article (&optional arg)
   "Pick the article on the current line.
 If ARG, pick the article on that line instead."
   (interactive "P")
   (when arg
-    (let (pos)
-      (save-excursion
-       (goto-char (point-min))
-       (when (zerop (forward-line (1- (prefix-numeric-value arg))))
-         (setq pos (point))))
-      (if (not pos)
-         (gnus-error 2 "No such line: %s" arg)
-       (goto-char pos))))
+    (gnus-pick-goto-article arg))
   (gnus-summary-mark-as-processable 1))
 
+(defun gnus-pick-article-or-thread (&optional arg)
+  "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line.
+Otherwise pick the article on the current line.
+If ARG, pick the article/thread on that line instead."
+  (interactive "P")
+  (when arg
+    (gnus-pick-goto-article arg))
+  (if gnus-thread-hide-subtree
+      (progn
+       (save-excursion
+         (gnus-uu-mark-thread))
+       (forward-line 1))
+    (gnus-summary-mark-as-processable 1)))
+
+(defun gnus-pick-unmark-article-or-thread (&optional arg)
+  "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line.
+Otherwise unmark the article on current line.
+If ARG, unmark thread/article on that line instead."
+  (interactive "P")
+  (when arg
+    (gnus-pick-goto-article arg))
+  (if gnus-thread-hide-subtree
+      (save-excursion
+       (gnus-uu-unmark-thread))
+    (gnus-summary-unmark-as-processable 1)))
+
 (defun gnus-pick-mouse-pick (e)
   (interactive "e")
   (mouse-set-point e)
@@ -179,10 +227,9 @@ This must be bound to a button-down mouse event."
   (let* ((echo-keystrokes 0)
         (start-posn (event-start start-event))
         (start-point (posn-point start-posn))
-         (start-line (1+ (count-lines 1 start-point)))
+         (start-line (1+ (count-lines (point-min) start-point)))
         (start-window (posn-window start-posn))
-        (start-frame (window-frame start-window))
-        (bounds (window-edges start-window))
+        (bounds (gnus-window-edges start-window))
         (top (nth 1 bounds))
         (bottom (if (window-minibuffer-p start-window)
                     (nth 3 bounds)
@@ -192,7 +239,7 @@ This must be bound to a button-down mouse event."
     (setq mouse-selection-click-count click-count)
     (setq mouse-selection-click-count-buffer (current-buffer))
     (mouse-set-point start-event)
-    ;; In case the down click is in the middle of some intangible text,
+   ;; In case the down click is in the middle of some intangible text,
     ;; use the end of that text, and put it in START-POINT.
     (when (< (point) start-point)
       (goto-char start-point))
@@ -201,129 +248,121 @@ This must be bound to a button-down mouse event."
     ;; end-of-range is used only in the single-click case.
     ;; It is the place where the drag has reached so far
     ;; (but not outside the window where the drag started).
-    (let (event end end-point last-end-point (end-of-range (point)))
+    (let (event end end-point (end-of-range (point)))
       (track-mouse
-       (while (progn
-               (setq event (read-event))
-               (or (mouse-movement-p event)
-                   (eq (car-safe event) 'switch-frame)))
-        (if (eq (car-safe event) 'switch-frame)
-            nil
-          (setq end (event-end event)
-                end-point (posn-point end))
-          (when end-point
-            (setq last-end-point end-point))
-
-          (cond
-           ;; Are we moving within the original window?
-           ((and (eq (posn-window end) start-window)
-                 (integer-or-marker-p end-point))
-            ;; Go to START-POINT first, so that when we move to END-POINT,
-            ;; if it's in the middle of intangible text,
-            ;; point jumps in the direction away from START-POINT.
-            (goto-char start-point)
-            (goto-char end-point)
-            (gnus-pick-article)
-            ;; In case the user moved his mouse really fast, pick
-            ;; articles on the line between this one and the last one.
-            (let* ((this-line (1+ (count-lines 1 end-point)))
-                   (min-line (min this-line start-line))
-                   (max-line (max this-line start-line)))
-              (while (< min-line max-line)
-                (goto-line min-line)
-                (gnus-pick-article)
-                (setq min-line (1+ min-line)))
-              (setq start-line this-line))
-            (when (zerop (% click-count 3))
-              (setq end-of-range (point))))
-           (t
-            (let ((mouse-row (cdr (cdr (mouse-position)))))
-              (cond
-               ((null mouse-row))
-               ((< mouse-row top)
-                (mouse-scroll-subr start-window (- mouse-row top)))
-               ((>= mouse-row bottom)
-                (mouse-scroll-subr start-window
-                                   (1+ (- mouse-row bottom)))))))))))
+       (while (progn
+                (setq event (cdr (gnus-read-event-char)))
+                (or (mouse-movement-p event)
+                    (eq (car-safe event) 'switch-frame)))
+         (if (eq (car-safe event) 'switch-frame)
+             nil
+           (setq end (event-end event)
+                 end-point (posn-point end))
+
+           (cond
+            ;; Are we moving within the original window?
+            ((and (eq (posn-window end) start-window)
+                  (integer-or-marker-p end-point))
+             ;; Go to START-POINT first, so that when we move to END-POINT,
+             ;; if it's in the middle of intangible text,
+             ;; point jumps in the direction away from START-POINT.
+             (goto-char start-point)
+             (goto-char end-point)
+             (gnus-pick-article)
+             ;; In case the user moved his mouse really fast, pick
+             ;; articles on the line between this one and the last one.
+             (let* ((this-line (1+ (count-lines (point-min) end-point)))
+                    (min-line (min this-line start-line))
+                    (max-line (max this-line start-line)))
+               (while (< min-line max-line)
+                 (goto-char (point-min))
+                 (forward-line (1- min-line))
+                 (gnus-pick-article)
+                 (setq min-line (1+ min-line)))
+               (setq start-line this-line))
+             (when (zerop (% click-count 3))
+               (setq end-of-range (point))))
+            (t
+             (let ((mouse-row (cdr (cdr (mouse-position)))))
+               (cond
+                ((null mouse-row))
+                ((< mouse-row top)
+                 (mouse-scroll-subr start-window (- mouse-row top)))
+                ((>= mouse-row bottom)
+                 (mouse-scroll-subr start-window
+                                    (1+ (- mouse-row bottom)))))))))))
       (when (consp event)
-       (let ((fun (key-binding (vector (car event)))))
+       (let (;; (fun (key-binding (vector (car event))))
+              )
          ;; Run the binding of the terminating up-event, if possible.
-         ;; In the case of a multiple click, it gives the wrong results,
+          ;; In the case of a multiple click, it gives the wrong results,
          ;; because it would fail to set up a region.
          (when nil
-           ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
-           ;; In this case, we can just let the up-event execute normally.
+            ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+            ;; In this case, we can just let the up-event execute normally.
            (let ((end (event-end event)))
              ;; Set the position in the event before we replay it,
              ;; because otherwise it may have a position in the wrong
              ;; buffer.
              (setcar (cdr end) end-of-range)
              ;; Delete the overlay before calling the function,
-             ;; because delete-overlay increases buffer-modified-tick.
+              ;; because delete-overlay increases buffer-modified-tick.
              (push event unread-command-events))))))))
 
+(defvar scroll-in-place)
+
 (defun gnus-pick-next-page ()
   "Go to the next page.  If at the end of the buffer, start reading articles."
   (interactive)
-  (condition-case nil
-      (scroll-up)
-    (end-of-buffer (gnus-pick-start-reading))))
+  (let ((scroll-in-place nil))
+    (condition-case nil
+       (scroll-up)
+      (end-of-buffer (gnus-pick-start-reading)))))
 
 ;;;
 ;;; gnus-binary-mode
 ;;;
 
-(defvar gnus-binary-mode nil
-  "Minor mode for providing a binary group interface in Gnus summary buffers.")
-
 (defvar gnus-binary-mode-hook nil
   "Hook run in summary binary mode buffers.")
 
-(defvar gnus-binary-mode-map nil)
-
-(unless gnus-binary-mode-map
-  (setq gnus-binary-mode-map (make-sparse-keymap))
-
-  (gnus-define-keys
-   gnus-binary-mode-map
-   "g" gnus-binary-show-article))
+(defvar gnus-binary-mode-map
+  (let ((map (make-sparse-keymap)))
+    (gnus-define-keys map
+      "g" gnus-binary-show-article)
+    map))
 
 (defun gnus-binary-make-menu-bar ()
   (unless (boundp 'gnus-binary-menu)
     (easy-menu-define
-     gnus-binary-menu gnus-binary-mode-map ""
-     '("Pick"
-       ["Switch binary mode off" gnus-binary-mode t]))))
+      gnus-binary-menu gnus-binary-mode-map ""
+      '("Pick"
+       ["Switch binary mode off" gnus-binary-mode t]))))
+
+(eval-when-compile
+  (when (featurep 'xemacs)
+    (defvar gnus-binary-mode-on-hook)
+    (defvar gnus-binary-mode-off-hook)))
 
-(defun gnus-binary-mode (&optional arg)
+(define-minor-mode gnus-binary-mode
   "Minor mode for providing a binary group interface in Gnus summary buffers."
-  (interactive "P")
-  (when (eq major-mode 'gnus-summary-mode)
-    (make-local-variable 'gnus-binary-mode)
-    (setq gnus-binary-mode 
-         (if (null arg) (not gnus-binary-mode)
-           (> (prefix-numeric-value arg) 0)))
-    (when gnus-binary-mode
-      ;; Make sure that we don't select any articles upon group entry.
-      (make-local-variable 'gnus-auto-select-first)
-      (setq gnus-auto-select-first nil)
-      (make-local-variable 'gnus-summary-display-article-function)
-      (setq gnus-summary-display-article-function 'gnus-binary-display-article)
-      ;; Set up the menu.
-      (when (and menu-bar-mode
-                (gnus-visual-p 'binary-menu 'menu))
-       (gnus-binary-make-menu-bar))
-      (unless (assq 'gnus-binary-mode minor-mode-alist)
-       (push '(gnus-binary-mode " Binary") minor-mode-alist))
-      (unless (assq 'gnus-binary-mode minor-mode-map-alist)
-       (push (cons 'gnus-binary-mode gnus-binary-mode-map)
-             minor-mode-map-alist))
-      (run-hooks 'gnus-binary-mode-hook))))
-
-(defun gnus-binary-display-article (article &optional all-header)
+  :lighter " Binary" :keymap gnus-binary-mode-map
+  (cond
+   ((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-binary-mode nil))
+   (gnus-binary-mode
+    ;;&