X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=2bca1cf05b79f0d90d4a6a647e727c77d97e897d;hb=ece5869ff8aaa59a2b906f21c7fbb1a402d6a073;hp=1f51dff1896659a8f970eb4f8844a3d18c63b21c;hpb=3c241eab11755103e216295cb90967f6026a2fe3;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index 1f51dff18..2bca1cf05 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-2011 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -275,7 +274,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,7 +293,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.11" +(defconst gnus-version-number "0.18" "Version number for this version of Gnus.") (defconst gnus-version (format "No Gnus v%s" gnus-version-number) @@ -1031,10 +1030,11 @@ be set in `.emacs' instead." (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. + ;; 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 @@ -1042,12 +1042,15 @@ be set in `.emacs' instead." ((boundp 'image-load-path) (symbol-value 'image-load-path)) (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" + (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 svg :file "gnus.svg") (:type png :file "gnus.png") (:type pbm :file "gnus.pbm" ;; Account for the pbm's background. @@ -1056,7 +1059,7 @@ be set in `.emacs' instead." (:type xbm :file "gnus.xbm" ;; Account for the xbm's background. :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) + :foreground ,(face-background 'default))))))) (when image (let ((size (image-size image))) (insert-char ?\n (max 0 (round (- (window-height) @@ -1064,9 +1067,10 @@ be set in `.emacs' instead." (insert-char ?\ (max 0 (round (- (window-width) (or x (car size))) 2))) (insert-image image)) + (goto-char (point-min)) t))) (insert - (format " + (format " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -1101,6 +1105,22 @@ be set in `.emacs' instead." (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))) (when (string-match "gnus" command) @@ -1224,7 +1244,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) @@ -1398,18 +1423,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'. @@ -1422,6 +1439,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))) @@ -1431,14 +1449,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 @@ -1580,9 +1590,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. @@ -1617,7 +1630,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. @@ -1865,7 +1879,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 @@ -2555,7 +2572,7 @@ a string, be sure to use a valid format, see RFC 2616." (defvar gnus-extended-servers nil) ;; The carpal mode has been removed, but define the variable for -;; backwards compatability. +;; backwards compatibility. (defvar gnus-carpal nil) (make-obsolete-variable 'gnus-carpal nil "Emacs 24.1") @@ -2608,7 +2625,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) @@ -2642,9 +2659,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") @@ -2670,8 +2691,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 @@ -2779,7 +2799,8 @@ gnus-registry.el will populate this if it's loaded.") ("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) @@ -2880,7 +2901,6 @@ gnus-registry.el will populate this if it's loaded.") gnus-start-date-timer gnus-stop-date-timer gnus-mime-view-all-parts) ("gnus-int" gnus-request-type) - ("gnus-html" gnus-html-show-images) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch gnus-check-reasonable-setup) @@ -2897,7 +2917,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 @@ -2918,50 +2939,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 @@ -3112,6 +3145,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) @@ -3261,7 +3298,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) @@ -3550,16 +3587,6 @@ 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)))) - (defsubst gnus-sloppily-equal-method-parameters (m1 m2) ;; Check parameters for sloppy equalness. (let ((p1 (copy-sequence (cddr m1))) @@ -3588,6 +3615,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) @@ -4327,11 +4364,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) @@ -4351,6 +4388,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)