cgit.sxemacs.org Git - gnus/blob - lisp/gnus-salt.el

   1 ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
   2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'gnus-load)
  28 (require 'gnus-sum)
  29
  30 ;;;
  31 ;;; gnus-pick-mode
  32 ;;;
  33
  34 (defvar gnus-pick-mode nil
  35   "Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
  36
  37 (defvar gnus-pick-display-summary nil
  38   "*Display summary while reading.")
  39
  40 (defvar gnus-pick-mode-hook nil
  41   "Hook run in summary pick mode buffers.")
  42
  43 (defvar gnus-mark-unpicked-articles-as-read nil
  44   "*If non-nil, mark all unpicked articles as read.")
  45
  46 (defvar gnus-summary-pick-line-format
  47   "%-5p %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
  48   "*The format specification of the lines in pick buffers.
  49 It accepts the same format specs that `gnus-summary-line-format' does.")
  50
  51 ;;; Internal variables.
  52
  53 (defvar gnus-pick-mode-map nil)
  54
  55 (unless gnus-pick-mode-map
  56   (setq gnus-pick-mode-map (make-sparse-keymap))
  57
  58   (gnus-define-keys
  59    gnus-pick-mode-map
  60    "t" gnus-uu-mark-thread
  61    "T" gnus-uu-unmark-thread
  62    " " gnus-pick-next-page
  63    "u" gnus-summary-unmark-as-processable
  64    "U" gnus-summary-unmark-all-processable
  65    "v" gnus-uu-mark-over
  66    "r" gnus-uu-mark-region
  67    "R" gnus-uu-unmark-region
  68    "e" gnus-uu-mark-by-regexp
  69    "E" gnus-uu-mark-by-regexp
  70    "b" gnus-uu-mark-buffer
  71    "B" gnus-uu-unmark-buffer
  72    "." gnus-pick-article
  73    "\r" gnus-pick-start-reading))
  74
  75 (defun gnus-pick-make-menu-bar ()
  76   (unless (boundp 'gnus-pick-menu)
  77     (easy-menu-define
  78      gnus-pick-menu gnus-pick-mode-map ""
  79      '("Pick"
  80        ("Pick"
  81         ["Article" gnus-summary-mark-as-processable t]
  82         ["Thread" gnus-uu-mark-thread t]
  83         ["Region" gnus-uu-mark-region t]
  84         ["Regexp" gnus-uu-mark-regexp t]
  85         ["Buffer" gnus-uu-mark-buffer t])
  86        ("Unpick"
  87         ["Article" gnus-summary-unmark-as-processable t]
  88         ["Thread" gnus-uu-unmark-thread t]
  89         ["Region" gnus-uu-unmark-region t]
  90         ["Regexp" gnus-uu-unmark-regexp t]
  91         ["Buffer" gnus-uu-unmark-buffer t])
  92        ["Start reading" gnus-pick-start-reading t]
  93        ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
  94
  95 (defun gnus-pick-mode (&optional arg)
  96   "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
  97
  98 \\{gnus-pick-mode-map}"
  99   (interactive "P")
 100   (when (eq major-mode 'gnus-summary-mode)
 101     (make-local-variable 'gnus-pick-mode)
 102     (setq gnus-pick-mode
 103           (if (null arg) (not gnus-pick-mode)
 104             (> (prefix-numeric-value arg) 0)))
 105     (when gnus-pick-mode
 106       ;; Make sure that we don't select any articles upon group entry.
 107       (make-local-variable 'gnus-auto-select-first)
 108       (setq gnus-auto-select-first nil)
 109       ;; Change line format.
 110       (make-local-variable 'gnus-summary-line-format)
 111       (setq gnus-summary-line-format
 112             gnus-summary-pick-line-format)
 113       (make-local-variable 'gnus-summary-line-format-spec)
 114       (setq gnus-summary-line-format nil)
 115       (gnus-update-format-specifications nil 'summary)
 116       (gnus-update-summary-mark-positions)
 117       ;; Set up the menu.
 118       (when (and menu-bar-mode
 119                  (gnus-visual-p 'pick-menu 'menu))
 120         (gnus-pick-make-menu-bar))
 121       (unless (assq 'gnus-pick-mode minor-mode-alist)
 122         (push '(gnus-pick-mode " Pick") minor-mode-alist))
 123       (unless (assq 'gnus-pick-mode minor-mode-map-alist)
 124         (push (cons 'gnus-pick-mode gnus-pick-mode-map)
 125               minor-mode-map-alist))
 126       (run-hooks 'gnus-pick-mode-hook))))
 127
 128 (defvar gnus-pick-line-number 1)
 129 (defun gnus-pick-line-number ()
 130   "Return the current line number."
 131   (if (bobp)
 132       (setq gnus-pick-line-number 1)
 133     (incf gnus-pick-line-number)))
 134
 135 (defun gnus-pick-start-reading (&optional catch-up)
 136   "Start reading the picked articles.
 137 If given a prefix, mark all unpicked articles as read."
 138   (interactive "P")
 139   (unless gnus-newsgroup-processable
 140     (error "No articles have been picked"))
 141   (gnus-summary-limit-to-articles nil)
 142   (when (or catch-up gnus-mark-unpicked-articles-as-read)
 143     (gnus-summary-limit-mark-excluded-as-read))
 144   (gnus-summary-first-unread-article)
 145   (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
 146
 147 (defun gnus-pick-article (&optional arg)
 148   "Pick the article on the current line.
 149 If ARG, pick the article on that line instead."
 150   (interactive "P")
 151   (when arg
 152     (let (pos)
 153       (save-excursion
 154         (goto-char (point-min))
 155         (when (zerop (forward-line (1- (prefix-numeric-value arg))))
 156           (setq pos (point))))
 157       (if (not pos)
 158           (gnus-error 2 "No such line: %s" arg)
 159         (goto-char pos))))
 160   (gnus-summary-mark-as-processable 1))
 161
 162 (defun gnus-pick-next-page ()
 163   "Go to the next page.  If at the end of the buffer, start reading articles."
 164   (interactive)
 165   (condition-case ()
 166       (scroll-up)
 167     (gnus-pick-start-reading)))
 168
 169 ;;;
 170 ;;; gnus-binary-mode
 171 ;;;
 172
 173 (defvar gnus-binary-mode nil
 174   "Minor mode for provind a binary group interface in Gnus summary buffers.")
 175
 176 (defvar gnus-binary-mode-hook nil
 177   "Hook run in summary binary mode buffers.")
 178
 179 (defvar gnus-binary-mode-map nil)
 180
 181 (unless gnus-binary-mode-map
 182   (setq gnus-binary-mode-map (make-sparse-keymap))
 183
 184   (gnus-define-keys
 185    gnus-binary-mode-map
 186    "g" gnus-binary-show-article))
 187
 188 (defun gnus-binary-make-menu-bar ()
 189   (unless (boundp 'gnus-binary-menu)
 190     (easy-menu-define
 191      gnus-binary-menu gnus-binary-mode-map ""
 192      '("Pick"
 193        ["Switch binary mode off" gnus-binary-mode t]))))
 194
 195 (defun gnus-binary-mode (&optional arg)
 196   "Minor mode for providing a binary group interface in Gnus summary buffers."
 197   (interactive "P")
 198   (when (eq major-mode 'gnus-summary-mode)
 199     (make-local-variable 'gnus-binary-mode)
 200     (setq gnus-binary-mode
 201           (if (null arg) (not gnus-binary-mode)
 202             (> (prefix-numeric-value arg) 0)))
 203     (when gnus-binary-mode
 204       ;; Make sure that we don't select any articles upon group entry.
 205       (make-local-variable 'gnus-auto-select-first)
 206       (setq gnus-auto-select-first nil)
 207       (make-local-variable 'gnus-summary-display-article-function)
 208       (setq gnus-summary-display-article-function 'gnus-binary-display-article)
 209       ;; Set up the menu.
 210       (when (and menu-bar-mode
 211                  (gnus-visual-p 'binary-menu 'menu))
 212         (gnus-binary-make-menu-bar))
 213       (unless (assq 'gnus-binary-mode minor-mode-alist)
 214         (push '(gnus-binary-mode " Binary") minor-mode-alist))
 215       (unless (assq 'gnus-binary-mode minor-mode-map-alist)
 216         (push (cons 'gnus-binary-mode gnus-binary-mode-map)
 217               minor-mode-map-alist))
 218       (run-hooks 'gnus-binary-mode-hook))))
 219
 220 (defun gnus-binary-display-article (article &optional all-header)
 221   "Run ARTICLE through the binary decode functions."
 222   (when (gnus-summary-goto-subject article)
 223     (let ((gnus-view-pseudos 'automatic))
 224       (gnus-uu-decode-uu))))
 225
 226 (defun gnus-binary-show-article (&optional arg)
 227   "Bypass the binary functions and show the article."
 228   (interactive "P")
 229   (let (gnus-summary-display-article-function)
 230     (gnus-summary-show-article arg)))
 231
 232 ;;;
 233 ;;; gnus-tree-mode
 234 ;;;
 235
 236 (defvar gnus-tree-line-format "%(%[%3,3n%]%)"
 237   "Format of tree elements.")
 238
 239 (defvar gnus-tree-minimize-window t
 240   "If non-nil, minimize the tree buffer window.
 241 If a number, never let the tree buffer grow taller than that number of
 242 lines.")
 243
 244 (defvar gnus-selected-tree-face 'modeline
 245   "*Face used for highlighting selected articles in the thread tree.")
 246
 247 (defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
 248                              (?\{ . ?\}) (?< . ?>))
 249   "Brackets used in tree nodes.")
 250
 251 (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
 252   "Charaters used to connect parents with children.")
 253
 254 (defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z"
 255   "*The format specification for the tree mode line.")
 256
 257 (defvar gnus-generate-tree-function 'gnus-generate-vertical-tree
 258   "*Function for generating a thread tree.
 259 Two predefined functions are available:
 260 `gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.")
 261
 262 (defvar gnus-tree-mode-hook nil
 263   "*Hook run in tree mode buffers.")
 264
 265 ;;; Internal variables.
 266
 267 (defvar gnus-tree-line-format-alist
 268   `((?n gnus-tmp-name ?s)
 269     (?f gnus-tmp-from ?s)
 270     (?N gnus-tmp-number ?d)
 271     (?\[ gnus-tmp-open-bracket ?c)
 272     (?\] gnus-tmp-close-bracket ?c)
 273     (?s gnus-tmp-subject ?s)))
 274
 275 (defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist)
 276
 277 (defvar gnus-tree-mode-line-format-spec nil)
 278 (defvar gnus-tree-line-format-spec nil)
 279
 280 (defvar gnus-tree-node-length nil)
 281 (defvar gnus-selected-tree-overlay nil)
 282
 283 (defvar gnus-tree-displayed-thread nil)
 284
 285 (defvar gnus-tree-mode-map nil)
 286 (put 'gnus-tree-mode 'mode-class 'special)
 287
 288 (unless gnus-tree-mode-map
 289   (setq gnus-tree-mode-map (make-keymap))
 290   (suppress-keymap gnus-tree-mode-map)
 291   (gnus-define-keys
 292    gnus-tree-mode-map
 293    "\r" gnus-tree-select-article
 294    gnus-mouse-2 gnus-tree-pick-article
 295    "\C-?" gnus-tree-read-summary-keys
 296
 297    "\C-c\C-i" gnus-info-find-node)
 298
 299   (substitute-key-definition
 300    'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
 301
 302 (defun gnus-tree-make-menu-bar ()
 303   (unless (boundp 'gnus-tree-menu)
 304     (easy-menu-define
 305      gnus-tree-menu gnus-tree-mode-map ""
 306      '("Tree"
 307        ["Select article" gnus-tree-select-article t]))))
 308
 309 (defun gnus-tree-mode ()
 310   "Major mode for displaying thread trees."
 311   (interactive)
 312   (setq gnus-tree-mode-line-format-spec
 313         (gnus-parse-format gnus-tree-mode-line-format
 314                            gnus-summary-mode-line-format-alist))
 315   (setq gnus-tree-line-format-spec
 316         (gnus-parse-format gnus-tree-line-format
 317                            gnus-tree-line-format-alist t))
 318   (when (and menu-bar-mode
 319              (gnus-visual-p 'tree-menu 'menu))
 320     (gnus-tree-make-menu-bar))
 321   (kill-all-local-variables)
 322   (gnus-simplify-mode-line)
 323   (setq mode-name "Tree")
 324   (setq major-mode 'gnus-tree-mode)
 325   (use-local-map gnus-tree-mode-map)
 326   (buffer-disable-undo (current-buffer))
 327   (setq buffer-read-only t)
 328   (setq truncate-lines t)
 329   (save-excursion
 330     (gnus-set-work-buffer)
 331     (gnus-tree-node-insert (make-mail-header "") nil)
 332     (setq gnus-tree-node-length (1- (point))))
 333   (run-hooks 'gnus-tree-mode-hook))
 334
 335 (defun gnus-tree-read-summary-keys (&optional arg)
 336   "Read a summary buffer key sequence and execute it."
 337   (interactive "P")
 338   (let ((buf (current-buffer))
 339         win)
 340     (gnus-article-read-summary-keys arg nil t)
 341     (when (setq win (get-buffer-window buf))
 342       (select-window win)
 343       (when gnus-selected-tree-overlay
 344         (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
 345       (gnus-tree-minimize))))
 346
 347 (defun gnus-tree-select-article (article)
 348   "Select the article under point, if any."
 349   (interactive (list (gnus-tree-article-number)))
 350   (let ((buf (current-buffer)))
 351     (when article
 352       (save-excursion
 353         (set-buffer gnus-summary-buffer)
 354         (gnus-summary-goto-article article))
 355       (select-window (get-buffer-window buf)))))
 356
 357 (defun gnus-tree-pick-article (e)
 358   "Select the article under the mouse pointer."
 359   (interactive "e")
 360   (mouse-set-point e)
 361   (gnus-tree-select-article (gnus-tree-article-number)))
 362
 363 (defun gnus-tree-article-number ()
 364   (get-text-property (point) 'gnus-number))
 365
 366 (defun gnus-tree-article-region (article)
 367   "Return a cons with BEG and END of the article region."
 368   (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
 369     (when pos
 370       (cons pos (next-single-property-change pos 'gnus-number)))))
 371
 372 (defun gnus-tree-goto-article (article)
 373   (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
 374     (when pos
 375       (goto-char pos))))
 376
 377 (defun gnus-tree-recenter ()
 378   "Center point in the tree window."
 379   (let ((selected (selected-window))
 380         (tree-window (get-buffer-window gnus-tree-buffer t)))
 381     (when tree-window
 382       (select-window tree-window)
 383       (when gnus-selected-tree-overlay
 384         (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
 385       (let* ((top (cond ((< (window-height) 4) 0)
 386                         ((< (window-height) 7) 1)
 387                         (t 2)))
 388              (height (1- (window-height)))
 389              (bottom (save-excursion (goto-char (point-max))
 390                                      (forward-line (- height))
 391                                      (point))))
 392         ;; Set the window start to either `bottom', which is the biggest
 393         ;; possible valid number, or the second line from the top,
 394         ;; whichever is the least.
 395         (set-window-start
 396          tree-window (min bottom (save-excursion
 397                                    (forward-line (- top)) (point)))))
 398       (select-window selected))))
 399
 400 (defun gnus-get-tree-buffer ()
 401   "Return the tree buffer properly initialized."
 402   (save-excursion
 403     (set-buffer (get-buffer-create gnus-tree-buffer))
 404     (unless (eq major-mode 'gnus-tree-mode)
 405       (gnus-add-current-to-buffer-list)
 406       (gnus-tree-mode))
 407     (current-buffer)))
 408
 409 (defun gnus-tree-minimize ()
 410   (when (and gnus-tree-minimize-window
 411              (not (one-window-p)))
 412     (let ((windows 0)
 413           tot-win-height)
 414       (walk-windows (lambda (window) (incf windows)))
 415       (setq tot-win-height
 416             (- (frame-height)
 417                (* window-min-height (1- windows))
 418                2))
 419       (let* ((window-min-height 2)
 420              (height (count-lines (point-min) (point-max)))
 421              (min (max (1- window-min-height) height))
 422              (tot (if (numberp gnus-tree-minimize-window)
 423                       (min gnus-tree-minimize-window min)
 424                     min))
 425              (win (get-buffer-window (current-buffer)))
 426              (wh (and win (1- (window-height win)))))
 427         (setq tot (min tot tot-win-height))
 428         (when (and win
 429                    (not (eq tot wh)))
 430           (let ((selected (selected-window)))
 431             (select-window win)
 432             (enlarge-window (- tot wh))
 433             (select-window selected)))))))
 434
 435 ;;; Generating the tree.
 436
 437 (defun gnus-tree-node-insert (header sparse &optional adopted)
 438   (let* ((dummy (stringp header))
 439          (header (if (vectorp header) header
 440                    (progn
 441                      (setq header (make-mail-header "*****"))
 442                      (mail-header-set-number header 0)
 443                      (mail-header-set-lines header 0)
 444                      (mail-header-set-chars header 0)
 445                      header)))
 446          (gnus-tmp-from (mail-header-from header))
 447          (gnus-tmp-subject (mail-header-subject header))
 448          (gnus-tmp-number (mail-header-number header))
 449          (gnus-tmp-name
 450           (cond
 451            ((string-match "(.+)" gnus-tmp-from)
 452             (substring gnus-tmp-from
 453                        (1+ (match-beginning 0)) (1- (match-end 0))))
 454            ((string-match "<[^>]+> *$" gnus-tmp-from)
 455             (let ((beg (match-beginning 0)))
 456               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
 457                        (substring gnus-tmp-from (1+ (match-beginning 0))
 458                                   (1- (match-end 0))))
 459                   (substring gnus-tmp-from 0 beg))))
 460            ((memq gnus-tmp-number sparse)
 461             "***")
 462            (t gnus-tmp-from)))
 463          (gnus-tmp-open-bracket
 464           (cond ((memq gnus-tmp-number sparse)
 465                  (caadr gnus-tree-brackets))
 466                 (dummy (caaddr gnus-tree-brackets))
 467                 (adopted (car (nth 3 gnus-tree-brackets)))
 468                 (t (caar gnus-tree-brackets))))
 469          (gnus-tmp-close-bracket
 470           (cond ((memq gnus-tmp-number sparse)
 471                  (cdadr gnus-tree-brackets))
 472                 (adopted (cdr (nth 3 gnus-tree-brackets)))
 473                 (dummy
 474                  (cdaddr gnus-tree-brackets))
 475                 (t (cdar gnus-tree-brackets))))
 476          (buffer-read-only nil)
 477          beg end)
 478     (gnus-add-text-properties
 479      (setq beg (point))
 480      (setq end (progn (eval gnus-tree-line-format-spec) (point)))
 481      (list 'gnus-number gnus-tmp-number))
 482     (when (or t (gnus-visual-p 'tree-highlight 'highlight))
 483       (gnus-tree-highlight-node gnus-tmp-number beg end))))
 484
 485 (defun gnus-tree-highlight-node (article beg end)
 486   "Highlight current line according to `gnus-summary-highlight'."
 487   (let ((list gnus-summary-highlight)
 488         face)
 489     (save-excursion
 490       (set-buffer gnus-summary-buffer)
 491       (let* ((score (or (cdr (assq article gnus-newsgroup-scored))
 492                         gnus-summary-default-score 0))
 493              (default gnus-summary-default-score)
 494              (mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
 495         ;; Eval the cars of the lists until we find a match.
 496         (while (and list
 497                     (not (eval (caar list))))
 498           (setq list (cdr list)))))
 499     (unless (eq (setq face (cdar list)) (get-text-property beg 'face))
 500       (gnus-put-text-property
 501        beg end 'face
 502        (if (boundp face) (symbol-value face) face)))))
 503
 504 (defun gnus-tree-indent (level)
 505   (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? )))
 506
 507 (defvar gnus-tmp-limit)
 508 (defvar gnus-tmp-sparse)
 509 (defvar gnus-tmp-indent)
 510
 511 (defun gnus-generate-tree (thread)
 512   "Generate a thread tree for THREAD."
 513   (save-excursion
 514     (set-buffer (gnus-get-tree-buffer))
 515     (let ((buffer-read-only nil)
 516           (gnus-tmp-indent 0))
 517       (erase-buffer)
 518       (funcall gnus-generate-tree-function thread 0)
 519       (gnus-set-mode-line 'tree)
 520       (goto-char (point-min))
 521       (gnus-tree-minimize)
 522       (gnus-tree-recenter)
 523       (let ((selected (selected-window)))
 524         (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
 525           (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
 526           (gnus-horizontal-recenter)
 527           (select-window selected))))))
 528
 529 (defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted)
 530   "Generate a horizontal tree."
 531   (let* ((dummy (stringp (car thread)))
 532          (do (or dummy
 533                  (memq (mail-header-number (car thread)) gnus-tmp-limit)))
 534          col beg)
 535     (if (not do)
 536         ;; We don't want this article.
 537         (setq thread (cdr thread))
 538       (if (not (bolp))
 539           ;; Not the first article on the line, so we insert a "-".
 540           (insert (car gnus-tree-parent-child-edges))
 541         ;; If the level isn't zero, then we insert some indentation.
 542         (unless (zerop level)
 543           (gnus-tree-indent level)
 544           (insert (cadr gnus-tree-parent-child-edges))
 545           (setq col (- (setq beg (point)) (gnus-point-at-bol) 1))
 546           ;; Draw "|" lines upwards.
 547           (while (progn
 548                    (forward-line -1)
 549                    (forward-char col)
 550                    (= (following-char) ? ))
 551             (delete-char 1)
 552             (insert (caddr gnus-tree-parent-child-edges)))
 553           (goto-char beg)))
 554       (setq dummyp nil)
 555       ;; Insert the article node.
 556       (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted))
 557     (if (null thread)
 558         ;; End of the thread, so we go to the next line.
 559         (unless (bolp)
 560           (insert "\n"))
 561       ;; Recurse downwards in all children of this article.
 562       (while thread
 563         (gnus-generate-horizontal-tree
 564          (pop thread) (if do (1+ level) level)
 565          (or dummyp dummy) dummy)))))
 566
 567 (defsubst gnus-tree-indent-vertical ()
 568   (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
 569                 (- (point) (gnus-point-at-bol)))))
 570     (when (> len 0)
 571       (insert (make-string len ? )))))
 572
 573 (defsubst gnus-tree-forward-line (n)
 574   (while (>= (decf n) 0)
 575     (unless (zerop (forward-line 1))
 576       (end-of-line)
 577       (insert "\n")))
 578   (end-of-line))
 579
 580 (defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
 581   "Generate a vertical tree."
 582   (let* ((dummy (stringp (car thread)))
 583          (do (or dummy
 584                  (memq (mail-header-number (car thread)) gnus-tmp-limit)))
 585          beg)
 586     (if (not do)
 587         ;; We don't want this article.
 588         (setq thread (cdr thread))
 589       (if (not (save-excursion (beginning-of-line) (bobp)))
 590           ;; Not the first article on the line, so we insert a "-".
 591           (progn
 592             (gnus-tree-indent-vertical)
 593             (insert (make-string (/ gnus-tree-node-length 2) ? ))
 594             (insert (caddr gnus-tree-parent-child-edges))
 595             (gnus-tree-forward-line 1))
 596         ;; If the level isn't zero, then we insert some indentation.
 597         (unless (zerop gnus-tmp-indent)
 598           (gnus-tree-forward-line (1- (* 2 level)))
 599           (gnus-tree-indent-vertical)
 600           (delete-char -1)
 601           (insert (cadr gnus-tree-parent-child-edges))
 602           (setq beg (point))
 603           ;; Draw "-" lines leftwards.
 604           (while (progn
 605                    (forward-char -2)
 606                    (= (following-char) ? ))
 607             (delete-char 1)
 608             (insert (car gnus-tree-parent-child-edges)))
 609           (goto-char beg)
 610           (gnus-tree-forward-line 1)))
 611       (setq dummyp nil)
 612       ;; Insert the article node.
 613       (gnus-tree-indent-vertical)
 614       (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)
 615       (gnus-tree-forward-line 1))
 616     (if (null thread)
 617         ;; End of the thread, so we go to the next line.
 618         (progn
 619           (goto-char (point-min))
 620           (end-of-line)
 621           (incf gnus-tmp-indent))
 622       ;; Recurse downwards in all children of this article.
 623       (while thread
 624         (gnus-generate-vertical-tree
 625          (pop thread) (if do (1+ level) level)
 626          (or dummyp dummy) dummy)))))
 627
 628 ;;; Interface functions.
 629
 630 (defun gnus-possibly-generate-tree (article &optional force)
 631   "Generate the thread tree for ARTICLE if it isn't displayed already."
 632   (when (save-excursion
 633           (set-buffer gnus-summary-buffer)
 634           (and gnus-use-trees
 635                (vectorp (gnus-summary-article-header article))))
 636     (save-excursion
 637       (let ((top (save-excursion
 638                    (set-buffer gnus-summary-buffer)
 639                    (gnus-cut-thread
 640                     (gnus-remove-thread
 641                      (mail-header-id
 642                       (gnus-summary-article-header article)) t))))
 643             (gnus-tmp-limit gnus-newsgroup-limit)
 644             (gnus-tmp-sparse gnus-newsgroup-sparse))
 645         (when (or force
 646                   (not (eq top gnus-tree-displayed-thread)))
 647           (gnus-generate-tree top)
 648           (setq gnus-tree-displayed-thread top))))))
 649
 650 (defun gnus-tree-open (group)
 651   (gnus-get-tree-buffer))
 652
 653 (defun gnus-tree-close (group)
 654   ;(gnus-kill-buffer gnus-tree-buffer)
 655   )
 656
 657 (defun gnus-highlight-selected-tree (article)
 658   "Highlight the selected article in the tree."
 659   (let ((buf (current-buffer))
 660         region)
 661     (set-buffer gnus-tree-buffer)
 662     (when (setq region (gnus-tree-article-region article))
 663       (when (or (not gnus-selected-tree-overlay)
 664                 (gnus-extent-detached-p gnus-selected-tree-overlay))
 665         ;; Create a new overlay.
 666         (gnus-overlay-put
 667          (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
 668          'face gnus-selected-tree-face))
 669       ;; Move the overlay to the article.
 670       (gnus-move-overlay
 671        gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
 672       (gnus-tree-minimize)
 673       (gnus-tree-recenter)
 674       (let ((selected (selected-window)))
 675         (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
 676           (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
 677           (gnus-horizontal-recenter)
 678           (select-window selected))))
 679     ;; If we remove this save-excursion, it updates the wrong mode lines?!?
 680     (save-excursion
 681       (set-buffer gnus-tree-buffer)
 682       (gnus-set-mode-line 'tree))
 683     (set-buffer buf)))
 684
 685 (defun gnus-tree-highlight-article (article face)
 686   (save-excursion
 687     (set-buffer (gnus-get-tree-buffer))
 688     (let (region)
 689       (when (setq region (gnus-tree-article-region article))
 690         (gnus-put-text-property (car region) (cdr region) 'face face)
 691         (set-window-point
 692          (get-buffer-window (current-buffer) t) (cdr region))))))
 693
 694 ;;; Allow redefinition of functions.
 695 (gnus-ems-redefine)
 696
 697 (provide 'gnus-salt)
 698
 699 ;;; gnus-salt.el ends here