X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-salt.el;h=410772fcbd25dd051ef20912c0aefea99fdaa312;hp=b50341d0c89d105fd2f6e1d9286f74cc20dfdfa4;hb=477d2d1e18caaf92a73dbbcbfb1e87d3c104a10a;hpb=2e33d39729730bd9b58520e013ce3e53250eeb15 diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index b50341d0c..410772fcb 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -1,15 +1,17 @@ ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -17,26 +19,25 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile + (when (featurep 'xemacs) + (require 'easy-mmode))) ; for `define-minor-mode' (require 'gnus) (require 'gnus-sum) +(require 'gnus-win) ;;; ;;; gnus-pick-mode ;;; -(defvar gnus-pick-mode nil - "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") - (defcustom gnus-pick-display-summary nil "*Display summary while reading." :type 'boolean @@ -47,18 +48,22 @@ :type 'hook :group 'gnus-summary-pick) +(when (featurep 'xemacs) + (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)) + (defcustom gnus-mark-unpicked-articles-as-read nil "*If non-nil, mark all unpicked articles as read." :type 'boolean :group 'gnus-summary-pick) (defcustom gnus-pick-elegant-flow t - "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked." + "If non-nil, `gnus-pick-start-reading' runs + `gnus-summary-next-group' when no articles have been picked." :type 'boolean :group 'gnus-summary-pick) (defcustom gnus-summary-pick-line-format - "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n" "*The format specification of the lines in pick buffers. It accepts the same format specs that `gnus-summary-line-format' does." :type 'string @@ -66,72 +71,73 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;;; Internal variables. -(defvar gnus-pick-mode-map nil) - -(unless gnus-pick-mode-map - (setq gnus-pick-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-pick-mode-map - " " gnus-pick-next-page - "u" gnus-pick-unmark-article-or-thread - "." gnus-pick-article-or-thread - gnus-down-mouse-2 gnus-pick-mouse-pick-region - "\r" gnus-pick-start-reading - )) +(defvar gnus-pick-mode-map + (let ((map (make-sparse-keymap))) + (gnus-define-keys map + " " gnus-pick-next-page + "u" gnus-pick-unmark-article-or-thread + "." gnus-pick-article-or-thread + gnus-down-mouse-2 gnus-pick-mouse-pick-region + "\r" gnus-pick-start-reading) + map)) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) (easy-menu-define - gnus-pick-menu gnus-pick-mode-map "" - '("Pick" - ("Pick" - ["Article" gnus-summary-mark-as-processable t] - ["Thread" gnus-uu-mark-thread t] - ["Region" gnus-uu-mark-region t] - ["Regexp" gnus-uu-mark-by-regexp t] - ["Buffer" gnus-uu-mark-buffer t]) - ("Unpick" - ["Article" gnus-summary-unmark-as-processable t] - ["Thread" gnus-uu-unmark-thread t] - ["Region" gnus-uu-unmark-region t] - ["Regexp" gnus-uu-unmark-by-regexp t] - ["Buffer" gnus-summary-unmark-all-processable t]) - ["Start reading" gnus-pick-start-reading t] - ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) - -(defun gnus-pick-mode (&optional arg) + gnus-pick-menu gnus-pick-mode-map "" + '("Pick" + ("Pick" + ["Article" gnus-summary-mark-as-processable t] + ["Thread" gnus-uu-mark-thread t] + ["Region" gnus-uu-mark-region t] + ["Regexp" gnus-uu-mark-by-regexp t] + ["Buffer" gnus-uu-mark-buffer t]) + ("Unpick" + ["Article" gnus-summary-unmark-as-processable t] + ["Thread" gnus-uu-unmark-thread t] + ["Region" gnus-uu-unmark-region t] + ["Regexp" gnus-uu-unmark-by-regexp t] + ["Buffer" gnus-summary-unmark-all-processable t]) + ["Start reading" gnus-pick-start-reading t] + ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) + +(eval-when-compile + (when (featurep 'xemacs) + (defvar gnus-pick-mode-on-hook) + (defvar gnus-pick-mode-off-hook))) + +(define-minor-mode gnus-pick-mode "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) - (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. - (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 (gnus-visual-p 'pick-menu 'menu) - (gnus-pick-make-menu-bar)) - (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) - (gnus-run-hooks 'gnus-pick-mode-hook)))) + :lighter " Pick" :keymap gnus-pick-mode-map + (cond + ((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-pick-mode nil)) + ((not gnus-pick-mode) + ;; FIXME: a buffer-local minor mode removing globally from a hook?? + (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)) + (t + ;; Make sure that we don't select any articles upon group entry. + (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) + ;; FIXME: a buffer-local minor mode adding globally to a hook?? + (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) + (set (make-local-variable 'gnus-summary-goto-unread) 'never) + ;; Set up the menu. + (when (gnus-visual-p 'pick-menu 'menu) + (gnus-pick-make-menu-bar))))) (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) + (with-current-buffer gnus-summary-buffer gnus-pick-mode)) (message-add-action - '(gnus-configure-windows ,gnus-current-window-configuration t) + `(gnus-configure-windows ,gnus-current-window-configuration t) 'send 'exit 'postpone 'kill))) (defvar gnus-pick-line-number 1) @@ -147,11 +153,11 @@ If given a prefix, mark all unpicked articles as read." (interactive "P") (if gnus-newsgroup-processable (progn - (gnus-summary-limit-to-articles nil) - (when (or catch-up gnus-mark-unpicked-articles-as-read) + (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 + (gnus-summary-first-article) + (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow (progn @@ -163,8 +169,8 @@ If given a prefix, mark all unpicked articles as read." (error "No articles have been picked")))) (defun gnus-pick-goto-article (arg) - "Go to the article number indicated by ARG. If ARG is an invalid -article number, then stay on current line." + "Go to the article number indicated by ARG. +If ARG is an invalid article number, then stay on current line." (let (pos) (save-excursion (goto-char (point-min)) @@ -173,9 +179,9 @@ article number, then stay on current line." (if (not pos) (gnus-error 2 "No such line: %s" arg) (goto-char pos)))) - + (defun gnus-pick-article (&optional arg) - "Pick the article on the current line. + "Pick the article on the current line. If ARG, pick the article on that line instead." (interactive "P") (when arg @@ -183,27 +189,31 @@ If ARG, pick the article on that line instead." (gnus-summary-mark-as-processable 1)) (defun gnus-pick-article-or-thread (&optional arg) - "If gnus-thread-hide-subtree is t, then pick the thread on the current line. + "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line. Otherwise pick the article on the current line. If ARG, pick the article/thread on that line instead." (interactive "P") (when arg (gnus-pick-goto-article arg)) (if gnus-thread-hide-subtree - (gnus-uu-mark-thread) + (progn + (save-excursion + (gnus-uu-mark-thread)) + (forward-line 1)) (gnus-summary-mark-as-processable 1))) - + (defun gnus-pick-unmark-article-or-thread (&optional arg) - "If gnus-thread-hide-subtree is t, then unmark the thread on current line. + "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line. Otherwise unmark the article on current line. If ARG, unmark thread/article on that line instead." (interactive "P") (when arg (gnus-pick-goto-article arg)) (if gnus-thread-hide-subtree - (gnus-uu-unmark-thread) + (save-excursion + (gnus-uu-unmark-thread)) (gnus-summary-unmark-as-processable 1))) - + (defun gnus-pick-mouse-pick (e) (interactive "e") (mouse-set-point e) @@ -218,7 +228,7 @@ This must be bound to a button-down mouse 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-line (1+ (count-lines (point-min) start-point))) (start-window (posn-window start-posn)) (bounds (gnus-window-edges start-window)) (top (nth 1 bounds)) @@ -230,7 +240,7 @@ This must be bound to a button-down mouse 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, + ;; 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)) @@ -262,11 +272,12 @@ This must be bound to a button-down mouse event." (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))) + (let* ((this-line (1+ (count-lines (point-min) 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) + (goto-char (point-min)) + (forward-line (1- min-line)) (gnus-pick-article) (setq min-line (1+ min-line))) (setq start-line this-line)) @@ -284,18 +295,18 @@ This must be bound to a button-down mouse event." (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, + ;; 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. + ;; (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. + ;; because delete-overlay increases buffer-modified-tick. (push event unread-command-events)))))))) (defun gnus-pick-next-page () @@ -310,52 +321,46 @@ This must be bound to a button-down mouse event." ;;; gnus-binary-mode ;;; -(defvar gnus-binary-mode nil - "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.") -(defvar gnus-binary-mode-map nil) - -(unless gnus-binary-mode-map - (setq gnus-binary-mode-map (make-sparse-keymap)) - - (gnus-define-keys - gnus-binary-mode-map - "g" gnus-binary-show-article)) +(defvar gnus-binary-mode-map + (let ((map (make-sparse-keymap))) + (gnus-define-keys map + "g" gnus-binary-show-article) + map)) (defun gnus-binary-make-menu-bar () (unless (boundp 'gnus-binary-menu) (easy-menu-define - gnus-binary-menu gnus-binary-mode-map "" - '("Pick" - ["Switch binary mode off" gnus-binary-mode t])))) + gnus-binary-menu gnus-binary-mode-map "" + '("Pick" + ["Switch binary mode off" gnus-binary-mode t])))) + +(eval-when-compile + (when (featurep 'xemacs) + (defvar gnus-binary-mode-on-hook) + (defvar gnus-binary-mode-off-hook))) -(defun gnus-binary-mode (&optional arg) +(define-minor-mode gnus-binary-mode "Minor mode for providing a binary group interface in Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-binary-mode) - (setq gnus-binary-mode - (if (null arg) (not gnus-binary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-binary-mode - ;; 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) - (make-local-variable 'gnus-summary-display-article-function) - (setq gnus-summary-display-article-function 'gnus-binary-display-article) - ;; Set up the menu. - (when (gnus-visual-p 'binary-menu 'menu) - (gnus-binary-make-menu-bar)) - (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) - (gnus-run-hooks 'gnus-binary-mode-hook)))) + :lighter " Binary" :keymap gnus-binary-mode-map + (cond + ((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-binary-mode nil)) + (gnus-binary-mode + ;; 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) + (make-local-variable 'gnus-summary-display-article-function) + (setq gnus-summary-display-article-function 'gnus-binary-display-article) + ;; Set up the menu. + (when (gnus-visual-p 'binary-menu 'menu) + (gnus-binary-make-menu-bar))))) (defun gnus-binary-display-article (article &optional all-header) "Run ARTICLE through the binary decode functions." (when (gnus-summary-goto-subject article) - (let ((gnus-view-pseudos 'automatic)) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu)))) (defun gnus-binary-show-article (&optional arg) @@ -412,6 +417,11 @@ Two predefined functions are available: :type 'hook :group 'gnus-summary-tree) +(when (featurep 'xemacs) + (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) + (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) + + ;;; Internal variables. (defvar gnus-tree-line-format-alist @@ -431,6 +441,7 @@ Two predefined functions are available: (defvar gnus-selected-tree-overlay nil) (defvar gnus-tree-displayed-thread nil) +(defvar gnus-tree-inhibit nil) (defvar gnus-tree-mode-map nil) (put 'gnus-tree-mode 'mode-class 'special) @@ -439,13 +450,13 @@ Two predefined functions are available: (setq gnus-tree-mode-map (make-keymap)) (suppress-keymap gnus-tree-mode-map) (gnus-define-keys - gnus-tree-mode-map - "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary + gnus-tree-mode-map + "\r" gnus-tree-select-article + gnus-mouse-2 gnus-tree-pick-article + "\C-?" gnus-tree-read-summary-keys + "h" gnus-tree-show-summary - "\C-c\C-i" gnus-info-find-node) + "\C-c\C-i" gnus-info-find-node) (substitute-key-definition 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) @@ -453,9 +464,9 @@ Two predefined functions are available: (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])))) + 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." @@ -476,20 +487,22 @@ Two predefined functions are available: (gnus-set-work-buffer) (gnus-tree-node-insert (make-mail-header "") nil) (setq gnus-tree-node-length (1- (point)))) - (gnus-run-hooks 'gnus-tree-mode-hook)) + (gnus-run-mode-hooks 'gnus-tree-mode-hook)) (defun gnus-tree-read-summary-keys (&optional arg) "Read a summary buffer key sequence and execute it." (interactive "P") - (let ((buf (current-buffer)) - win) - (set-buffer gnus-article-buffer) - (gnus-article-read-summary-keys arg nil t) - (when (setq win (get-buffer-window buf)) - (select-window win) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (gnus-tree-minimize)))) + (unless gnus-tree-inhibit + (let ((buf (current-buffer)) + (gnus-tree-inhibit t) + win) + (set-buffer gnus-article-buffer) + (gnus-article-read-summary-keys arg nil t) + (when (setq win (get-buffer-window buf)) + (select-window win) + (when gnus-selected-tree-overlay + (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) + (gnus-tree-minimize))))) (defun gnus-tree-show-summary () "Reconfigure windows to show summary buffer." @@ -504,8 +517,7 @@ Two predefined functions are available: (interactive (list (gnus-tree-article-number))) (let ((buf (current-buffer))) (when article - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-summary-goto-article article)) (select-window (get-buffer-window buf))))) @@ -534,7 +546,7 @@ Two predefined functions are available: (defun gnus-tree-recenter () "Center point in the tree window." (let ((selected (selected-window)) - (tree-window (get-buffer-window gnus-tree-buffer t))) + (tree-window (gnus-get-buffer-window gnus-tree-buffer t))) (when tree-window (select-window tree-window) (when gnus-selected-tree-overlay @@ -546,7 +558,7 @@ Two predefined functions are available: (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) (point)))) - ;; Set the window start to either `bottom', which is the biggest + ;; 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 @@ -556,8 +568,7 @@ Two predefined functions are available: (defun gnus-get-tree-buffer () "Return the tree buffer properly initialized." - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-tree-buffer)) + (with-current-buffer (gnus-get-buffer-create gnus-tree-buffer) (unless (eq major-mode 'gnus-tree-mode) (gnus-tree-mode)) (current-buffer))) @@ -642,11 +653,14 @@ Two predefined functions are available: "Highlight current line according to `gnus-summary-highlight'." (let ((list gnus-summary-highlight) face) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) gnus-summary-default-score 0)) (default gnus-summary-default-score) + (default-high gnus-summary-default-high-score) + (default-low gnus-summary-default-low-score) + (uncached (memq article gnus-newsgroup-undownloaded)) + (downloaded (not uncached)) (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) ;; Eval the cars of the lists until we find a match. (while (and list @@ -666,8 +680,7 @@ Two predefined functions are available: (defun gnus-generate-tree (thread) "Generate a thread tree for THREAD." - (save-excursion - (set-buffer (gnus-get-tree-buffer)) + (with-current-buffer (gnus-get-tree-buffer) (let ((buffer-read-only nil) (gnus-tmp-indent 0)) (erase-buffer) @@ -677,8 +690,8 @@ Two predefined functions are available: (gnus-tree-minimize) (gnus-tree-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)) + (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) + (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)) (gnus-horizontal-recenter) (select-window selected)))))) @@ -700,7 +713,7 @@ Two predefined functions are available: (unless (zerop level) (gnus-tree-indent level) (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) + (setq col (- (setq beg (point)) (point-at-bol) 1)) ;; Draw "|" lines upwards. (while (progn (forward-line -1) @@ -724,7 +737,7 @@ Two predefined functions are available: (defsubst gnus-tree-indent-vertical () (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (gnus-point-at-bol))))) + (- (point) (point-at-bol))))) (when (> len 0) (insert (make-string len ? ))))) @@ -762,7 +775,7 @@ Two predefined functions are available: (setq beg (point)) (forward-char -1) ;; Draw "-" lines leftwards. - (while (and (> (point) 1) + (while (and (not (bobp)) (eq (char-after (1- (point))) ? )) (delete-char -1) (insert (car gnus-tree-parent-child-edges)) @@ -790,14 +803,12 @@ Two predefined functions are available: (defun gnus-possibly-generate-tree (article &optional force) "Generate the thread tree for ARTICLE if it isn't displayed already." - (when (save-excursion - (set-buffer gnus-summary-buffer) + (when (with-current-buffer gnus-summary-buffer (and gnus-use-trees gnus-show-threads (vectorp (gnus-summary-article-header article)))) (save-excursion - (let ((top (save-excursion - (set-buffer gnus-summary-buffer) + (let ((top (with-current-buffer gnus-summary-buffer (gnus-cut-thread (gnus-remove-thread (mail-header-id @@ -816,6 +827,12 @@ Two predefined functions are available: (defun gnus-tree-close (group) (gnus-kill-buffer gnus-tree-buffer)) +(defun gnus-tree-perhaps-minimize () + (when (and gnus-tree-minimize-window + (get-buffer gnus-tree-buffer)) + (with-current-buffer gnus-tree-buffer + (gnus-tree-minimize)))) + (defun gnus-highlight-selected-tree (article) "Highlight the selected article in the tree." (let ((buf (current-buffer)) @@ -826,7 +843,8 @@ Two predefined functions are available: (gnus-extent-detached-p gnus-selected-tree-overlay)) ;; Create a new overlay. (gnus-overlay-put - (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) + (setq gnus-selected-tree-overlay + (gnus-make-overlay (point-min) (1+ (point-min)))) 'face gnus-selected-tree-face)) ;; Move the overlay to the article. (gnus-move-overlay @@ -834,194 +852,22 @@ Two predefined functions are available: (gnus-tree-minimize) (gnus-tree-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)) + (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) + (select-window (gnus-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) +;; If we remove this save-excursion, it updates the wrong mode lines?!? + (with-current-buffer gnus-tree-buffer (gnus-set-mode-line 'tree)) (set-buffer buf))) (defun gnus-tree-highlight-article (article face) - (save-excursion - (set-buffer (gnus-get-tree-buffer)) + (with-current-buffer (gnus-get-tree-buffer) (let (region) (when (setq region (gnus-tree-article-region article)) (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. -\\ -The following commands are available: - -\\{gnus-carpal-mode-map}" - (interactive) - (kill-all-local-variables) - (setq mode-line-modified (cdr gnus-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) - (setq buffer-read-only t) - (make-local-variable 'gnus-carpal-attached-buffer) - (gnus-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 (gnus-get-buffer-create buffer)) - (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer - (intern (format "gnus-%s-buffer" type))) - (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)) + (gnus-get-buffer-window (current-buffer) t) (cdr region)))))) ;;; Allow redefinition of functions. (gnus-ems-redefine)