X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=3e79b186c83b6b885e68ec4a65c6afdd28e5cfbd;hp=602ee31944a1cf17de86adc2b8fa65b71c77ab49;hb=70ff151cb4e485521a6fd201556153c2a3ec05e4;hpb=6ce1ca7f3be9ad05a04a9138526bd596599b758d diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 602ee3194..3e79b186c 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,7 +1,7 @@ ;;; gnus-group.el --- group mode commands for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -110,6 +110,18 @@ If nil, no groups are permanently visible." :group 'gnus-group-listing :type '(choice regexp (const nil))) +(defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]" + "Groups in which links in html articles are considered all safe. +The value may be a regexp matching those groups, a list of group names, +or nil. This overrides `mm-w3m-safe-url-regexp' (which see). This is +effective only when emacs-w3m renders html articles, i.e., in the case +`mm-text-html-renderer' is set to `w3m'." + :version "23.2" + :group 'gnus-group-various + :type '(choice regexp + (repeat :tag "List of group names" (string :tag "Group")) + (const nil))) + (defcustom gnus-list-groups-with-ticked-articles t "*If non-nil, list groups that have only ticked articles. If nil, only list groups that have unread articles." @@ -157,7 +169,7 @@ list." (function-item gnus-group-sort-by-rank) (function :tag "other" nil)))) -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n" +(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -497,7 +509,10 @@ simple manner.") (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) (t number)) ?s) (?R gnus-tmp-number-of-read ?s) - (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d) + (?U (if (gnus-active gnus-tmp-group) + (gnus-number-of-unseen-articles-in-group gnus-tmp-group) + "*") + ?s) (?t gnus-tmp-number-total ?d) (?y gnus-tmp-number-of-unread ?s) (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) @@ -648,7 +663,6 @@ simple manner.") "h" gnus-group-make-help-group "u" gnus-group-make-useful-group "a" gnus-group-make-archive-group - "k" gnus-group-make-kiboze-group "l" gnus-group-nnimap-edit-acl "m" gnus-group-make-group "E" gnus-group-edit-group @@ -668,13 +682,6 @@ simple manner.") "\177" gnus-group-delete-group [delete] gnus-group-delete-group) -(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) - "b" gnus-group-brew-soup - "w" gnus-soup-save-areas - "s" gnus-soup-send-replies - "p" gnus-soup-pack-packet - "r" nnsoup-pack-replies) - (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) "s" gnus-group-sort-groups "a" gnus-group-sort-groups-by-alphabet @@ -926,7 +933,6 @@ simple manner.") ["Add the archive group" gnus-group-make-archive-group t] ["Make a doc group..." gnus-group-make-doc-group t] ["Make a web group..." gnus-group-make-web-group t] - ["Make a kiboze group..." gnus-group-make-kiboze-group t] ["Make a virtual group..." gnus-group-make-empty-virtual t] ["Add a group to a virtual..." gnus-group-add-to-virtual t] ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] @@ -960,13 +966,6 @@ simple manner.") (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" `("Gnus" - ("SOUP" - ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] - ["Send replies" gnus-soup-send-replies - (fboundp 'gnus-soup-pack-packet)] - ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] - ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] - ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) ["Send a mail" gnus-group-mail t] ["Send a message (mail or news)" gnus-group-post-news t] ["Create a local message" gnus-group-news t] @@ -984,7 +983,6 @@ simple manner.") ["Browse foreign server..." gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ["Expire all expirable articles" gnus-group-expire-all-groups t] - ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] ["Save .newsrc files" gnus-group-save-newsrc t] ["Suspend Gnus" gnus-group-suspend t] @@ -1278,7 +1276,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (zerop number)) (zerop (buffer-size))) ;; No groups in the buffer. - (gnus-message 5 gnus-no-groups-message)) + (gnus-message 5 "%s" gnus-no-groups-message)) ;; We have some groups displayed. (goto-char (point-max)) (when (or (not gnus-group-goto-next-group-function) @@ -1360,7 +1358,8 @@ if it is a string, only list groups matching REGEXP." (setq not-in-list (delete group not-in-list))) (when (gnus-group-prepare-logic group - (and unread ; This group might be unchecked + (and (or unread ; This group might be unchecked + predicate) ; Check if this group should be listed (or (not (stringp regexp)) (string-match regexp group)) (<= (setq clevel (gnus-info-level info)) level) @@ -1374,7 +1373,7 @@ if it is a string, only list groups matching REGEXP." (if (eq unread t) ; Unactivated? gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) + (and (numberp unread) (> unread 0))) ; We list groups with unread articles (and gnus-list-groups-with-ticked-articles (cdr (assq 'tick (gnus-info-marks info)))) @@ -1692,72 +1691,66 @@ if it is a string, only list groups matching REGEXP." "Update all lines where GROUP appear. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." - ;; Can't use `save-excursion' here, so we do it manually. - (let ((buf (current-buffer)) - mark) - (set-buffer gnus-group-buffer) - (setq mark (point-marker)) - ;; The buffer may be narrowed. - (save-restriction - (widen) - (let ((ident (gnus-intern-safe group gnus-active-hashtb)) - (loc (point-min)) - found buffer-read-only) - ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-group-entry group))) - (when (and entry - (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")")))) - ;; Find all group instances. If topics are in use, each group - ;; may be listed in more than once. - (while (setq loc (text-property-any - loc (point-max) 'gnus-group ident)) - (setq found t) - (goto-char loc) - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook))) - (setq loc (1+ loc))) - (unless (or found visible-only) - ;; No such line in the buffer, find out where it's supposed to - ;; go, and insert it there (or at the end of the buffer). - (if gnus-goto-missing-group-function - (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-group-entry group)))) - (while (and entry (car entry) - (not - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - (caar entry) gnus-active-hashtb))))) - (setq entry (cdr entry))) - (or entry (goto-char (point-max))))) - ;; Finally insert the line. - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook)))) - (when gnus-group-update-group-function - (funcall gnus-group-update-group-function group)) - (gnus-group-set-mode-line))) - (goto-char mark) - (set-marker mark nil) - (set-buffer buf))) + (with-current-buffer gnus-group-buffer + (save-excursion + ;; The buffer may be narrowed. + (save-restriction + (widen) + (let ((ident (gnus-intern-safe group gnus-active-hashtb)) + (loc (point-min)) + found buffer-read-only) + ;; Enter the current status into the dribble buffer. + (let ((entry (gnus-group-entry group))) + (when (and entry + (not (gnus-ephemeral-group-p group))) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string (nth 2 entry)) + ")")))) + ;; Find all group instances. If topics are in use, each group + ;; may be listed in more than once. + (while (setq loc (text-property-any + loc (point-max) 'gnus-group ident)) + (setq found t) + (goto-char loc) + (let ((gnus-group-indentation (gnus-group-group-indentation))) + (gnus-delete-line) + (gnus-group-insert-group-line-info group) + (save-excursion + (forward-line -1) + (gnus-run-hooks 'gnus-group-update-group-hook))) + (setq loc (1+ loc))) + (unless (or found visible-only) + ;; No such line in the buffer, find out where it's supposed to + ;; go, and insert it there (or at the end of the buffer). + (if gnus-goto-missing-group-function + (funcall gnus-goto-missing-group-function group) + (let ((entry (cddr (gnus-group-entry group)))) + (while (and entry (car entry) + (not + (gnus-goto-char + (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe + (caar entry) + gnus-active-hashtb))))) + (setq entry (cdr entry))) + (or entry (goto-char (point-max))))) + ;; Finally insert the line. + (let ((gnus-group-indentation (gnus-group-group-indentation))) + (gnus-group-insert-group-line-info group) + (save-excursion + (forward-line -1) + (gnus-run-hooks 'gnus-group-update-group-hook)))) + (when gnus-group-update-group-function + (funcall gnus-group-update-group-function group)) + (gnus-group-set-mode-line)))))) (defun gnus-group-set-mode-line () "Update the mode line in the group buffer." (when (memq 'group gnus-updated-mode-lines) ;; Yes, we want to keep this mode line updated. - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (let* ((gformat (or gnus-group-mode-line-format-spec (gnus-set-format 'group-mode))) (gnus-tmp-news-server (cadr gnus-select-method)) @@ -1770,8 +1763,7 @@ already." (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) + (with-current-buffer gnus-dribble-buffer (not (zerop (buffer-size)))))) (mode-string (eval gformat))) ;; Say whether the dribble buffer has been modified. @@ -2189,7 +2181,10 @@ be permanent." The arguments are the same as `completing-read' except that COLLECTION and HIST default to `gnus-active-hashtb' and `gnus-group-history' respectively if they are omitted." - (let (group) + (let ((completion-styles (and (boundp 'completion-styles) + completion-styles)) + group) + (push 'substring completion-styles) (mapatoms (lambda (symbol) (setq group (symbol-name symbol)) (set (intern (if (string-match "[^\000-\177]" group) @@ -2351,7 +2346,7 @@ specified by `gnus-gmane-group-download-format'." (unless range (setq range 500)) (when (< range 1) (error "Invalid range: %s" range)) - (let ((tmpfile (make-temp-file + (let ((tmpfile (mm-make-temp-file (format "%s.start-%s.range-%s." group start range))) (gnus-thread-sort-functions '(gnus-thread-sort-by-number))) (with-temp-file tmpfile @@ -2413,15 +2408,14 @@ Valid input formats include: (gnus-read-ephemeral-gmane-group group start range))) (defcustom gnus-bug-group-download-format-alist - '((emacs ;; Only a test bed yet: - . "http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?mbox=yes;bug=%s") + '((emacs . "http://debbugs.gnu.org/%s;mbox=yes") (debian . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes")) "Alist of symbols for bug trackers and the corresponding URL format string. The URL format string must contain a single \"%s\", specifying the bug number, and browsing the URL must return mbox output." :group 'gnus-group-foreign - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type '(repeat (cons (symbol) (string :tag "URL format string")))) (defun gnus-read-ephemeral-bug-group (number mbox-url) @@ -2433,7 +2427,7 @@ the bug number, and browsing the URL must return mbox output." (cdr (assoc 'emacs gnus-bug-group-download-format-alist)))) (when (stringp number) (setq number (string-to-number number))) - (let ((tmpfile (make-temp-file "gnus-temp-group-"))) + (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) (with-temp-file tmpfile (url-insert-file-contents (format mbox-url number)) (write-region (point-min) (point-max) tmpfile) @@ -3082,42 +3076,6 @@ If there is, use Gnus to create an nnrss group" (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) -(defvar nnwarchive-type-definition) -(defvar gnus-group-warchive-type-history nil) -(defvar gnus-group-warchive-login-history nil) -(defvar gnus-group-warchive-address-history nil) - -(defun gnus-group-make-warchive-group () - "Create a nnwarchive group." - (interactive) - (require 'nnwarchive) - (let* ((group (gnus-read-group "Group name: ")) - (default-type (or (car gnus-group-warchive-type-history) - (symbol-name (caar nnwarchive-type-definition)))) - (type - (gnus-string-or - (completing-read - (format "Warchive type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) - nnwarchive-type-definition) - nil t nil 'gnus-group-warchive-type-history) - default-type)) - (address (read-string "Warchive address: " - nil 'gnus-group-warchive-address-history)) - (default-login (or (car gnus-group-warchive-login-history) - user-mail-address)) - (login - (gnus-string-or - (read-string - (format "Warchive login (default %s): " user-mail-address) - default-login 'gnus-group-warchive-login-history) - user-mail-address)) - (method - `(nnwarchive ,address - (nnwarchive-type ,(intern type)) - (nnwarchive-login ,login)))) - (gnus-group-make-group group method))) - (defun gnus-group-make-archive-group (&optional all) "Create the (ding) Gnus archive group of the most recent articles. Given a prefix, create a full group." @@ -3158,41 +3116,6 @@ mail messages or news articles in files that have numeric names." (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(defvar nnkiboze-score-file) -(declare-function nnkiboze-score-file "nnkiboze" (group)) - -(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 -score file entries for articles to include in the group." - (interactive - (list - (read-string "nnkiboze group name: ") - (read-string "Source groups (regexp): ") - (let ((headers (mapcar 'list - '("subject" "from" "number" "date" "message-id" - "references" "chars" "lines" "xref" - "followup" "all" "body" "head"))) - scores header regexp regexps) - (while (not (equal "" (setq header (completing-read - "Match on header: " headers nil t)))) - (setq regexps nil) - (while (not (equal "" (setq regexp (read-string - (format "Match on %s (regexp): " - header))))) - (push (list regexp nil nil 'r) regexps)) - (push (cons header regexps) scores)) - scores))) - (gnus-group-make-group group "nnkiboze" address) - (let* ((nnkiboze-current-group group) - (score-file (car (nnkiboze-score-file ""))) - (score-dir (file-name-directory score-file))) - (unless (file-exists-p score-dir) - (make-directory score-dir)) - (with-temp-file score-file - (let (emacs-lisp-mode-hook) - (gnus-pp scores))))) - (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." (interactive @@ -4062,23 +3985,13 @@ re-scanning. If ARG is non-nil and not a number, this will force (>= arg gnus-use-nocem)) (not arg))) (gnus-nocem-scan-groups)) - ;; If ARG is not a number, then we read the active file. - (when (and arg (not (numberp arg))) - (let ((gnus-read-active-file t)) - (gnus-read-active-file)) - (setq arg nil) - - ;; If the user wants it, we scan for new groups. - (when (eq gnus-check-new-newsgroups 'always) - (gnus-find-new-newsgroups))) - - (setq arg (gnus-group-default-level arg t)) - (if (and gnus-read-active-file (not arg)) - (progn - (gnus-read-active-file) - (gnus-get-unread-articles arg)) - (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) - (gnus-get-unread-articles arg))) + + (gnus-get-unread-articles arg) + + ;; If the user wants it, we scan for new groups. + (when (eq gnus-check-new-newsgroups 'always) + (gnus-find-new-newsgroups)) + (gnus-check-reasonable-setup) (gnus-run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups (and (numberp arg) @@ -4226,7 +4139,7 @@ If given a prefix argument, prompt for a group." (gnus-gethash mname gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) (gnus-read-descriptions-file method)) - (gnus-message 1 + (gnus-message 1 "%s" (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) @@ -4387,11 +4300,9 @@ If GROUP, edit that local kill file instead." (interactive "P") (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) - (gnus-message - 6 - (substitute-command-keys - (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" - (if group "local" "global"))))) + (gnus-message 6 "Editing a %s kill file (Type %s to exit)" + (if group "local" "global") + (substitute-command-keys "\\[gnus-kill-file-exit]"))) (defun gnus-group-edit-local-kill (article group) "Edit a local kill file." @@ -4468,8 +4379,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (gnus-run-hooks 'gnus-exit-gnus-hook) (gnus-configure-windows 'group t) (when (and (gnus-buffer-live-p gnus-dribble-buffer) - (not (zerop (save-excursion - (set-buffer gnus-dribble-buffer) + (not (zerop (with-current-buffer gnus-dribble-buffer (buffer-size))))) (gnus-dribble-enter ";;; Gnus was exited on purpose without saving the .newsrc files.")) @@ -4483,7 +4393,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (defun gnus-group-describe-briefly () "Give a one line description of the group mode commands." (interactive) - (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) + (gnus-message 7 "%s" (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) (defun gnus-group-browse-foreign-server (method) "Browse a foreign news server. @@ -4530,13 +4440,11 @@ and the second element is the address." (setcar (nthcdr (1- total) info) part-info))) (unless entry ;; This is a new group, so we just create it. - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (setq method (gnus-info-method info)) (when (gnus-server-equal method "native") (setq method nil)) - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (if method ;; It's a foreign group... (gnus-group-make-group @@ -4600,8 +4508,7 @@ and the second element is the address." "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." (let ((buffer (gnus-summary-buffer-name group))) (if (gnus-buffer-live-p buffer) - (save-excursion - (set-buffer (get-buffer buffer)) + (with-current-buffer (get-buffer buffer) (gnus-summary-add-mark article mark)) (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) (list article))))) @@ -4801,5 +4708,4 @@ Compacting group %s... (this may take a long time)" (provide 'gnus-group) -;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 ;;; gnus-group.el ends here