X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-salt.el;h=be9fd4979498b10cabd9a7228cf87914d4407c45;hb=b19ab0bcf7b463d4b14b41bd23f2a5d62d03795a;hp=9fe77ff75028b6fe930a2d66477e241c101bfe68;hpb=fd8763cdcbdbe29405551fac06c104afd8523df0;p=gnus

diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el
index 9fe77ff75..be9fd4979 100644
--- a/lisp/gnus-salt.el
+++ b/lisp/gnus-salt.el
@@ -24,8 +24,8 @@
 
 ;;; Code:
 
-(require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-load)
+(require 'gnus-sum)
 
 ;;;
 ;;; gnus-pick-mode
@@ -40,6 +40,14 @@
 (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-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 +59,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 +69,8 @@
    "E" gnus-uu-mark-by-regexp
    "b" gnus-uu-mark-buffer
    "B" gnus-uu-unmark-buffer
+   "." gnus-pick-article
+   gnus-mouse-2 gnus-pick-pick-article
    "\r" gnus-pick-start-reading))
 
 (defun gnus-pick-make-menu-bar ()
@@ -84,7 +94,9 @@
        ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
 
 (defun gnus-pick-mode (&optional arg)
-  "Minor mode for providing a pick-and-read interface in Gnus summary buffers."
+  "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)
     (make-local-variable 'gnus-pick-mode)
@@ -95,6 +107,11 @@
       ;; 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)
+      ;; 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 up the menu.
       (when (and menu-bar-mode
 		 (gnus-visual-p 'pick-menu 'menu))
@@ -106,6 +123,13 @@
 	      minor-mode-map-alist))
       (run-hooks 'gnus-pick-mode-hook))))
 
+(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."
@@ -113,10 +137,38 @@ If given a prefix, mark all unpicked articles as read."
   (unless gnus-newsgroup-processable
     (error "No articles have been picked"))
   (gnus-summary-limit-to-articles nil)
-  (when catch-up
+  (when (or catch-up gnus-mark-unpicked-articles-as-read)
     (gnus-summary-limit-mark-excluded-as-read))
-  (gnus-configure-windows (if gnus-pick-display-summary 'summary 'pick) t))
+  (gnus-summary-first-unread-article)
+  (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
 
+(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-mouse-pick-article (e)
+  (interactive "e")
+  (mouse-set-point e)
+  (save-excursion
+    (gnus-summary-mark-as-processable 1)))
+
+(defun gnus-pick-next-page ()
+  "Go to the next page.  If at the end of the buffer, start reading articles."
+  (interactive)
+  (condition-case ()
+      (scroll-up)
+    (gnus-pick-start-reading)))
 
 ;;;
 ;;; gnus-binary-mode
@@ -164,8 +216,8 @@ If given a prefix, mark all unpicked articles as read."
 	(gnus-binary-make-menu-bar))
       (unless (assq 'gnus-binary-mode minor-mode-alist)
 	(push '(gnus-binary-mode " Binary") minor-mode-alist))
-      (unless (assq 'gnus-topic-mode minor-mode-map-alist)
-	(push (cons 'gnus-topic-mode gnus-binary-mode-map)
+      (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))))
 
@@ -196,7 +248,8 @@ lines.")
 (defvar gnus-selected-tree-face 'modeline
   "*Face used for highlighting selected articles in the thread tree.")
 
-(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) (?\{ . ?\}))
+(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
+			     (?\{ . ?\}) (?< . ?>))
   "Brackets used in tree nodes.")
 
 (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
@@ -213,9 +266,6 @@ Two predefined functions are available:
 (defvar gnus-tree-mode-hook nil
   "*Hook run in tree mode buffers.")
 
-(defvar gnus-tree-buffer "*Tree*"
-  "Buffer where Gnus thread trees are displayed.")
-
 ;;; Internal variables.
 
 (defvar gnus-tree-line-format-alist 
@@ -246,13 +296,19 @@ Two predefined functions are available:
    gnus-tree-mode-map
    "\r" gnus-tree-select-article
    gnus-mouse-2 gnus-tree-pick-article
-   "\C-?" gnus-tree-read-summary-keys)
+   "\C-?" gnus-tree-read-summary-keys
+
+   "\C-c\C-i" gnus-info-find-node)
 
   (substitute-key-definition
    'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
 
 (defun gnus-tree-make-menu-bar ()
-  )
+  (unless (boundp 'gnus-tree-menu)
+    (easy-menu-define
+     gnus-tree-menu gnus-tree-mode-map ""
+     '("Tree"
+       ["Select article" gnus-tree-select-article t]))))
 
 (defun gnus-tree-mode ()
   "Major mode for displaying thread trees."
@@ -357,24 +413,32 @@ Two predefined functions are available:
 (defun gnus-tree-minimize ()
   (when (and gnus-tree-minimize-window
 	     (not (one-window-p)))
-    (let* ((window-min-height 2)
-	   (height (count-lines (point-min) (point-max)))
-	   (min (max (1- window-min-height) height))
-	   (tot (if (numberp gnus-tree-minimize-window)
-		    (min gnus-tree-minimize-window min)
-		  min))
-	   (win (get-buffer-window (current-buffer)))
-	   (wh (and win (1- (window-height win)))))
-      (when (and win
-		 (not (eq tot wh)))
-	(let ((selected (selected-window)))
-	  (select-window win)
-	  (enlarge-window (- tot wh))
-	  (select-window selected))))))
+    (let ((windows 0)
+	  tot-win-height)
+      (walk-windows (lambda (window) (incf windows)))
+      (setq tot-win-height 
+	    (- (frame-height) 
+	       (* window-min-height (1- windows))
+	       2))
+      (let* ((window-min-height 2)
+	     (height (count-lines (point-min) (point-max)))
+	     (min (max (1- window-min-height) height))
+	     (tot (if (numberp gnus-tree-minimize-window)
+		      (min gnus-tree-minimize-window min)
+		    min))
+	     (win (get-buffer-window (current-buffer)))
+	     (wh (and win (1- (window-height win)))))
+	(setq tot (min tot tot-win-height))
+	(when (and win
+		   (not (eq tot wh)))
+	  (let ((selected (selected-window)))
+	    (select-window win)
+	    (enlarge-window (- tot wh))
+	    (select-window selected)))))))
 
 ;;; Generating the tree.
 
-(defun gnus-tree-node-insert (header sparse)
+(defun gnus-tree-node-insert (header sparse &optional adopted)
   (let* ((dummy (stringp header))
 	 (header (if (vectorp header) header
 		   (progn
@@ -404,16 +468,18 @@ Two predefined functions are available:
 	  (cond ((memq gnus-tmp-number sparse) 
 		 (caadr gnus-tree-brackets))
 		(dummy (caaddr gnus-tree-brackets))
+		(adopted (car (nth 3 gnus-tree-brackets)))
 		(t (caar gnus-tree-brackets))))
 	 (gnus-tmp-close-bracket
 	  (cond ((memq gnus-tmp-number sparse)
 		 (cdadr gnus-tree-brackets))
+		(adopted (cdr (nth 3 gnus-tree-brackets)))
 		(dummy
 		 (cdaddr gnus-tree-brackets))
 		(t (cdar gnus-tree-brackets))))
 	 (buffer-read-only nil)
 	 beg end)
-    (add-text-properties
+    (gnus-add-text-properties
      (setq beg (point))
      (setq end (progn (eval gnus-tree-line-format-spec) (point)))
      (list 'gnus-number gnus-tmp-number))
@@ -435,7 +501,7 @@ Two predefined functions are available:
 		    (not (eval (caar list))))
 	  (setq list (cdr list)))))
     (unless (eq (setq face (cdar list)) (get-text-property beg 'face))
-      (put-text-property 
+      (gnus-put-text-property 
        beg end 'face 
        (if (boundp face) (symbol-value face) face)))))
 
@@ -459,11 +525,12 @@ Two predefined functions are available:
       (gnus-tree-minimize)
       (gnus-tree-recenter)
       (let ((selected (selected-window)))
-	(select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
-	(gnus-horizontal-recenter)
-	(select-window selected)))))
+	(when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+	  (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+	  (gnus-horizontal-recenter)
+	  (select-window selected))))))
 
-(defun gnus-generate-horizontal-tree (thread level &optional dummyp)
+(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted)
   "Generate a horizontal tree."
   (let* ((dummy (stringp (car thread)))
 	 (do (or dummy
@@ -490,7 +557,7 @@ Two predefined functions are available:
 	  (goto-char beg)))
       (setq dummyp nil)
       ;; Insert the article node.
-      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse))
+      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted))
     (if (null thread)
 	;; End of the thread, so we go to the next line.
 	(unless (bolp)
@@ -499,7 +566,7 @@ Two predefined functions are available:
       (while thread
 	(gnus-generate-horizontal-tree
 	 (pop thread) (if do (1+ level) level) 
-	 (or dummyp dummy))))))
+	 (or dummyp dummy) dummy)))))
 
 (defsubst gnus-tree-indent-vertical ()
   (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) 
@@ -514,12 +581,12 @@ Two predefined functions are available:
       (insert "\n")))
   (end-of-line))
 
-(defun gnus-generate-vertical-tree (thread level &optional dummyp)
+(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
   "Generate a vertical tree."
   (let* ((dummy (stringp (car thread)))
 	 (do (or dummy
 		 (memq (mail-header-number (car thread)) gnus-tmp-limit)))
-	 col beg)
+	 beg)
     (if (not do)
 	;; We don't want this article.
 	(setq thread (cdr thread))
@@ -548,7 +615,7 @@ Two predefined functions are available:
       (setq dummyp nil)
       ;; Insert the article node.
       (gnus-tree-indent-vertical)
-      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse)
+      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)
       (gnus-tree-forward-line 1))
     (if (null thread)
 	;; End of the thread, so we go to the next line.
@@ -560,7 +627,7 @@ Two predefined functions are available:
       (while thread
 	(gnus-generate-vertical-tree
 	 (pop thread) (if do (1+ level) level) 
-	 (or dummyp dummy))))))
+	 (or dummyp dummy) dummy)))))
 
 ;;; Interface functions.
 
@@ -569,6 +636,7 @@ Two predefined functions are available:
   (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
@@ -609,9 +677,10 @@ Two predefined functions are available:
       (gnus-tree-minimize)
       (gnus-tree-recenter)
       (let ((selected (selected-window)))
-	(select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
-	(gnus-horizontal-recenter)
-	(select-window selected)))
+	(when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+	  (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+	  (gnus-horizontal-recenter)
+	  (select-window selected))))
     ;; If we remove this save-excursion, it updates the wrong mode lines?!?
     (save-excursion
       (set-buffer gnus-tree-buffer)
@@ -623,10 +692,180 @@ Two predefined functions are available:
     (set-buffer (gnus-get-tree-buffer))
     (let (region)
       (when (setq region (gnus-tree-article-region article))
-	(put-text-property (car region) (cdr region) 'face face)
+	(gnus-put-text-property (car region) (cdr region) 'face face)
 	(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)