* gnus-art.el (gnus-save-all-headers): Mention it might be overridden.
[gnus] / lisp / gnus-salt.el
1 ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
2
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
4 ;;   2005, 2006 Free Software Foundation, Inc.
5
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
25
26 ;;; Commentary:
27
28 ;;; Code:
29
30 (eval-when-compile (require 'cl))
31
32 (require 'gnus)
33 (require 'gnus-sum)
34 (require 'gnus-win)
35
36 ;;;
37 ;;; gnus-pick-mode
38 ;;;
39
40 (defvar gnus-pick-mode nil
41   "Minor mode for providing a pick-and-read interface in Gnus
42 summary buffers.")
43
44 (defcustom gnus-pick-display-summary nil
45   "*Display summary while reading."
46   :type 'boolean
47   :group 'gnus-summary-pick)
48
49 (defcustom gnus-pick-mode-hook nil
50   "Hook run in summary pick mode buffers."
51   :type 'hook
52   :group 'gnus-summary-pick)
53
54 (when (featurep 'xemacs)
55   (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add))
56
57 (defcustom gnus-mark-unpicked-articles-as-read nil
58   "*If non-nil, mark all unpicked articles as read."
59   :type 'boolean
60   :group 'gnus-summary-pick)
61
62 (defcustom gnus-pick-elegant-flow t
63   "If non-nil, `gnus-pick-start-reading' runs
64  `gnus-summary-next-group' when no articles have been picked."
65   :type 'boolean
66   :group 'gnus-summary-pick)
67
68 (defcustom gnus-summary-pick-line-format
69   "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
70   "*The format specification of the lines in pick buffers.
71 It accepts the same format specs that `gnus-summary-line-format' does."
72   :type 'string
73   :group 'gnus-summary-pick)
74
75 ;;; Internal variables.
76
77 (defvar gnus-pick-mode-map nil)
78
79 (unless gnus-pick-mode-map
80   (setq gnus-pick-mode-map (make-sparse-keymap))
81
82   (gnus-define-keys gnus-pick-mode-map
83     " " gnus-pick-next-page
84     "u" gnus-pick-unmark-article-or-thread
85     "." gnus-pick-article-or-thread
86     gnus-down-mouse-2 gnus-pick-mouse-pick-region
87     "\r" gnus-pick-start-reading))
88
89 (defun gnus-pick-make-menu-bar ()
90   (unless (boundp 'gnus-pick-menu)
91     (easy-menu-define
92       gnus-pick-menu gnus-pick-mode-map ""
93       '("Pick"
94         ("Pick"
95          ["Article" gnus-summary-mark-as-processable t]
96          ["Thread" gnus-uu-mark-thread t]
97          ["Region" gnus-uu-mark-region t]
98          ["Regexp" gnus-uu-mark-by-regexp t]
99          ["Buffer" gnus-uu-mark-buffer t])
100         ("Unpick"
101          ["Article" gnus-summary-unmark-as-processable t]
102          ["Thread" gnus-uu-unmark-thread t]
103          ["Region" gnus-uu-unmark-region t]
104          ["Regexp" gnus-uu-unmark-by-regexp t]
105          ["Buffer" gnus-summary-unmark-all-processable t])
106         ["Start reading" gnus-pick-start-reading t]
107         ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
108
109 (defun gnus-pick-mode (&optional arg)
110   "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
111
112 \\{gnus-pick-mode-map}"
113   (interactive "P")
114   (when (eq major-mode 'gnus-summary-mode)
115     (if (not (set (make-local-variable 'gnus-pick-mode)
116                   (if (null arg) (not gnus-pick-mode)
117                     (> (prefix-numeric-value arg) 0))))
118         (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
119       ;; Make sure that we don't select any articles upon group entry.
120       (set (make-local-variable 'gnus-auto-select-first) nil)
121       ;; Change line format.
122       (setq gnus-summary-line-format gnus-summary-pick-line-format)
123       (setq gnus-summary-line-format-spec nil)
124       (gnus-update-format-specifications nil 'summary)
125       (gnus-update-summary-mark-positions)
126       (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
127       (set (make-local-variable 'gnus-summary-goto-unread) 'never)
128       ;; Set up the menu.
129       (when (gnus-visual-p 'pick-menu 'menu)
130         (gnus-pick-make-menu-bar))
131       (add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map)
132       (gnus-run-hooks 'gnus-pick-mode-hook))))
133
134 (defun gnus-pick-setup-message ()
135   "Make Message do the right thing on exit."
136   (when (and (gnus-buffer-live-p gnus-summary-buffer)
137              (save-excursion
138                (set-buffer gnus-summary-buffer)
139                gnus-pick-mode))
140     (message-add-action
141      '(gnus-configure-windows ,gnus-current-window-configuration t)
142      'send 'exit 'postpone 'kill)))
143
144 (defvar gnus-pick-line-number 1)
145 (defun gnus-pick-line-number ()
146   "Return the current line number."
147   (if (bobp)
148       (setq gnus-pick-line-number 1)
149     (incf gnus-pick-line-number)))
150
151 (defun gnus-pick-start-reading (&optional catch-up)
152   "Start reading the picked articles.
153 If given a prefix, mark all unpicked articles as read."
154   (interactive "P")
155   (if gnus-newsgroup-processable
156       (progn
157         (gnus-summary-limit-to-articles nil)
158         (when (or catch-up gnus-mark-unpicked-articles-as-read)
159           (gnus-summary-limit-mark-excluded-as-read))
160         (gnus-summary-first-article)
161         (gnus-configure-windows
162          (if gnus-pick-display-summary 'article 'pick) t))
163     (if gnus-pick-elegant-flow
164         (progn
165           (when (or catch-up gnus-mark-unpicked-articles-as-read)
166             (gnus-summary-catchup nil t))
167           (if (gnus-group-quit-config gnus-newsgroup-name)
168               (gnus-summary-exit)
169             (gnus-summary-next-group)))
170       (error "No articles have been picked"))))
171
172 (defun gnus-pick-goto-article (arg)
173   "Go to the article number indicated by ARG.
174 If ARG is an invalid article number, then stay on current line."
175   (let (pos)
176     (save-excursion
177       (goto-char (point-min))
178       (when (zerop (forward-line (1- (prefix-numeric-value arg))))
179         (setq pos (point))))
180     (if (not pos)
181         (gnus-error 2 "No such line: %s" arg)
182       (goto-char pos))))
183
184 (defun gnus-pick-article (&optional arg)
185   "Pick the article on the current line.
186 If ARG, pick the article on that line instead."
187   (interactive "P")
188   (when arg
189     (gnus-pick-goto-article arg))
190   (gnus-summary-mark-as-processable 1))
191
192 (defun gnus-pick-article-or-thread (&optional arg)
193   "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line.
194 Otherwise pick the article on the current line.
195 If ARG, pick the article/thread on that line instead."
196   (interactive "P")
197   (when arg
198     (gnus-pick-goto-article arg))
199   (if gnus-thread-hide-subtree
200       (progn
201         (save-excursion
202           (gnus-uu-mark-thread))
203         (forward-line 1))
204     (gnus-summary-mark-as-processable 1)))
205
206 (defun gnus-pick-unmark-article-or-thread (&optional arg)
207   "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line.
208 Otherwise unmark the article on current line.
209 If ARG, unmark thread/article on that line instead."
210   (interactive "P")
211   (when arg
212     (gnus-pick-goto-article arg))
213   (if gnus-thread-hide-subtree
214       (save-excursion
215         (gnus-uu-unmark-thread))
216     (gnus-summary-unmark-as-processable 1)))
217
218 (defun gnus-pick-mouse-pick (e)
219   (interactive "e")
220   (mouse-set-point e)
221   (save-excursion
222     (gnus-summary-mark-as-processable 1)))
223
224 (defun gnus-pick-mouse-pick-region (start-event)
225   "Pick articles that the mouse is dragged over.
226 This must be bound to a button-down mouse event."
227   (interactive "e")
228   (mouse-minibuffer-check start-event)
229   (let* ((echo-keystrokes 0)
230          (start-posn (event-start start-event))
231          (start-point (posn-point start-posn))
232          (start-line (1+ (count-lines (point-min) start-point)))
233          (start-window (posn-window start-posn))
234          (bounds (gnus-window-edges start-window))
235          (top (nth 1 bounds))
236          (bottom (if (window-minibuffer-p start-window)
237                      (nth 3 bounds)
238                    ;; Don't count the mode line.
239                    (1- (nth 3 bounds))))
240          (click-count (1- (event-click-count start-event))))
241     (setq mouse-selection-click-count click-count)
242     (setq mouse-selection-click-count-buffer (current-buffer))
243     (mouse-set-point start-event)
244    ;; In case the down click is in the middle of some intangible text,
245     ;; use the end of that text, and put it in START-POINT.
246     (when (< (point) start-point)
247       (goto-char start-point))
248     (gnus-pick-article)
249     (setq start-point (point))
250     ;; end-of-range is used only in the single-click case.
251     ;; It is the place where the drag has reached so far
252     ;; (but not outside the window where the drag started).
253     (let (event end end-point (end-of-range (point)))
254       (track-mouse
255         (while (progn
256                  (setq event (cdr (gnus-read-event-char)))
257                  (or (mouse-movement-p event)
258                      (eq (car-safe event) 'switch-frame)))
259           (if (eq (car-safe event) 'switch-frame)
260               nil
261             (setq end (event-end event)
262                   end-point (posn-point end))
263
264             (cond
265              ;; Are we moving within the original window?
266              ((and (eq (posn-window end) start-window)
267                    (integer-or-marker-p end-point))
268               ;; Go to START-POINT first, so that when we move to END-POINT,
269               ;; if it's in the middle of intangible text,
270               ;; point jumps in the direction away from START-POINT.
271               (goto-char start-point)
272               (goto-char end-point)
273               (gnus-pick-article)
274               ;; In case the user moved his mouse really fast, pick
275               ;; articles on the line between this one and the last one.
276               (let* ((this-line (1+ (count-lines (point-min) end-point)))
277                      (min-line (min this-line start-line))
278                      (max-line (max this-line start-line)))
279                 ;; Why not use `forward-line'?  --Stef
280                 (while (< min-line max-line)
281                   (goto-line min-line)
282                   (gnus-pick-article)
283                   (setq min-line (1+ min-line)))
284                 (setq start-line this-line))
285               (when (zerop (% click-count 3))
286                 (setq end-of-range (point))))
287              (t
288               (let ((mouse-row (cdr (cdr (mouse-position)))))
289                 (cond
290                  ((null mouse-row))
291                  ((< mouse-row top)
292                   (mouse-scroll-subr start-window (- mouse-row top)))
293                  ((>= mouse-row bottom)
294                   (mouse-scroll-subr start-window
295                                      (1+ (- mouse-row bottom)))))))))))
296       (when (consp event)
297         (let ((fun (key-binding (vector (car event)))))
298           ;; Run the binding of the terminating up-event, if possible.
299        ;; In the case of a multiple click, it gives the wrong results,
300           ;; because it would fail to set up a region.
301           (when nil
302       ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
303        ;; In this case, we can just let the up-event execute normally.
304             (let ((end (event-end event)))
305               ;; Set the position in the event before we replay it,
306               ;; because otherwise it may have a position in the wrong
307               ;; buffer.
308               (setcar (cdr end) end-of-range)
309               ;; Delete the overlay before calling the function,
310              ;; because delete-overlay increases buffer-modified-tick.
311               (push event unread-command-events))))))))
312
313 (defun gnus-pick-next-page ()
314   "Go to the next page.  If at the end of the buffer, start reading articles."
315   (interactive)
316   (let ((scroll-in-place nil))
317     (condition-case nil
318         (scroll-up)
319       (end-of-buffer (gnus-pick-start-reading)))))
320
321 ;;;
322 ;;; gnus-binary-mode
323 ;;;
324
325 (defvar gnus-binary-mode nil
326   "Minor mode for providing a binary group interface in Gnus summary buffers.")
327
328 (defvar gnus-binary-mode-hook nil
329   "Hook run in summary binary mode buffers.")
330
331 (defvar gnus-binary-mode-map nil)
332
333 (unless gnus-binary-mode-map
334   (setq gnus-binary-mode-map (make-sparse-keymap))
335
336   (gnus-define-keys
337       gnus-binary-mode-map
338     "g" gnus-binary-show-article))
339
340 (defun gnus-binary-make-menu-bar ()
341   (unless (boundp 'gnus-binary-menu)
342     (easy-menu-define
343       gnus-binary-menu gnus-binary-mode-map ""
344       '("Pick"
345         ["Switch binary mode off" gnus-binary-mode t]))))
346
347 (defun gnus-binary-mode (&optional arg)
348   "Minor mode for providing a binary group interface in Gnus summary buffers."
349   (interactive "P")
350   (when (eq major-mode 'gnus-summary-mode)
351     (make-local-variable 'gnus-binary-mode)
352     (setq gnus-binary-mode
353           (if (null arg) (not gnus-binary-mode)
354             (> (prefix-numeric-value arg) 0)))
355     (when gnus-binary-mode
356       ;; Make sure that we don't select any articles upon group entry.
357       (make-local-variable 'gnus-auto-select-first)
358       (setq gnus-auto-select-first nil)
359       (make-local-variable 'gnus-summary-display-article-function)
360       (setq gnus-summary-display-article-function 'gnus-binary-display-article)
361       ;; Set up the menu.
362       (when (gnus-visual-p 'binary-menu 'menu)
363         (gnus-binary-make-menu-bar))
364       (add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map)
365       (gnus-run-hooks 'gnus-binary-mode-hook))))
366
367 (defun gnus-binary-display-article (article &optional all-header)
368   "Run ARTICLE through the binary decode functions."
369   (when (gnus-summary-goto-subject article)
370     (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
371       (gnus-uu-decode-uu))))
372
373 (defun gnus-binary-show-article (&optional arg)
374   "Bypass the binary functions and show the article."
375   (interactive "P")
376   (let (gnus-summary-display-article-function)
377     (gnus-summary-show-article arg)))
378
379 ;;;
380 ;;; gnus-tree-mode
381 ;;;
382
383 (defcustom gnus-tree-line-format "%(%[%3,3n%]%)"
384   "Format of tree elements."
385   :type 'string
386   :group 'gnus-summary-tree)
387
388 (defcustom gnus-tree-minimize-window t
389   "If non-nil, minimize the tree buffer window.
390 If a number, never let the tree buffer grow taller than that number of
391 lines."
392   :type '(choice boolean
393                  integer)
394   :group 'gnus-summary-tree)
395
396 (defcustom gnus-selected-tree-face 'modeline
397   "*Face used for highlighting selected articles in the thread tree."
398   :type 'face
399   :group 'gnus-summary-tree)
400
401 (defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
402                              (?\{ . ?\}) (?< . ?>))
403   "Brackets used in tree nodes.")
404
405 (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
406   "Characters used to connect parents with children.")
407
408 (defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z"
409   "*The format specification for the tree mode line."
410   :type 'string
411   :group 'gnus-summary-tree)
412
413 (defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree
414   "*Function for generating a thread tree.
415 Two predefined functions are available:
416 `gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'."
417   :type '(radio (function-item gnus-generate-vertical-tree)
418                 (function-item gnus-generate-horizontal-tree)
419                 (function :tag "Other" nil))
420   :group 'gnus-summary-tree)
421
422 (defcustom gnus-tree-mode-hook nil
423   "*Hook run in tree mode buffers."
424   :type 'hook
425   :group 'gnus-summary-tree)
426
427 (when (featurep 'xemacs)
428   (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add)
429   (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off))
430
431
432 ;;; Internal variables.
433
434 (defvar gnus-tree-line-format-alist
435   `((?n gnus-tmp-name ?s)
436     (?f gnus-tmp-from ?s)
437     (?N gnus-tmp-number ?d)
438     (?\[ gnus-tmp-open-bracket ?c)
439     (?\] gnus-tmp-close-bracket ?c)
440     (?s gnus-tmp-subject ?s)))
441
442 (defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist)
443
444 (defvar gnus-tree-mode-line-format-spec nil)
445 (defvar gnus-tree-line-format-spec nil)
446
447 (defvar gnus-tree-node-length nil)
448 (defvar gnus-selected-tree-overlay nil)
449
450 (defvar gnus-tree-displayed-thread nil)
451 (defvar gnus-tree-inhibit nil)
452
453 (defvar gnus-tree-mode-map nil)
454 (put 'gnus-tree-mode 'mode-class 'special)
455
456 (unless gnus-tree-mode-map
457   (setq gnus-tree-mode-map (make-keymap))
458   (suppress-keymap gnus-tree-mode-map)
459   (gnus-define-keys
460       gnus-tree-mode-map
461     "\r" gnus-tree-select-article
462     gnus-mouse-2 gnus-tree-pick-article
463     "\C-?" gnus-tree-read-summary-keys
464     "h" gnus-tree-show-summary
465
466     "\C-c\C-i" gnus-info-find-node)
467
468   (substitute-key-definition
469    'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
470
471 (defun gnus-tree-make-menu-bar ()
472   (unless (boundp 'gnus-tree-menu)
473     (easy-menu-define
474       gnus-tree-menu gnus-tree-mode-map ""
475       '("Tree"
476         ["Select article" gnus-tree-select-article t]))))
477
478 (defun gnus-tree-mode ()
479   "Major mode for displaying thread trees."
480   (interactive)
481   (gnus-set-format 'tree-mode)
482   (gnus-set-format 'tree t)
483   (when (gnus-visual-p 'tree-menu 'menu)
484     (gnus-tree-make-menu-bar))
485   (kill-all-local-variables)
486   (gnus-simplify-mode-line)
487   (setq mode-name "Tree")
488   (setq major-mode 'gnus-tree-mode)
489   (use-local-map gnus-tree-mode-map)
490   (buffer-disable-undo)
491   (setq buffer-read-only t)
492   (setq truncate-lines t)
493   (save-excursion
494     (gnus-set-work-buffer)
495     (gnus-tree-node-insert (make-mail-header "") nil)
496     (setq gnus-tree-node-length (1- (point))))
497   (gnus-run-mode-hooks 'gnus-tree-mode-hook))
498
499 (defun gnus-tree-read-summary-keys (&optional arg)
500   "Read a summary buffer key sequence and execute it."
501   (interactive "P")
502   (unless gnus-tree-inhibit
503     (let ((buf (current-buffer))
504           (gnus-tree-inhibit t)
505           win)
506       (set-buffer gnus-article-buffer)
507       (gnus-article-read-summary-keys arg nil t)
508       (when (setq win (get-buffer-window buf))
509         (select-window win)
510         (when gnus-selected-tree-overlay
511           (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
512         (gnus-tree-minimize)))))
513
514 (defun gnus-tree-show-summary ()
515   "Reconfigure windows to show summary buffer."
516   (interactive)
517   (if (not (gnus-buffer-live-p gnus-summary-buffer))
518       (error "There is no summary buffer for this tree buffer")
519     (gnus-configure-windows 'article)
520     (gnus-summary-goto-subject gnus-current-article)))
521
522 (defun gnus-tree-select-article (article)
523   "Select the article under point, if any."
524   (interactive (list (gnus-tree-article-number)))
525   (let ((buf (current-buffer)))
526     (when article
527       (save-excursion
528         (set-buffer gnus-summary-buffer)
529         (gnus-summary-goto-article article))
530       (select-window (get-buffer-window buf)))))
531
532 (defun gnus-tree-pick-article (e)
533   "Select the article under the mouse pointer."
534   (interactive "e")
535   (mouse-set-point e)
536   (gnus-tree-select-article (gnus-tree-article-number)))
537
538 (defun gnus-tree-article-number ()
539   (get-text-property (point) 'gnus-number))
540
541 (defun gnus-tree-article-region (article)
542   "Return a cons with BEG and END of the article region."
543   (let ((pos (text-property-any
544               (point-min) (point-max) 'gnus-number article)))
545     (when pos
546       (cons pos (next-single-property-change pos 'gnus-number)))))
547
548 (defun gnus-tree-goto-article (article)
549   (let ((pos (text-property-any
550               (point-min) (point-max) 'gnus-number article)))
551     (when pos
552       (goto-char pos))))
553
554 (defun gnus-tree-recenter ()
555   "Center point in the tree window."
556   (let ((selected (selected-window))
557         (tree-window (gnus-get-buffer-window gnus-tree-buffer t)))
558     (when tree-window
559       (select-window tree-window)
560       (when gnus-selected-tree-overlay
561         (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
562       (let* ((top (cond ((< (window-height) 4) 0)
563                         ((< (window-height) 7) 1)
564                         (t 2)))
565              (height (1- (window-height)))
566              (bottom (save-excursion (goto-char (point-max))
567                                      (forward-line (- height))
568                                      (point))))
569       ;; Set the window start to either `bottom', which is the biggest
570         ;; possible valid number, or the second line from the top,
571         ;; whichever is the least.
572         (set-window-start
573          tree-window (min bottom (save-excursion
574                                    (forward-line (- top)) (point)))))
575       (select-window selected))))
576
577 (defun gnus-get-tree-buffer ()
578   "Return the tree buffer properly initialized."
579   (save-excursion
580     (set-buffer (gnus-get-buffer-create gnus-tree-buffer))
581     (unless (eq major-mode 'gnus-tree-mode)
582       (gnus-tree-mode))
583     (current-buffer)))
584
585 (defun gnus-tree-minimize ()
586   (when (and gnus-tree-minimize-window
587              (not (one-window-p)))
588     (let ((windows 0)
589           tot-win-height)
590       (walk-windows (lambda (window) (incf windows)))
591       (setq tot-win-height
592             (- (frame-height)
593                (* window-min-height (1- windows))
594                2))
595       (let* ((window-min-height 2)
596              (height (count-lines (point-min) (point-max)))
597              (min (max (1- window-min-height) height))
598              (tot (if (numberp gnus-tree-minimize-window)
599                       (min gnus-tree-minimize-window min)
600                     min))
601              (win (get-buffer-window (current-buffer)))
602              (wh (and win (1- (window-height win)))))
603         (setq tot (min tot tot-win-height))
604         (when (