X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus.el;h=2ebdfb12b7879bff89d6d4ab85a130819873fafb;hp=18cb8e41dac092cdf00537e8ff08c238a1b3285d;hb=cf1cc15caa87116a3869bbfaea7cd0b02a8250e2;hpb=6596e287aaa6b58bc2603bc113a99ee22a924381 diff --git a/lisp/gnus.el b/lisp/gnus.el index 18cb8e41d..2ebdfb12b 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,7 +1,6 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 1987-1990, 1993-1998, 2000-2012 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -29,7 +28,7 @@ (eval '(run-hooks 'gnus-load-hook)) -;; For Emacs < 22.2. +;; For Emacs <22.2 and XEmacs. (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) @@ -37,6 +36,7 @@ (require 'wid-edit) (require 'mm-util) (require 'nnheader) +(require 'gnus-compat) ;; These are defined afterwards with gnus-define-group-parameter (defvar gnus-ham-process-destinations) @@ -275,7 +275,7 @@ (defgroup gnus-meta nil "Meta variables controlling major portions of Gnus. -In general, modifying these variables does not take affect until Gnus +In general, modifying these variables does not take effect until Gnus is restarted, and sometimes reloaded." :group 'gnus) @@ -294,10 +294,10 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.11" +(defconst gnus-version-number "0.2" "Version number for this version of Gnus.") -(defconst gnus-version (format "No Gnus v%s" gnus-version-number) +(defconst gnus-version (format "Ma Gnus v%s" gnus-version-number) "Version string for this version of Gnus.") (defcustom gnus-inhibit-startup-message nil @@ -307,9 +307,6 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) -(unless (fboundp 'gnus-group-remove-excess-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore)) - (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) @@ -352,7 +349,6 @@ be set in `.emacs' instead." (list str)) line))) (defalias 'gnus-mode-line-buffer-identification 'identity)) - (defalias 'gnus-characterp 'numberp) (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) (defalias 'gnus-key-press-event-p 'numberp) @@ -704,7 +700,7 @@ be set in `.emacs' instead." (defface gnus-summary-cancelled '((((class color)) (:foreground "yellow" :background "black"))) - "Face used for cancelled articles." + "Face used for canceled articles." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled) @@ -920,7 +916,8 @@ be set in `.emacs' instead." ;;; Gnus buffers ;;; -(defvar gnus-buffers nil) +(defvar gnus-buffers nil + "List of buffers handled by Gnus.") (defun gnus-get-buffer-create (name) "Do the same as `get-buffer-create', but store the created buffer." @@ -952,7 +949,8 @@ be set in `.emacs' instead." ;;; Splash screen. -(defvar gnus-group-buffer "*Group*") +(defvar gnus-group-buffer "*Group*" + "Name of the Gnus group buffer.") (defface gnus-splash '((((class color) @@ -991,8 +989,6 @@ be set in `.emacs' instead." (while (search-forward "\t" nil t) (replace-match " " t t)))))) -(defvar gnus-simple-splash nil) - ;;(format "%02x%02x%02x" 114 66 20) "724214" (defvar gnus-logo-color-alist @@ -1013,10 +1009,11 @@ be set in `.emacs' instead." (purp "#9999cc" "#666699") (no "#ff0000" "#ffff00") (neutral "#b4b4b4" "#878787") + (ma "#2020e0" "#8080ff") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") -(defcustom gnus-logo-color-style 'no +(defcustom gnus-logo-color-style 'ma "*Color styles used for the Gnus logo." :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) gnus-logo-color-alist)) @@ -1032,50 +1029,50 @@ be set in `.emacs' instead." "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) - (cond - ((and - (fboundp 'find-image) - (display-graphic-p) - ;; Make sure the library defining `image-load-path' is loaded - ;; (`find-image' is autoloaded) (and discard the result). Else, we may - ;; get "defvar ignored because image-load-path is let-bound" when calling - ;; `find-image' below. - (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) - (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) - (image-load-path (cond (data-directory - (list data-directory)) - ((boundp 'image-load-path) - (symbol-value 'image-load-path)) - (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" - :color-symbols - (("thing" . ,(car gnus-logo-colors)) - ("shadow" . ,(cadr gnus-logo-colors)) - ("oort" . "#eeeeee") - ("background" . ,(face-background 'default)))) - (:type svg :file "gnus.svg") - (:type png :file "gnus.png") - (:type pbm :file "gnus.pbm" - ;; Account for the pbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)) - (:type xbm :file "gnus.xbm" - ;; Account for the xbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) - (when image - (let ((size (image-size image))) - (insert-char ?\n (max 0 (round (- (window-height) - (or y (cdr size)) 1) 2))) - (insert-char ?\ (max 0 (round (- (window-width) - (or x (car size))) 2))) - (insert-image image)) - (setq gnus-simple-splash nil) - t)))) - (t + (unless (and + (fboundp 'find-image) + (display-graphic-p) + ;; Make sure the library defining `image-load-path' is + ;; loaded (`find-image' is autoloaded) (and discard the + ;; result). Else, we may get "defvar ignored because + ;; image-load-path is let-bound" when calling `find-image' + ;; below. + (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) + (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) + (image-load-path (cond (data-directory + (list data-directory)) + ((boundp 'image-load-path) + (symbol-value 'image-load-path)) + (t load-path))) + (image (gnus-splash-svg-color-symbols (find-image + `((:type svg :file "gnus.svg" + :color-symbols + (("#bf9900" . ,(car gnus-logo-colors)) + ("#ffcc00" . ,(cadr gnus-logo-colors)))) + (:type xpm :file "gnus.xpm" + :color-symbols + (("thing" . ,(car gnus-logo-colors)) + ("shadow" . ,(cadr gnus-logo-colors)))) + (:type png :file "gnus.png") + (:type pbm :file "gnus.pbm" + ;; Account for the pbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default)) + (:type xbm :file "gnus.xbm" + ;; Account for the xbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default))))))) + (when image + (let ((size (image-size image))) + (insert-char ?\n (max 0 (round (- (window-height) + (or y (cdr size)) 1) 2))) + (insert-char ?\ (max 0 (round (- (window-width) + (or x (car size))) 2))) + (insert-image image)) + (goto-char (point-min)) + t))) (insert - (format " %s + (format " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -1094,8 +1091,7 @@ be set in `.emacs' instead." _ __ -" - "")) +")) ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) @@ -1107,10 +1103,25 @@ be set in `.emacs' instead." (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. (put-text-property (point-min) (point-max) 'face 'gnus-splash) - (setq gnus-simple-splash t))) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat " " gnus-version)) - (set-buffer-modified-p t)) + (goto-char (point-min)) + (setq mode-line-buffer-identification (concat " " gnus-version)) + (set-buffer-modified-p t))) + +(defun gnus-splash-svg-color-symbols (list) + "Do color-symbol search-and-replace in svg file." + (let ((type (plist-get (cdr list) :type)) + (file (plist-get (cdr list) :file)) + (color-symbols (plist-get (cdr list) :color-symbols))) + (if (string= type "svg") + (let ((data (with-temp-buffer (insert-file-contents file) + (buffer-string)))) + (mapc (lambda (rule) + (setq data (replace-regexp-in-string + (concat "fill:" (car rule)) + (concat "fill:" (cdr rule)) data))) + color-symbols) + (cons (car list) (list :type type :data data))) + list))) (eval-when (load) (let ((command (format "%s" this-command))) @@ -1235,7 +1246,12 @@ REST is a plist of following: (defcustom gnus-home-directory "~/" "Directory variable that specifies the \"home\" directory. -All other Gnus file and directory variables are initialized from this variable." +All other Gnus file and directory variables are initialized from this variable. + +Note that Gnus is mostly loaded when the `.gnus.el' file is read. +This means that other directory variables that are initialized +from this variable won't be set properly if you set this variable +in `.gnus.el'. Set this variable in `.emacs' instead." :group 'gnus-files :type 'directory) @@ -1266,15 +1282,6 @@ by the user. If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable.") -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - (defcustom gnus-nntpserver-file "/etc/nntpserver" "A file with only the name of the nntp server in it." :group 'gnus-files @@ -1298,20 +1305,11 @@ Check the NNTPSERVER environment variable and the ;;;###autoload (custom-autoload 'gnus-select-method "gnus")) (defcustom gnus-select-method - (condition-case nil - (nconc - (list 'nntp (or (condition-case nil - (gnus-getenv-nntpserver) - (error nil)) - (when (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service))) - (error nil)) + (list 'nntp (or (gnus-getenv-nntpserver) + (when (and gnus-default-nntp-server + (not (string= gnus-default-nntp-server ""))) + gnus-default-nntp-server) + "news")) "Default method for selecting a newsgroup. This variable should be a list, where the first element is how the news is to be fetched, the second is the address. @@ -1355,12 +1353,12 @@ updated if the value of this variable is nil, even if you change the value of `gnus-message-archive-method' afterward. If you want the saved \"archive\" method to be updated whenever you change the value of `gnus-message-archive-method', set this variable to a non-nil value." - :version "23.1" ;; No Gnus + :version "23.1" :group 'gnus-server :group 'gnus-message :type 'boolean) -(defcustom gnus-message-archive-group nil +(defcustom gnus-message-archive-group '((format-time-string "sent.%Y-%m")) "*Name of the group in which to save the messages you've written. This can either be a string; a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list @@ -1380,8 +1378,12 @@ unprefixed -- which implicitly means \"store on the archive server\". However, you may wish to store the message on some other server. In that case, just return a fully prefixed name of the group -- \"nnml+private:mail.misc\", for instance." + :version "24.1" :group 'gnus-message :type '(choice (const :tag "none" nil) + (const :tag "Weekly" ((format-time-string "sent.%Yw%U"))) + (const :tag "Monthly" ((format-time-string "sent.%Y-%m"))) + (const :tag "Yearly" ((format-time-string "sent.%Y"))) function sexp string)) @@ -1392,14 +1394,7 @@ To make Gnus query you for a server, you have to give `gnus' a non-numeric prefix - `C-u M-x gnus', in short." :group 'gnus-server :type '(repeat string)) - -(defcustom gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead." - :group 'gnus-server - :type '(choice (const :tag "disable" nil) - string)) +(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") (defcustom gnus-secondary-select-methods nil "A list of secondary methods that will be used for reading news. @@ -1413,11 +1408,6 @@ you could set this variable: :group 'gnus-server :type '(repeat gnus-select-method)) -(defvar gnus-backup-default-subscribed-newsgroups - '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") - "Default default new newsgroups the first time Gnus is run. -Should be set in paths.el, and shouldn't be touched by the user.") - (defcustom gnus-local-domain nil "Local domain name without a host name. The DOMAINNAME environment variable is used instead if it is defined. @@ -1428,18 +1418,10 @@ no need to set this variable." string)) (make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1") -(defvar gnus-local-organization nil - "String with a description of what organization (if any) the user belongs to. -Obsolete variable; use `message-user-organization' instead.") - ;; Customization variables (defcustom gnus-refer-article-method 'current "Preferred method for fetching an article by Message-ID. -If you are reading news from the local spool (with nnspool), fetching -articles by Message-ID is painfully slow. By setting this method to an -nntp method, you might get acceptable results. - The value of this variable must be a valid select method as discussed in the documentation of `gnus-select-method'. @@ -1452,6 +1434,7 @@ list, Gnus will try all the methods in the list until it finds a match." (const current) (const :tag "Google" (nnweb "refer" (nnweb-type google))) gnus-select-method + sexp (repeat :menu-tag "Try multiple" :tag "Multiple" :value (current (nnweb "refer" (nnweb-type google))) @@ -1461,14 +1444,6 @@ list, Gnus will try all the methods in the list until it finds a match." (nnweb "refer" (nnweb-type google))) gnus-select-method)))) -(defcustom gnus-group-fetch-control-use-browse-url nil - "*Non-nil means that control messages are displayed using `browse-url'. -Otherwise they are fetched with ange-ftp and displayed in an ephemeral -group." - :version "22.1" - :group 'gnus-group-various - :type 'boolean) - (defcustom gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in @@ -1498,7 +1473,7 @@ Also see `gnus-large-ephemeral-newsgroup'." integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) - "*Non-nil means that the default name of a file to save articles in is the group name. + "Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead. If this variable is a list, and the list contains the element @@ -1508,8 +1483,8 @@ saving; and if it contains the element `not-kill', long file names will not be used for kill files. Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t." +type you're using. On `usg-unix-v' this variable defaults to nil while +on all other systems it defaults to t." :group 'gnus-start :type '(radio (sexp :format "Non-nil\n" :match (lambda (widget value) @@ -1610,9 +1585,12 @@ commands will still require prompting." :type 'boolean) (defcustom gnus-interactive-exit t - "*If non-nil, require your confirmation when exiting Gnus." + "*If non-nil, require your confirmation when exiting Gnus. +If `quiet', update any active summary buffers automatically +first before exiting." :group 'gnus-exit - :type 'boolean) + :type '(choice boolean + (const quiet))) (defcustom gnus-extract-address-components 'gnus-extract-address-components "*Function for extracting address components from a From header. @@ -1625,11 +1603,6 @@ slower." (function-item mail-extract-address-components) (function :tag "Other"))) -(defcustom gnus-carpal nil - "*If non-nil, display clickable icons." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-shell-command-separator ";" "String used to separate shell commands." :group 'gnus-files @@ -1652,7 +1625,8 @@ slower." ("nnweb" none) ("nnrss" none) ("nnagent" post-mail) - ("nnimap" post-mail address prompt-address physical-address) + ("nnimap" post-mail address prompt-address physical-address respool + server-marks) ("nnmaildir" mail respool address) ("nnnil" none)) "*An alist of valid select methods. @@ -1900,7 +1874,10 @@ total number of articles in the group.") :function-document "Whether this group should be ignored by the registry." :variable gnus-registry-ignored-groups - :variable-default nil + :variable-default (mapcar + (lambda (g) (list g t)) + '("delayed$" "drafts$" "queue$" "INBOX$" + "^nnmairix:" "^nnir:" "archive")) :variable-document "*Groups in which the registry should be turned off." :variable-group gnus-registry @@ -2589,6 +2566,11 @@ a string, be sure to use a valid format, see RFC 2616." (defvar gnus-server-method-cache nil) (defvar gnus-extended-servers nil) +;; The carpal mode has been removed, but define the variable for +;; backwards compatibility. +(defvar gnus-carpal nil) +(make-obsolete-variable 'gnus-carpal nil "Emacs 24.1") + (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") @@ -2638,7 +2620,7 @@ a string, be sure to use a valid format, see RFC 2616." (scored . score) (saved . save) (cached . cache) (downloadable . download) (unsendable . unsend) (forwarded . forward) - (recent . recent) (seen . seen))) + (seen . seen))) (defconst gnus-article-special-mark-lists '((seen range) @@ -2672,9 +2654,13 @@ such as a mark that says whether an article is stored in the cache (defvar gnus-have-read-active-file nil) (defconst gnus-maintainer - "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" + "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") +(defconst gnus-bug-package + "gnus" + "The package to use in the bug submission.") + (defvar gnus-info-nodes '((gnus-group-mode "(gnus)Group Buffer") (gnus-summary-mode "(gnus)Summary Buffer") @@ -2700,8 +2686,7 @@ such as a mark that says whether an article is stored in the cache gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist - gnus-format-specs) + gnus-topic-topology gnus-topic-alist) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-alist nil @@ -2802,14 +2787,15 @@ gnus-registry.el will populate this if it's loaded.") gnus-convert-image-to-gray-x-face gnus-convert-face-to-png gnus-face-from-file) ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree - gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) + gnus-tree-open gnus-tree-close) ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server) ("gnus-cite" :interactive t gnus-article-highlight-citation gnus-article-hide-citation-maybe gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) + gnus-article-hide-citation-in-followups + gnus-article-fill-cited-long-lines) ("gnus-kill" gnus-kill gnus-apply-kill-file-internal gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score) @@ -2926,7 +2912,8 @@ gnus-registry.el will populate this if it's loaded.") gnus-agent-save-active gnus-agent-method-p gnus-agent-get-undownloaded-list gnus-agent-fetch-session gnus-summary-set-agent-mark gnus-agent-save-group-info - gnus-agent-request-article gnus-agent-retrieve-headers) + gnus-agent-request-article gnus-agent-retrieve-headers + gnus-agent-store-article gnus-agent-group-covered-p) ("gnus-agent" :interactive t gnus-unplugged gnus-agentize gnus-agent-batch) ("gnus-vm" :interactive t gnus-summary-save-in-vm @@ -2947,50 +2934,62 @@ gnus-registry.el will populate this if it's loaded.") It works along the same lines as a normal formatting string, with some simple extensions. -%N Article number, left padded with spaces (string) -%S Subject (string) -%s Subject if it is at the root of a thread, and \"\" otherwise (string) -%n Name of the poster (string) -%a Extracted name of the poster (string) -%A Extracted address of the poster (string) -%F Contents of the From: header (string) -%f Contents of the From: or To: headers (string) -%x Contents of the Xref: header (string) -%D Date of the article (string) -%d Date of the article (string) in DD-MMM format -%o Date of the article (string) in YYYYMMDD`T'HHMMSS format -%M Message-id of the article (string) -%r References of the article (string) -%c Number of characters in the article (integer) -%k Pretty-printed version of the above (string) - For example, \"1.2k\" or \"0.4M\". -%L Number of lines in the article (integer) -%I Indentation based on thread level (a string of spaces) -%B A complex trn-style thread tree (string) - The variables `gnus-sum-thread-*' can be used for customization. -%T A string with two possible values: 80 spaces if the article - is on thread level two or larger and 0 spaces on level one -%R \"A\" if this article has been replied to, \" \" otherwise (character) -%U Status of this article (character, \"R\", \"K\", \"-\" or \" \") -%[ Opening bracket (character, \"[\" or \"<\") -%] Closing bracket (character, \"]\" or \">\") -%> Spaces of length thread-level (string) -%< Spaces of length (- 20 thread-level) (string) -%i Article score (number) -%z Article zcore (character) -%t Number of articles under the current thread (number). -%e Whether the thread is empty or not (character). -%V Total thread score (number). -%P The line number (number). -%O Download mark (character). -%* If present, indicates desired cursor position - (instead of after first colon). -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the summary just like information from any other - summary specifier. +%N Article number, left padded with spaces (string) +%S Subject (string) +%s Subject if it is at the root of a thread, and \"\" + otherwise (string) +%n Name of the poster (string) +%a Extracted name of the poster (string) +%A Extracted address of the poster (string) +%F Contents of the From: header (string) +%f Contents of the From: or To: headers (string) +%x Contents of the Xref: header (string) +%D Date of the article (string) +%d Date of the article (string) in DD-MMM format +%o Date of the article (string) in YYYYMMDD`T'HHMMSS + format +%M Message-id of the article (string) +%r References of the article (string) +%c Number of characters in the article (integer) +%k Pretty-printed version of the above (string) + For example, \"1.2k\" or \"0.4M\". +%L Number of lines in the article (integer) +%I Indentation based on thread level (a string of + spaces) +%B A complex trn-style thread tree (string) + The variables `gnus-sum-thread-*' can be used for + customization. +%T A string with two possible values: 80 spaces if the + article is on thread level two or larger and 0 spaces + on level one +%R \"A\" if this article has been replied to, \" \" + otherwise (character) +%U \"Read\" status of this article. + See Info node `(gnus)Marking Articles' +%[ Opening bracket (character, \"[\" or \"<\") +%] Closing bracket (character, \"]\" or \">\") +%> Spaces of length thread-level (string) +%< Spaces of length (- 20 thread-level) (string) +%i Article score (number) +%z Article zcore (character) +%t Number of articles under the current thread (number). +%e Whether the thread is empty or not (character). +%V Total thread score (number). +%P The line number (number). +%O Download mark (character). +%* If present, indicates desired cursor position + (instead of after first colon). +%u User defined specifier. The next character in the + format string should be a letter. Gnus will call the + function gnus-user-format-function-X, where X is the + letter following %u. The function will be passed the + current header as argument. The function should + return a string, which will be inserted into the + summary just like information from any other summary + specifier. +&user-date; Age sensitive date format. Various date format is + defined in `gnus-summary-user-date-format-alist'. + The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column @@ -3141,6 +3140,10 @@ Return nil if not defined." (defmacro gnus-get-info (group) `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) +(defun gnus-set-info (group info) + (setcar (nthcdr 2 (gnus-gethash group gnus-newsrc-hashtb)) + info)) + ;;; Load the compatibility functions. (require 'gnus-ems) @@ -3290,7 +3293,7 @@ g -- Group name." ((= c ?d) (point)) ((= c ?D) - (read-file-name prompt nil default-directory 'lambda)) + (read-directory-name prompt nil default-directory 'lambda)) ((= c ?f) (read-file-name prompt nil nil 'lambda)) ((= c ?F) @@ -3390,14 +3393,14 @@ that that variable is buffer-local to the summary buffers." (defun gnus-news-group-p (group &optional article) "Return non-nil if GROUP (and ARTICLE) come from a news server." (cond ((gnus-member-of-valid 'post group) ;Ordinary news group - t) ;is news of course. + t) ;is news of course. ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined. nil) ;must be mail then. ((vectorp article) ;Has header info. (eq (gnus-request-type group (mail-header-id article)) 'news)) - ((null article) ;Hasn't header info + ((null article) ;Hasn't header info (eq (gnus-request-type group) 'news)) ;(unknown ==> mail) - ((< article 0) ;Virtual message + ((< article 0) ;Virtual message nil) ;we don't know, guess mail. (t ;Has positive number (eq (gnus-request-type group article) 'news)))) ;use it. @@ -3579,18 +3582,15 @@ that that variable is buffer-local to the summary buffers." gnus-valid-select-methods))) (equal (nth 1 m1) (nth 1 m2))))))) -(defun gnus-methods-sloppily-equal (m1 m2) - ;; Same method. - (or - (eq m1 m2) - ;; Type and name are equal. - (and - (eq (car m1) (car m2)) - (equal (cadr m1) (cadr m2)) - (gnus-sloppily-equal-method-parameters m1 m2)))) +(defun gnus-method-ephemeral-p (method) + (let ((equal nil)) + (dolist (ephemeral gnus-ephemeral-servers) + (when (gnus-sloppily-equal-method-parameters method ephemeral) + (setq equal t))) + equal)) (defsubst gnus-sloppily-equal-method-parameters (m1 m2) - ;; Check parameters for sloppy equalness. + ;; Check parameters for sloppy equality. (let ((p1 (copy-sequence (cddr m1))) (p2 (copy-sequence (cddr m2))) e1 e2) @@ -3617,6 +3617,16 @@ that that variable is buffer-local to the summary buffers." ;; If p2 now is empty, they were equal. (null p2)))) +(defun gnus-methods-sloppily-equal (m1 m2) + ;; Same method. + (or + (eq m1 m2) + ;; Type and name are equal. + (and + (eq (car m1) (car m2)) + (equal (cadr m1) (cadr m2)) + (gnus-sloppily-equal-method-parameters m1 m2)))) + (defun gnus-server-equal (m1 m2) "Say whether two methods are equal." (let ((m1 (cond ((null m1) gnus-select-method) @@ -3814,12 +3824,13 @@ You should probably use `gnus-find-method-for-group' instead." (defun gnus-expand-group-parameter (match value group) "Use MATCH to expand VALUE in GROUP." - (with-temp-buffer - (insert group) - (goto-char (point-min)) - (while (re-search-forward match nil t) - (replace-match value)) - (buffer-string))) + (let ((start (string-match match group))) + (if start + (let ((matched-string (substring group start (match-end 0)))) + ;; Build match groups + (string-match match matched-string) + (replace-match value nil nil matched-string)) + group))) (defun gnus-expand-group-parameters (match parameters group) "Go through PARAMETERS and expand them according to the match data." @@ -3857,13 +3868,14 @@ The function `gnus-group-find-parameter' will do that for you." ;; The car is regexp matching for matching the group name. (when (string-match (car head) group) ;; The cdr is the parameters. - (setq result (gnus-group-parameter-value (cdr head) - symbol allow-list)) - (when result - ;; Expand if necessary. - (if (and (stringp result) (string-match "\\\\[0-9&]" result)) - (setq result (gnus-expand-group-parameter (car head) - result group)))))) + (let ((this-result + (gnus-group-parameter-value (cdr head) symbol allow-list t))) + (when this-result + (setq result (car this-result)) + ;; Expand if necessary. + (if (and (stringp result) (string-match "\\\\[0-9&]" result)) + (setq result (gnus-expand-group-parameter + (car head) result group))))))) ;; Done. result)))) @@ -3873,7 +3885,9 @@ If SYMBOL, return the value of that symbol in the group parameters. If you call this function inside a loop, consider using the faster `gnus-group-fast-parameter' instead." - (with-current-buffer gnus-group-buffer + (with-current-buffer (if (buffer-live-p (get-buffer gnus-group-buffer)) + gnus-group-buffer + (current-buffer)) (if symbol (gnus-group-fast-parameter group symbol allow-list) (nconc @@ -3921,8 +3935,11 @@ If ALLOW-LIST, also allow list as a result." group 'params)))) (defun gnus-group-set-parameter (group name value) - "Set parameter NAME to VALUE in GROUP." - (let ((info (gnus-get-info group))) + "Set parameter NAME to VALUE in GROUP. +GROUP can also be an INFO structure." + (let ((info (if (listp group) + group + (gnus-get-info group)))) (when info (gnus-group-remove-parameter group name) (let ((old-params (gnus-info-params info)) @@ -3932,17 +3949,22 @@ If ALLOW-LIST, also allow list as a result." (not (eq (caar old-params) name))) (setq new-params (append new-params (list (car old-params))))) (setq old-params (cdr old-params))) - (gnus-group-set-info new-params group 'params))))) + (if (listp group) + (gnus-info-set-params info new-params t) + (gnus-group-set-info new-params (gnus-info-group info) 'params)))))) (defun gnus-group-remove-parameter (group name) - "Remove parameter NAME from GROUP." - (let ((info (gnus-get-info group))) + "Remove parameter NAME from GROUP. +GROUP can also be an INFO structure." + (let ((info (if (listp group) + group + (gnus-get-info group)))) (when info (let ((params (gnus-info-params info))) (when params (setq params (delq name params)) (while (assq name params) - (gnus-pull name params)) + (gnus-alist-pull name params)) (gnus-info-set-params info params)))))) (defun gnus-group-add-score (group &optional score) @@ -4347,11 +4369,11 @@ current display is used." (switch-to-buffer gnus-group-buffer) (funcall gnus-other-frame-function arg) (add-hook 'gnus-exit-gnus-hook - '(lambda nil - (when (and (frame-live-p gnus-other-frame-object) - (cdr (frame-list))) - (delete-frame gnus-other-frame-object)) - (setq gnus-other-frame-object nil))))))) + (lambda nil + (when (and (frame-live-p gnus-other-frame-object) + (cdr (frame-list))) + (delete-frame gnus-other-frame-object)) + (setq gnus-other-frame-object nil))))))) ;;;###autoload (defun gnus (&optional arg dont-connect slave) @@ -4371,6 +4393,12 @@ prompt the user for the name of an NNTP server to use." (gnus-1 arg dont-connect slave) (gnus-final-warning))) +(autoload 'debbugs-gnu "debbugs-gnu") +(defun gnus-list-debbugs () + "List all open Gnus bug reports." + (interactive) + (debbugs-gnu nil "gnus")) + ;; Allow redefinition of Gnus functions. (gnus-ems-redefine)