X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-salt.el;h=164be42fb84d5f874169607c4e309fd6475839fc;hb=79a55ed7cad84f9cee85b4a052c453c1233d1bab;hp=7791c58f1c5c3e58c377ce54fac3452a187a84f3;hpb=3290776dcec80091cc398f1f800ca14ecd4e2035;p=gnus diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 7791c58f1..164be42fb 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -1,7 +1,8 @@ ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen +;; Keywords: news ;; This file is part of GNU Emacs. @@ -24,6 +25,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-sum) @@ -34,22 +37,32 @@ (defvar gnus-pick-mode nil "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") -(defvar gnus-pick-display-summary nil - "*Display summary while reading.") +(defcustom gnus-pick-display-summary nil + "*Display summary while reading." + :type 'boolean + :group 'gnus-summary-pick) -(defvar gnus-pick-mode-hook nil - "Hook run in summary pick mode buffers.") +(defcustom gnus-pick-mode-hook nil + "Hook run in summary pick mode buffers." + :type 'hook + :group 'gnus-summary-pick) -(defvar gnus-mark-unpicked-articles-as-read nil - "*If non-nil, mark all unpicked articles as read.") +(defcustom gnus-mark-unpicked-articles-as-read nil + "*If non-nil, mark all unpicked articles as read." + :type 'boolean + :group 'gnus-summary-pick) -(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.") +(defcustom gnus-pick-elegant-flow t + "If non-nil, `gnus-pick-start-reading' runs `gnus-summary-next-group' when no articles have been picked." + :type 'boolean + :group 'gnus-summary-pick) -(defvar gnus-summary-pick-line-format +(defcustom 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.") +It accepts the same format specs that `gnus-summary-line-format' does." + :type 'string + :group 'gnus-summary-pick) ;;; Internal variables. @@ -58,25 +71,12 @@ It accepts the same format specs that `gnus-summary-line-format' does.") (unless gnus-pick-mode-map (setq gnus-pick-mode-map (make-sparse-keymap)) - (gnus-define-keys - gnus-pick-mode-map - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - " " gnus-pick-next-page - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "r" gnus-uu-mark-region - "R" gnus-uu-unmark-region - "e" gnus-uu-mark-by-regexp - "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)) + (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)) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) @@ -87,14 +87,14 @@ It accepts the same format specs that `gnus-summary-line-format' does.") ["Article" gnus-summary-mark-as-processable t] ["Thread" gnus-uu-mark-thread t] ["Region" gnus-uu-mark-region t] - ["Regexp" gnus-uu-mark-regexp 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-regexp t] - ["Buffer" gnus-uu-unmark-buffer 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])))) @@ -120,12 +120,9 @@ It accepts the same format specs that `gnus-summary-line-format' does.") ;; Set up the 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)) - (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)))) + (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map + nil 'gnus-pick-mode) + (gnus-run-hooks 'gnus-pick-mode-hook)))) (defun gnus-pick-setup-message () "Make Message do the right thing on exit." @@ -133,8 +130,9 @@ It accepts the same format specs that `gnus-summary-line-format' does.") (save-excursion (set-buffer gnus-summary-buffer) gnus-pick-mode)) - (message-add-action - '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill))) + (message-add-action + '(gnus-configure-windows ,gnus-current-window-configuration t) + 'send 'exit 'postpone 'kill))) (defvar gnus-pick-line-number 1) (defun gnus-pick-line-number () @@ -153,32 +151,63 @@ If given a prefix, mark all unpicked articles as read." (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-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)) + (gnus-summary-catchup nil t)) (if (gnus-group-quit-config gnus-newsgroup-name) (gnus-summary-exit) (gnus-summary-next-group))) (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." + (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)))) + (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-pick-goto-article arg)) (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. +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 + (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. +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 + (save-excursion + (gnus-uu-unmark-thread)) + (gnus-summary-unmark-as-processable 1))) + (defun gnus-pick-mouse-pick (e) (interactive "e") (mouse-set-point e) @@ -195,8 +224,7 @@ This must be bound to a button-down mouse 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)) + (bounds (gnus-window-edges start-window)) (top (nth 1 bounds)) (bottom (if (window-minibuffer-p start-window) (nth 3 bounds) @@ -215,18 +243,16 @@ This must be bound to a button-down mouse event." ;; 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))) + (let (event end end-point (end-of-range (point))) (track-mouse (while (progn - (setq event (read-event)) + (setq event (cdr (gnus-read-event-char))) (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? @@ -300,8 +326,8 @@ This must be bound to a button-down mouse event." (setq gnus-binary-mode-map (make-sparse-keymap)) (gnus-define-keys - gnus-binary-mode-map - "g" gnus-binary-show-article)) + gnus-binary-mode-map + "g" gnus-binary-show-article)) (defun gnus-binary-make-menu-bar () (unless (boundp 'gnus-binary-menu) @@ -315,7 +341,7 @@ This must be bound to a button-down mouse event." (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-binary-mode) - (setq gnus-binary-mode + (setq gnus-binary-mode (if (null arg) (not gnus-binary-mode) (> (prefix-numeric-value arg) 0))) (when gnus-binary-mode @@ -327,12 +353,9 @@ This must be bound to a button-down mouse event." ;; Set up the 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)) - (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)))) + (gnus-add-minor-mode 'gnus-binary-mode " Binary" + gnus-binary-mode-map nil 'gnus-binary-mode) + (gnus-run-hooks 'gnus-binary-mode-hook)))) (defun gnus-binary-display-article (article &optional all-header) "Run ARTICLE through the binary decode functions." @@ -350,16 +373,23 @@ This must be bound to a button-down mouse event." ;;; gnus-tree-mode ;;; -(defvar gnus-tree-line-format "%(%[%3,3n%]%)" - "Format of tree elements.") +(defcustom gnus-tree-line-format "%(%[%3,3n%]%)" + "Format of tree elements." + :type 'string + :group 'gnus-summary-tree) -(defvar gnus-tree-minimize-window t +(defcustom gnus-tree-minimize-window t "If non-nil, minimize the tree buffer window. If a number, never let the tree buffer grow taller than that number of -lines.") +lines." + :type '(choice boolean + integer) + :group 'gnus-summary-tree) -(defvar gnus-selected-tree-face 'modeline - "*Face used for highlighting selected articles in the thread tree.") +(defcustom gnus-selected-tree-face 'modeline + "*Face used for highlighting selected articles in the thread tree." + :type 'face + :group 'gnus-summary-tree) (defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) (?\{ . ?\}) (?< . ?>)) @@ -368,20 +398,28 @@ lines.") (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) "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.") +(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z" + "*The format specification for the tree mode line." + :type 'string + :group 'gnus-summary-tree) -(defvar gnus-generate-tree-function 'gnus-generate-vertical-tree +(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree "*Function for generating a thread tree. Two predefined functions are available: -`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.") +`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'." + :type '(radio (function-item gnus-generate-vertical-tree) + (function-item gnus-generate-horizontal-tree) + (function :tag "Other" nil)) + :group 'gnus-summary-tree) -(defvar gnus-tree-mode-hook nil - "*Hook run in tree mode buffers.") +(defcustom gnus-tree-mode-hook nil + "*Hook run in tree mode buffers." + :type 'hook + :group 'gnus-summary-tree) ;;; Internal variables. -(defvar gnus-tree-line-format-alist +(defvar gnus-tree-line-format-alist `((?n gnus-tmp-name ?s) (?f gnus-tmp-from ?s) (?N gnus-tmp-number ?d) @@ -398,6 +436,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) @@ -406,12 +445,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 + 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)) @@ -426,12 +466,8 @@ Two predefined functions are available: (defun gnus-tree-mode () "Major mode for displaying thread trees." (interactive) - (setq gnus-tree-mode-line-format-spec - (gnus-parse-format gnus-tree-mode-line-format - gnus-summary-mode-line-format-alist)) - (setq gnus-tree-line-format-spec - (gnus-parse-format gnus-tree-line-format - gnus-tree-line-format-alist t)) + (gnus-set-format 'tree-mode) + (gnus-set-format 'tree t) (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) (kill-all-local-variables) @@ -439,26 +475,37 @@ Two predefined functions are available: (setq mode-name "Tree") (setq major-mode 'gnus-tree-mode) (use-local-map gnus-tree-mode-map) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (setq buffer-read-only t) (setq truncate-lines t) (save-excursion (gnus-set-work-buffer) (gnus-tree-node-insert (make-mail-header "") nil) (setq gnus-tree-node-length (1- (point)))) - (run-hooks 'gnus-tree-mode-hook)) + (gnus-run-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) - (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." + (interactive) + (if (not (gnus-buffer-live-p gnus-summary-buffer)) + (error "There is no summary buffer for this tree buffer") + (gnus-configure-windows 'article) + (gnus-summary-goto-subject gnus-current-article))) (defun gnus-tree-select-article (article) "Select the article under point, if any." @@ -481,12 +528,14 @@ Two predefined functions are available: (defun gnus-tree-article-region (article) "Return a cons with BEG and END of the article region." - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (let ((pos (text-property-any + (point-min) (point-max) 'gnus-number article))) (when pos (cons pos (next-single-property-change pos 'gnus-number))))) (defun gnus-tree-goto-article (article) - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (let ((pos (text-property-any + (point-min) (point-max) 'gnus-number article))) (when pos (goto-char pos)))) @@ -509,16 +558,15 @@ Two predefined functions are available: ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start - tree-window (min bottom (save-excursion + tree-window (min bottom (save-excursion (forward-line (- top)) (point))))) (select-window selected)))) (defun gnus-get-tree-buffer () "Return the tree buffer properly initialized." (save-excursion - (set-buffer (get-buffer-create gnus-tree-buffer)) + (set-buffer (gnus-get-buffer-create gnus-tree-buffer)) (unless (eq major-mode 'gnus-tree-mode) - (gnus-add-current-to-buffer-list) (gnus-tree-mode)) (current-buffer))) @@ -528,7 +576,7 @@ Two predefined functions are available: (let ((windows 0) tot-win-height) (walk-windows (lambda (window) (incf windows))) - (setq tot-win-height + (setq tot-win-height (- (frame-height) (* window-min-height (1- windows)) 2)) @@ -613,8 +661,8 @@ Two predefined functions are available: (not (eval (caar list)))) (setq list (cdr list))))) (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face + (gnus-put-text-property-excluding-characters-with-faces + beg end 'face (if (boundp face) (symbol-value face) face))))) (defun gnus-tree-indent (level) @@ -646,7 +694,9 @@ Two predefined functions are available: "Generate a horizontal 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)))) col beg) (if (not do) ;; We don't want this article. @@ -663,7 +713,7 @@ Two predefined functions are available: (while (progn (forward-line -1) (forward-char col) - (= (following-char) ? )) + (eq (char-after) ? )) (delete-char 1) (insert (caddr gnus-tree-parent-child-edges))) (goto-char beg))) @@ -718,13 +768,13 @@ Two predefined functions are available: (delete-char -1) (insert (cadr gnus-tree-parent-child-edges)) (setq beg (point)) + (forward-char -1) ;; Draw "-" lines leftwards. - (while (progn - (unless (bolp) - (forward-char -2)) - (= (following-char) ? )) - (delete-char 1) - (insert (car gnus-tree-parent-child-edges))) + (while (and (> (point) 1) + (eq (char-after (1- (point))) ? )) + (delete-char -1) + (insert (car gnus-tree-parent-child-edges)) + (forward-char -1)) (goto-char beg) (gnus-tree-forward-line 1))) (setq dummyp nil) @@ -757,8 +807,8 @@ Two predefined functions are available: (let ((top (save-excursion (set-buffer gnus-summary-buffer) (gnus-cut-thread - (gnus-remove-thread - (mail-header-id + (gnus-remove-thread + (mail-header-id (gnus-summary-article-header article)) t)))) (gnus-tmp-limit gnus-newsgroup-limit) @@ -772,8 +822,7 @@ Two predefined functions are available: (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." @@ -788,7 +837,7 @@ Two predefined functions are available: (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-move-overlay gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) (gnus-tree-minimize) (gnus-tree-recenter) @@ -809,7 +858,7 @@ Two predefined functions are available: (let (region) (when (setq region (gnus-tree-article-region article)) (gnus-put-text-property (car region) (cdr region) 'face face) - (set-window-point + (set-window-point (get-buffer-window (current-buffer) t) (cdr region)))))) ;;; @@ -841,7 +890,7 @@ Two predefined functions are available: ("exit" . gnus-group-exit))) (defvar gnus-carpal-summary-buffer-buttons - '("mark" + '("mark" ("read" . gnus-summary-mark-as-read-forward) ("tick" . gnus-summary-tick-article-forward) ("clear" . gnus-summary-clear-mark-forward) @@ -874,7 +923,7 @@ Two predefined functions are available: ("exit" . gnus-summary-exit) ("fed-up" . gnus-summary-catchup-and-goto-next-group))) -(defvar gnus-carpal-server-buffer-buttons +(defvar gnus-carpal-server-buffer-buttons '(("add" . gnus-server-add-server) ("browse" . gnus-server-browse-server) ("list" . gnus-server-list-servers) @@ -924,27 +973,26 @@ The following commands are available: \\{gnus-carpal-mode-map}" (interactive) (kill-all-local-variables) - (setq mode-line-modified "-- ") + (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 (current-buffer)) + (buffer-disable-undo) (setq buffer-read-only t) (make-local-variable 'gnus-carpal-attached-buffer) - (run-hooks 'gnus-carpal-mode-hook)) + (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 (get-buffer-create buffer)) + (set-buffer (gnus-get-buffer-create buffer)) (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer + (setq gnus-carpal-attached-buffer (intern (format "gnus-%s-buffer" type))) - (gnus-add-current-to-buffer-list) - (let ((buttons (symbol-value + (let ((buttons (symbol-value (intern (format "gnus-carpal-%s-buffer-buttons" type)))) (buffer-read-only nil)