*** empty log message ***
[gnus] / lisp / gnus-salt.el
index 6b5040a..f8c8c7c 100644 (file)
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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.
 
 ;;; Commentary:
 
 ;;; Code:
 
 (require 'gnus)
+(eval-when-compile (require 'cl))
 
 ;;;
 ;;; gnus-pick-mode
@@ -82,7 +84,7 @@
        ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
 
 (defun gnus-pick-mode (&optional arg)
-  "Minor mode for provind a pick-and-read interface in Gnus summary buffers."
+  "Minor mode for providing a pick-and-read interface in Gnus summary buffers."
   (interactive "P")
   (when (eq major-mode 'gnus-summary-mode)
     (make-local-variable 'gnus-pick-mode)
        (gnus-pick-make-menu-bar))
       (unless (assq 'gnus-pick-mode minor-mode-alist)
        (push '(gnus-pick-mode " Pick") minor-mode-alist))
-      (unless (assq 'gnus-topic-mode minor-mode-map-alist)
-       (push (cons 'gnus-topic-mode gnus-pick-mode-map)
+      (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))))
 
@@ -194,7 +196,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 '(?- ?\\ ?|)
@@ -211,9 +214,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 
@@ -250,7 +250,11 @@ Two predefined functions are available:
    '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."
@@ -287,7 +291,7 @@ Two predefined functions are available:
     (when (setq win (get-buffer-window buf))
       (select-window win)
       (when gnus-selected-tree-overlay
-       (goto-char (overlay-end gnus-selected-tree-overlay)))
+       (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
       (gnus-tree-minimize))))
 
 (defun gnus-tree-select-article (article)
@@ -322,23 +326,26 @@ Two predefined functions are available:
 
 (defun gnus-tree-recenter ()
   "Center point in the tree window."
-  (when (get-buffer-window (current-buffer))
-    (save-selected-window
-      (select-window (get-buffer-window (current-buffer)))
+  (let ((selected (selected-window))
+       (tree-window (get-buffer-window gnus-tree-buffer t)))
+    (when tree-window
+      (select-window tree-window)
+      (when gnus-selected-tree-overlay
+       (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))
-                                    (point)))
-            (window (get-buffer-window (current-buffer))))
+                                    (point))))
        ;; Set the window start to either `bottom', which is the biggest
        ;; possible valid number, or the second line from the top,
        ;; whichever is the least.
        (set-window-start
-        window (min bottom (save-excursion 
-                             (forward-line (- top)) (point))))))))
+        tree-window (min bottom (save-excursion 
+                                  (forward-line (- top)) (point)))))
+      (select-window selected))))
 
 (defun gnus-get-tree-buffer ()
   "Return the tree buffer properly initialized."
@@ -362,13 +369,14 @@ Two predefined functions are available:
           (wh (and win (1- (window-height win)))))
       (when (and win
                 (not (eq tot wh)))
-       (save-selected-window
+       (let ((selected (selected-window)))
          (select-window win)
-         (enlarge-window (- tot wh)))))))
+         (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
@@ -398,10 +406,12 @@ 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))))
@@ -452,9 +462,13 @@ Two predefined functions are available:
       (goto-char (point-min))
       (gnus-tree-minimize)
       (gnus-tree-recenter)
-      (gnus-horizontal-recenter))))
+      (let ((selected (selected-window)))
+       (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
@@ -481,7 +495,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)
@@ -490,7 +504,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) 
@@ -505,12 +519,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))
@@ -539,7 +553,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.
@@ -551,30 +565,36 @@ 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.
 
 (defun gnus-possibly-generate-tree (article &optional force)
   "Generate the thread tree for ARTICLE if it isn't displayed already."
-  (save-excursion
-    (let ((top (save-excursion
-                (set-buffer gnus-summary-buffer)
-                (gnus-cut-thread
-                 (gnus-remove-thread 
-                  (mail-header-id (gnus-summary-article-header article)) t))))
-         (gnus-tmp-limit gnus-newsgroup-limit)
-         (gnus-tmp-sparse gnus-newsgroup-sparse))
-      (when (or force
-               (not (eq top gnus-tree-displayed-thread)))
-       (gnus-generate-tree top)
-       (setq gnus-tree-displayed-thread top)))))
+  (when (save-excursion
+         (set-buffer gnus-summary-buffer)
+         (and gnus-use-trees
+              (vectorp (gnus-summary-article-header article))))
+    (save-excursion
+      (let ((top (save-excursion
+                  (set-buffer gnus-summary-buffer)
+                  (gnus-cut-thread
+                   (gnus-remove-thread 
+                    (mail-header-id 
+                     (gnus-summary-article-header article)) t))))
+           (gnus-tmp-limit gnus-newsgroup-limit)
+           (gnus-tmp-sparse gnus-newsgroup-sparse))
+       (when (or force
+                 (not (eq top gnus-tree-displayed-thread)))
+         (gnus-generate-tree top)
+         (setq gnus-tree-displayed-thread top))))))
 
 (defun gnus-tree-open (group)
   (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)
   "Highlight the selected article in the tree."
@@ -582,17 +602,22 @@ Two predefined functions are available:
        region)
     (set-buffer gnus-tree-buffer)
     (when (setq region (gnus-tree-article-region article))
-      (unless gnus-selected-tree-overlay
+      (when (or (not gnus-selected-tree-overlay)
+               (gnus-extent-detached-p gnus-selected-tree-overlay))
        ;; Create a new overlay.
        (gnus-overlay-put
-        (setq gnus-selected-tree-overlay (gnus-make-overlay 1 1))
+        (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
         'face gnus-selected-tree-face))
       ;; Move the overlay to the article.
       (gnus-move-overlay 
        gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
       (gnus-tree-minimize)
       (gnus-tree-recenter)
-      (gnus-horizontal-recenter))
+      (let ((selected (selected-window)))
+       (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)
@@ -604,6 +629,13 @@ 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)))))
+       (put-text-property (car region) (cdr region) 'face face)
+       (set-window-point 
+        (get-buffer-window (current-buffer) t) (cdr region))))))
+
+;;; Allow redefinition of functions.
+(gnus-ems-redefine)
+
+(provide 'gnus-salt)
 
 ;;; gnus-salt.el ends here