diff lisp/gnus/gnus-salt.el @ 98:0d2f883870bc r20-1b1

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children 360340f9fd5f
line wrap: on
line diff
--- a/lisp/gnus/gnus-salt.el	Mon Aug 13 09:12:43 2007 +0200
+++ b/lisp/gnus/gnus-salt.el	Mon Aug 13 09:13:56 2007 +0200
@@ -1,5 +1,5 @@
 ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 
@@ -25,7 +25,7 @@
 ;;; Code:
 
 (require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-sum)
 
 ;;;
 ;;; gnus-pick-mode
@@ -40,6 +40,17 @@
 (defvar gnus-pick-mode-hook nil
   "Hook run in summary pick mode buffers.")
 
+(defvar gnus-mark-unpicked-articles-as-read nil
+  "*If non-nil, mark all unpicked articles as read.")
+
+(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.")
+
+(defvar gnus-summary-pick-line-format
+  "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+  "*The format specification of the lines in pick buffers.
+It accepts the same format specs that `gnus-summary-line-format' does.")
+
 ;;; Internal variables.
 
 (defvar gnus-pick-mode-map nil)
@@ -51,7 +62,7 @@
    gnus-pick-mode-map
    "t" gnus-uu-mark-thread
    "T" gnus-uu-unmark-thread
-   " " gnus-summary-mark-as-processable
+   " " gnus-pick-next-page
    "u" gnus-summary-unmark-as-processable
    "U" gnus-summary-unmark-all-processable
    "v" gnus-uu-mark-over
@@ -61,6 +72,10 @@
    "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
+   "X" gnus-pick-start-reading
    "\r" gnus-pick-start-reading))
 
 (defun gnus-pick-make-menu-bar ()
@@ -89,17 +104,21 @@
 \\{gnus-pick-mode-map}"
   (interactive "P")
   (when (eq major-mode 'gnus-summary-mode)
-    (make-local-variable 'gnus-pick-mode)
-    (setq gnus-pick-mode 
-	  (if (null arg) (not gnus-pick-mode)
-	    (> (prefix-numeric-value arg) 0)))
-    (when gnus-pick-mode
+    (if (not (set (make-local-variable 'gnus-pick-mode)
+		  (if (null arg) (not gnus-pick-mode)
+		    (> (prefix-numeric-value arg) 0))))
+	(remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
       ;; 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)
+      (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)
+      (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
+      (set (make-local-variable 'gnus-summary-goto-unread) 'never)
       ;; Set up the menu.
-      (when (and menu-bar-mode
-		 (gnus-visual-p 'pick-menu 'menu))
+      (when (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))
@@ -108,25 +127,169 @@
 	      minor-mode-map-alist))
       (run-hooks 'gnus-pick-mode-hook))))
 
+(defun gnus-pick-setup-message ()
+  "Make Message do the right thing on exit."
+  (when (and (gnus-buffer-live-p gnus-summary-buffer)
+	     (save-excursion
+	       (set-buffer gnus-summary-buffer)
+	       gnus-pick-mode))
+    (message-add-action 
+     '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill)))
+
+(defvar gnus-pick-line-number 1)
+(defun gnus-pick-line-number ()
+  "Return the current line number."
+  (if (bobp)
+      (setq gnus-pick-line-number 1)
+    (incf gnus-pick-line-number)))
+
 (defun gnus-pick-start-reading (&optional catch-up)
   "Start reading the picked articles.
 If given a prefix, mark all unpicked articles as read."
   (interactive "P")
-  (unless gnus-newsgroup-processable
-    (error "No articles have been picked"))
-  (gnus-summary-limit-to-articles nil)
-  (when catch-up
-    (gnus-summary-limit-mark-excluded-as-read))
-  (gnus-summary-first-unread-article)
-  (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
+  (if gnus-newsgroup-processable
+      (progn
+        (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 
+	 (if gnus-pick-display-summary 'article 'pick) t))
+    (if gnus-pick-elegant-flow
+	(progn
+	  (when (or catch-up gnus-mark-unpicked-articles-as-read)
+	    (gnus-summary-limit-mark-excluded-as-read))
+	  (if (gnus-group-quit-config gnus-newsgroup-name)
+	      (gnus-summary-exit)
+	    (gnus-summary-next-group)))
+      (error "No articles have been picked"))))
+
+(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-summary-mark-as-processable 1))
+
+(defun gnus-pick-mouse-pick (e)
+  (interactive "e")
+  (mouse-set-point e)
+  (save-excursion
+    (gnus-summary-mark-as-processable 1)))
 
+(defun gnus-pick-mouse-pick-region (start-event)
+  "Pick articles that the mouse is dragged over.
+This must be bound to a button-down mouse event."
+  (interactive "e")
+  (mouse-minibuffer-check start-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-window (posn-window start-posn))
+	 (start-frame (window-frame start-window))
+	 (bounds (window-edges start-window))
+	 (top (nth 1 bounds))
+	 (bottom (if (window-minibuffer-p start-window)
+		     (nth 3 bounds)
+		   ;; Don't count the mode line.
+		   (1- (nth 3 bounds))))
+	 (click-count (1- (event-click-count start-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,
+    ;; use the end of that text, and put it in START-POINT.
+    (when (< (point) start-point)
+      (goto-char start-point))
+    (gnus-pick-article)
+    (setq start-point (point))
+    ;; 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)))
+      (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)))))))))))
+      (when (consp 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,
+	  ;; 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.
+	    (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.
+	      (push event unread-command-events))))))))
+
+(defun gnus-pick-next-page ()
+  "Go to the next page.  If at the end of the buffer, start reading articles."
+  (interactive)
+  (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 provind a binary group interface in Gnus summary buffers.")
+  "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.")
@@ -162,8 +325,7 @@
       (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))
+      (when (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))
@@ -204,7 +366,7 @@
   "Brackets used in tree nodes.")
 
 (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
-  "Charaters used to connect parents with children.")
+  "Characters used to connect parents with children.")
 
 (defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z"
   "*The format specification for the tree mode line.")
@@ -270,8 +432,7 @@
   (setq gnus-tree-line-format-spec 
 	(gnus-parse-format gnus-tree-line-format 
 			   gnus-tree-line-format-alist t))
-  (when (and menu-bar-mode
-	     (gnus-visual-p 'tree-menu 'menu))
+  (when (gnus-visual-p 'tree-menu 'menu)
     (gnus-tree-make-menu-bar))
   (kill-all-local-variables)
   (gnus-simplify-mode-line)
@@ -339,7 +500,7 @@
 	(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
       (let* ((top (cond ((< (window-height) 4) 0)
 			((< (window-height) 7) 1)
-			(t 2))) 
+			(t 2)))
 	     (height (1- (window-height)))
 	     (bottom (save-excursion (goto-char (point-max))
 				     (forward-line (- height))
@@ -368,7 +529,7 @@
 	  tot-win-height)
       (walk-windows (lambda (window) (incf windows)))
       (setq tot-win-height 
-	    (- (frame-height) 
+	    (- (frame-height)
 	       (* window-min-height (1- windows))
 	       2))
       (let* ((window-min-height 2)
@@ -383,9 +544,9 @@
 	(when (and win
 		   (not (eq tot wh)))
 	  (let ((selected (selected-window)))
-	    (select-window win)
-	    (enlarge-window (- tot wh))
-	    (select-window selected)))))))
+	    (when (ignore-errors (select-window win))
+	      (enlarge-window (- tot wh))
+	      (select-window selected))))))))
 
 ;;; Generating the tree.
 
@@ -416,7 +577,7 @@
 	    "***")
 	   (t gnus-tmp-from)))
 	 (gnus-tmp-open-bracket
-	  (cond ((memq gnus-tmp-number sparse) 
+	  (cond ((memq gnus-tmp-number sparse)
 		 (caadr gnus-tree-brackets))
 		(dummy (caaddr gnus-tree-brackets))
 		(adopted (car (nth 3 gnus-tree-brackets)))
@@ -516,11 +677,11 @@
       ;; Recurse downwards in all children of this article.
       (while thread
 	(gnus-generate-horizontal-tree
-	 (pop thread) (if do (1+ level) level) 
+	 (pop thread) (if do (1+ level) level)
 	 (or dummyp dummy) dummy)))))
 
 (defsubst gnus-tree-indent-vertical ()
-  (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) 
+  (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
 		(- (point) (gnus-point-at-bol)))))
     (when (> len 0)
       (insert (make-string len ? )))))
@@ -536,7 +697,9 @@
   "Generate a vertical tree."
   (let* ((dummy (stringp (car thread)))
 	 (do (or dummy
-		 (memq (mail-header-number (car thread)) gnus-tmp-limit)))
+		 (and (car thread)
+		      (memq (mail-header-number (car thread))
+			    gnus-tmp-limit))))
 	 beg)
     (if (not do)
 	;; We don't want this article.
@@ -557,7 +720,8 @@
 	  (setq beg (point))
 	  ;; Draw "-" lines leftwards.
 	  (while (progn
-		   (forward-char -2)
+		   (unless (bolp)
+		     (forward-char -2))
 		   (= (following-char) ? ))
 	    (delete-char 1)
 	    (insert (car gnus-tree-parent-child-edges)))
@@ -577,7 +741,7 @@
       ;; Recurse downwards in all children of this article.
       (while thread
 	(gnus-generate-vertical-tree
-	 (pop thread) (if do (1+ level) level) 
+	 (pop thread) (if do (1+ level) level)
 	 (or dummyp dummy) dummy)))))
 
 ;;; Interface functions.
@@ -587,6 +751,7 @@
   (when (save-excursion
 	  (set-buffer gnus-summary-buffer)
 	  (and gnus-use-trees
+	       gnus-show-threads
 	       (vectorp (gnus-summary-article-header article))))
     (save-excursion
       (let ((top (save-excursion
@@ -594,7 +759,8 @@
 		   (gnus-cut-thread
 		    (gnus-remove-thread 
 		     (mail-header-id 
-		      (gnus-summary-article-header article)) t))))
+		      (gnus-summary-article-header article))
+		     t))))
 	    (gnus-tmp-limit gnus-newsgroup-limit)
 	    (gnus-tmp-sparse gnus-newsgroup-sparse))
 	(when (or force
@@ -606,7 +772,7 @@
   (gnus-get-tree-buffer))
 
 (defun gnus-tree-close (group)
-  ;(gnus-kill-buffer gnus-tree-buffer)
+					;(gnus-kill-buffer gnus-tree-buffer)
   )
 
 (defun gnus-highlight-selected-tree (article)
@@ -646,6 +812,177 @@
 	(set-window-point 
 	 (get-buffer-window (current-buffer) t) (cdr region))))))
 
+;;;
+;;; gnus-carpal
+;;;
+
+(defvar gnus-carpal-group-buffer-buttons
+  '(("next" . gnus-group-next-unread-group)
+    ("prev" . gnus-group-prev-unread-group)
+    ("read" . gnus-group-read-group)
+    ("select" . gnus-group-select-group)
+    ("catch-up" . gnus-group-catchup-current)
+    ("new-news" . gnus-group-get-new-news-this-group)
+    ("toggle-sub" . gnus-group-unsubscribe-current-group)
+    ("subscribe" . gnus-group-unsubscribe-group)
+    ("kill" . gnus-group-kill-group)
+    ("yank" . gnus-group-yank-group)
+    ("describe" . gnus-group-describe-group)
+    "list"
+    ("subscribed" . gnus-group-list-groups)
+    ("all" . gnus-group-list-all-groups)
+    ("killed" . gnus-group-list-killed)
+    ("zombies" . gnus-group-list-zombies)
+    ("matching" . gnus-group-list-matching)
+    ("post" . gnus-group-post-news)
+    ("mail" . gnus-group-mail)
+    ("rescan" . gnus-group-get-new-news)
+    ("browse-foreign" . gnus-group-browse-foreign)
+    ("exit" . gnus-group-exit)))
+
+(defvar gnus-carpal-summary-buffer-buttons
+  '("mark" 
+    ("read" . gnus-summary-mark-as-read-forward)
+    ("tick" . gnus-summary-tick-article-forward)
+    ("clear" . gnus-summary-clear-mark-forward)
+    ("expirable" . gnus-summary-mark-as-expirable)
+    "move"
+    ("scroll" . gnus-summary-next-page)
+    ("next-unread" . gnus-summary-next-unread-article)
+    ("prev-unread" . gnus-summary-prev-unread-article)
+    ("first" . gnus-summary-first-unread-article)
+    ("best" . gnus-summary-best-unread-article)
+    "article"
+    ("headers" . gnus-summary-toggle-header)
+    ("uudecode" . gnus-uu-decode-uu)
+    ("enter-digest" . gnus-summary-enter-digest-group)
+    ("fetch-parent" . gnus-summary-refer-parent-article)
+    "mail"
+    ("move" . gnus-summary-move-article)
+    ("copy" . gnus-summary-copy-article)
+    ("respool" . gnus-summary-respool-article)
+    "threads"
+    ("lower" . gnus-summary-lower-thread)
+    ("kill" . gnus-summary-kill-thread)
+    "post"
+    ("post" . gnus-summary-post-news)
+    ("mail" . gnus-summary-mail)
+    ("followup" . gnus-summary-followup-with-original)
+    ("reply" . gnus-summary-reply-with-original)
+    ("cancel" . gnus-summary-cancel-article)
+    "misc"
+    ("exit" . gnus-summary-exit)
+    ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
+
+(defvar gnus-carpal-server-buffer-buttons 
+  '(("add" . gnus-server-add-server)
+    ("browse" . gnus-server-browse-server)
+    ("list" . gnus-server-list-servers)
+    ("kill" . gnus-server-kill-server)
+    ("yank" . gnus-server-yank-server)
+    ("copy" . gnus-server-copy-server)
+    ("exit" . gnus-server-exit)))
+
+(defvar gnus-carpal-browse-buffer-buttons
+  '(("subscribe" . gnus-browse-unsubscribe-current-group)
+    ("exit" . gnus-browse-exit)))
+
+(defvar gnus-carpal-group-buffer "*Carpal Group*")
+(defvar gnus-carpal-summary-buffer "*Carpal Summary*")
+(defvar gnus-carpal-server-buffer "*Carpal Server*")
+(defvar gnus-carpal-browse-buffer "*Carpal Browse*")
+
+(defvar gnus-carpal-attached-buffer nil)
+
+(defvar gnus-carpal-mode-hook nil
+  "*Hook run in carpal mode buffers.")
+
+(defvar gnus-carpal-button-face 'bold
+  "*Face used on carpal buttons.")
+
+(defvar gnus-carpal-header-face 'bold-italic
+  "*Face used on carpal buffer headers.")
+
+(defvar gnus-carpal-mode-map nil)
+(put 'gnus-carpal-mode 'mode-class 'special)
+
+(if gnus-carpal-mode-map
+    nil
+  (setq gnus-carpal-mode-map (make-keymap))
+  (suppress-keymap gnus-carpal-mode-map)
+  (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
+  (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
+  (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
+
+(defun gnus-carpal-mode ()
+  "Major mode for clicking buttons.
+
+All normal editing commands are switched off.
+\\<gnus-carpal-mode-map>
+The following commands are available:
+
+\\{gnus-carpal-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (setq mode-line-modified "-- ")
+  (setq major-mode 'gnus-carpal-mode)
+  (setq mode-name "Gnus Carpal")
+  (setq mode-line-process nil)
+  (use-local-map gnus-carpal-mode-map)
+  (buffer-disable-undo (current-buffer))
+  (setq buffer-read-only t)
+  (make-local-variable 'gnus-carpal-attached-buffer)
+  (run-hooks 'gnus-carpal-mode-hook))
+
+(defun gnus-carpal-setup-buffer (type)
+  (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
+    (if (get-buffer buffer)
+	()
+      (save-excursion
+	(set-buffer (get-buffer-create buffer))
+	(gnus-carpal-mode)
+	(setq gnus-carpal-attached-buffer 
+	      (intern (format "gnus-%s-buffer" type)))
+	(gnus-add-current-to-buffer-list)
+	(let ((buttons (symbol-value 
+			(intern (format "gnus-carpal-%s-buffer-buttons"
+					type))))
+	      (buffer-read-only nil)
+	      button)
+	  (while buttons
+	    (setq button (car buttons)
+		  buttons (cdr buttons))
+	    (if (stringp button)
+		(gnus-set-text-properties
+		 (point)
+		 (prog2 (insert button) (point) (insert " "))
+		 (list 'face gnus-carpal-header-face))
+	      (gnus-set-text-properties
+	       (point)
+	       (prog2 (insert (car button)) (point) (insert " "))
+	       (list 'gnus-callback (cdr button)
+		     'face gnus-carpal-button-face
+		     gnus-mouse-face-prop 'highlight))))
+	  (let ((fill-column (- (window-width) 2)))
+	    (fill-region (point-min) (point-max)))
+	  (set-window-point (get-buffer-window (current-buffer))
+			    (point-min)))))))
+
+(defun gnus-carpal-select ()
+  "Select the button under point."
+  (interactive)
+  (let ((func (get-text-property (point) 'gnus-callback)))
+    (if (null func)
+	()
+      (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
+      (call-interactively func))))
+
+(defun gnus-carpal-mouse-select (event)
+  "Select the button under the mouse pointer."
+  (interactive "e")
+  (mouse-set-point event)
+  (gnus-carpal-select))
+
 ;;; Allow redefinition of functions.
 (gnus-ems-redefine)