X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-group.el;h=b1dca09728efd4007073160be99a508d5a45df9d;hb=fbb493f9afd70ead7e736b7e8244796d76db5cfc;hp=92af017d0eae8dc2e48d41987cd1fda54646e3da;hpb=cd70301fa08903f2ec311c95429aed3adac4b80e;p=gnus diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 92af017d0..b1dca0972 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -37,6 +37,7 @@ (require 'gnus-win) (require 'gnus-undo) (require 'time-date) +(require 'gnus-ems) (defcustom gnus-group-archive-directory "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" @@ -117,8 +118,8 @@ This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', `gnus-group-sort-by-unread', `gnus-group-sort-by-level', -`gnus-group-sort-by-score', `gnus-group-sort-by-method', and -`gnus-group-sort-by-rank'. +`gnus-group-sort-by-score', `gnus-group-sort-by-method', +`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'. This variable can also be a list of sorting functions. In that case, the most significant sort function should be the last function in the @@ -131,6 +132,7 @@ list." (function-item gnus-group-sort-by-level) (function-item gnus-group-sort-by-score) (function-item gnus-group-sort-by-method) + (function-item gnus-group-sort-by-server) (function-item gnus-group-sort-by-rank) (function :tag "other" nil))) @@ -400,6 +402,7 @@ ticked: The number of ticked articles." For example: (((nntp \"news.com.cn\") . cn-gb-2312)) " + :version "21.1" :group 'gnus-charset :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) @@ -412,6 +415,15 @@ For example: :group 'gnus-charset :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) +(defcustom gnus-group-jump-to-group-prompt nil + "Default prompt for `gnus-group-jump-to-group'. +If non-nil, the value should be a string, e.g. \"nnml:\", +in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" +in the minibuffer prompt." + :group 'gnus-group-various + :type '(choice (string :tag "Prompt string") + (const :tag "Empty" nil))) + ;;; Internal variables (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat @@ -689,21 +701,29 @@ For example: (easy-menu-define gnus-group-reading-menu gnus-group-mode-map "" - '("Group" + `("Group" ["Read" gnus-group-read-group (gnus-group-group-name)] ["Select" gnus-group-select-group (gnus-group-group-name)] ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC" :active (gnus-group-group-name)] - ["Catch up" gnus-group-catchup-current (gnus-group-group-name)] + ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Mark unread articles in the current group as read"))] ["Catch up all articles" gnus-group-catchup-current-all (gnus-group-group-name)] ["Check for new articles" gnus-group-get-new-news-this-group - (gnus-group-group-name)] + :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Check for new messages in current group"))] ["Toggle subscription" gnus-group-unsubscribe-current-group (gnus-group-group-name)] - ["Kill" gnus-group-kill-group (gnus-group-group-name)] + ["Kill" gnus-group-kill-group :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Kill (remove) current group"))] ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] - ["Describe" gnus-group-describe-group (gnus-group-group-name)] + ["Describe" gnus-group-describe-group :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display description of the current group"))] ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) @@ -819,7 +839,7 @@ For example: (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" - '("Misc" + `("Misc" ("SOUP" ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] ["Send replies" gnus-soup-send-replies @@ -829,7 +849,10 @@ For example: ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) ["Send a mail" gnus-group-mail t] ["Post an article..." gnus-group-post-news t] - ["Check for new news" gnus-group-get-new-news t] + ["Check for new news" gnus-group-get-new-news + ,@(if (featurep 'xemacs) nil + '(:help "Get newly arrived articles")) + ] ["Activate all groups" gnus-activate-all-groups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] @@ -845,11 +868,42 @@ For example: ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] ["Send a bug report" gnus-bug t] - ["Exit from Gnus" gnus-group-exit t] + ["Exit from Gnus" gnus-group-exit + ,@(if (featurep 'xemacs) nil + '(:help "Quit reading news"))] ["Exit without saving" gnus-group-quit t])) (gnus-run-hooks 'gnus-group-menu-hook))) +(defvar gnus-group-toolbar-map nil) + +;; Emacs 21 tool bar. Should be no-op otherwise. +(defun gnus-group-make-tool-bar () + (if (and (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-group-toolbar-map)) + (setq gnus-group-toolbar-map + (let ((tool-bar-map (make-sparse-keymap)) + (load-path (mm-image-load-path))) + (tool-bar-add-item-from-menu + 'gnus-group-get-new-news "get-news" gnus-group-mode-map) + (tool-bar-add-item-from-menu + 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map) + (tool-bar-add-item-from-menu + 'gnus-group-catchup-current "catchup" gnus-group-mode-map) + (tool-bar-add-item-from-menu + 'gnus-group-describe-group "describe-group" gnus-group-mode-map) + (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe + :help "Subscribe to the current group") + (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe + 'unsubscribe + :help "Unsubscribe from the current group") + (tool-bar-add-item-from-menu + 'gnus-group-exit "exit-gnus" gnus-group-mode-map) + tool-bar-map))) + (if gnus-group-toolbar-map + (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map))) + (defun gnus-group-mode () "Major mode for reading news. @@ -868,9 +922,10 @@ The following commands are available: \\{gnus-group-mode-map}" (interactive) - (when (gnus-visual-p 'group-menu 'menu) - (gnus-group-make-menu-bar)) (kill-all-local-variables) + (when (gnus-visual-p 'group-menu 'menu) + (gnus-group-make-menu-bar) + (gnus-group-make-tool-bar)) (gnus-simplify-mode-line) (setq major-mode 'gnus-group-mode) (setq mode-name "Group") @@ -1053,8 +1108,7 @@ if it is a string, only list groups matching REGEXP." (newsrc (cdr gnus-newsrc-alist)) (lowest (or lowest 1)) (not-in-list (and gnus-group-listed-groups - (not (eq gnus-group-list-option 'limit)) - (copy-sequence gnus-group-listed-groups))) + (copy-sequence gnus-group-listed-groups))) info clevel unread group params) (erase-buffer) (when (or (< lowest gnus-level-zombie) @@ -1113,8 +1167,9 @@ if it is a string, only list groups matching REGEXP." (if (or gnus-group-listed-groups (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) (gnus-group-prepare-flat-list-dead - (or not-in-list - (setq gnus-killed-list (sort gnus-killed-list 'string<))) + (gnus-union + not-in-list + (setq gnus-killed-list (sort gnus-killed-list 'string<))) gnus-level-killed ?K regexp)) (gnus-group-set-mode-line) @@ -1146,8 +1201,12 @@ if it is a string, only list groups matching REGEXP." ;;; 'gnus-level level)) (gnus-group-insert-group-line group level nil - (if gnus-server-browse-hashtb - (gnus-gethash group gnus-server-browse-hashtb) t) + (let ((active (gnus-active group))) + (if active + (if (zerop (cdr active)) + 0 + (- (1+ (cdr active)) (car active))) + nil)) (gnus-method-simplify (gnus-find-method-for-group group))))))) (defun gnus-group-update-group-line () @@ -1191,7 +1250,7 @@ if it is a string, only list groups matching REGEXP." 0 (- (1+ (cdr active)) (car active))) nil) - nil)))) + (gnus-method-simplify (gnus-find-method-for-group group)))))) (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number @@ -1821,7 +1880,7 @@ Return the name of the group if selection was successful." (list (completing-read "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) - nil + gnus-group-jump-to-group-prompt 'gnus-group-history))) (when (equal group "") @@ -2376,14 +2435,14 @@ mail messages or news articles in files that have numeric names." (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) (setq group (gnus-group-prefixed-name - (concat (file-name-as-directory (directory-file-name dir)) - ext) + (expand-file-name ext dir) '(nndir ""))) (setq ext (format "<%d>" (setq i (1+ i))))) (gnus-group-make-group (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) +(eval-when-compile (defvar nnkiboze-score-file)) (defun gnus-group-make-kiboze-group (group address scores) "Create an nnkiboze group. The user will be prompted for a name, a regexp to match groups, and @@ -2586,6 +2645,12 @@ If REVERSE, sort in reverse order." (interactive "P") (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) +(defun gnus-group-sort-groups-by-server (&optional reverse) + "Sort the group buffer alphabetically by server name. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-server reverse)) + ;;; Selected group sorting. (defun gnus-group-sort-selected-groups (n func &optional reverse) @@ -2690,6 +2755,15 @@ sort in reverse order." (symbol-name (car (gnus-find-method-for-group (gnus-info-group info2) info2))))) +(defun gnus-group-sort-by-server (info1 info2) + "Sort alphabetically by server name." + (string< (gnus-method-to-server-name + (gnus-find-method-for-group + (gnus-info-group info1) info1)) + (gnus-method-to-server-name + (gnus-find-method-for-group + (gnus-info-group info2) info2)))) + (defun gnus-group-sort-by-score (info1 info2) "Sort by group score." (< (gnus-info-score info1) (gnus-info-score info2))) @@ -3313,7 +3387,7 @@ to use." (when current-prefix-arg (completing-read "Faq dir: " (and (listp gnus-group-faq-directory) - (mapcar (lambda (file) (list file)) + (mapcar #'list gnus-group-faq-directory)))))) (unless group (error "No group name given")) @@ -3324,7 +3398,7 @@ to use." (while (and (not found) (setq dir (pop dirs))) (let ((name (gnus-group-real-name group))) - (setq file (concat (file-name-as-directory dir) name))) + (setq file (expand-file-name name dir))) (if (not (file-exists-p file)) (gnus-message 1 "No such file: %s" file) (let ((enable-local-variables nil))