X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=45b84aec60e87bbf6fba3bc24f108ced7b024f6f;hb=0007de6d40db139c025a8b2cba9ef04ee4837608;hp=669ed1d038886345392b909ef9ca88fb2057ea0f;hpb=1ea3db8a284cc1ef9d77d52d5f7857ed9d526148;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index 669ed1d03..45b84aec6 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,8 +1,8 @@ ;;; 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 -;; Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, +;; 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -29,7 +29,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)))) @@ -307,14 +307,6 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) -(defcustom gnus-play-startup-jingle nil - "If non-nil, play the Gnus jingle at startup." - :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) @@ -357,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) @@ -925,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." @@ -957,9 +949,8 @@ be set in `.emacs' instead." ;;; Splash screen. -(defvar gnus-group-buffer "*Group*") - -(autoload 'gnus-play-jingle "gnus-audio") +(defvar gnus-group-buffer "*Group*" + "Name of the Gnus group buffer.") (defface gnus-splash '((((class color) @@ -983,9 +974,7 @@ be set in `.emacs' instead." (erase-buffer) (unless gnus-inhibit-startup-message (gnus-group-startup-message) - (sit-for 0) - (when gnus-play-startup-jingle - (gnus-play-jingle)))))) + (sit-for 0))))) (defun gnus-indent-rigidly (start end arg) "Indent rigidly using only spaces and no tabs." @@ -1000,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 @@ -1041,50 +1028,47 @@ 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 (find-image + `((: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. + :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 " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -1103,8 +1087,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)) @@ -1116,10 +1099,9 @@ 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))) (eval-when (load) (let ((command (format "%s" this-command))) @@ -1275,15 +1257,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 @@ -1307,20 +1280,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. @@ -1364,12 +1328,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 @@ -1389,8 +1353,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)) @@ -1401,14 +1369,14 @@ 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)) +(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") (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." + "The name of the host running the NNTP server." :group 'gnus-server :type '(choice (const :tag "disable" nil) string)) +(make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1") (defcustom gnus-secondary-select-methods nil "A list of secondary methods that will be used for reading news. @@ -1422,14 +1390,15 @@ 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.") - -(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.") +(defcustom gnus-local-domain nil + "Local domain name without a host name. +The DOMAINNAME environment variable is used instead if it is defined. +If the function `system-name' returns the full Internet name, there is +no need to set this variable." + :group 'gnus-message + :type '(choice (const :tag "default" nil) + string)) +(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1") ;; Customization variables @@ -1460,14 +1429,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 @@ -1489,13 +1450,15 @@ newsgroups." "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, confirmation is required for selecting the newsgroup. -If it is nil, no confirmation is required." +If it is nil, no confirmation is required. + +Also see `gnus-large-ephemeral-newsgroup'." :group 'gnus-group-select :type '(choice (const :tag "No limit" nil) 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 @@ -1505,8 +1468,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) @@ -1570,25 +1533,6 @@ articles. This is not a good idea." (sexp :format "all" :value t))) -(defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages. -You can also set this variable to a positive number as a group level. -In that case, Gnus scans NoCeM messages when checking new news if this -value is not exceeding a group level that you specify as the prefix -argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc. -Otherwise, Gnus does not scan NoCeM messages if you specify a group -level to those commands." - :group 'gnus-meta - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (list :convert-widget - (lambda (widget) - (list 'integer :tag "group level" - :value (if (boundp 'gnus-level-default-subscribed) - gnus-level-default-subscribed - 3)))))) - (defcustom gnus-suppress-duplicates nil "*If non-nil, Gnus will mark duplicate copies of the same article as read." :group 'gnus-meta @@ -1641,11 +1585,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 @@ -1668,7 +1607,7 @@ 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) ("nnmaildir" mail respool address) ("nnnil" none)) "*An alist of valid select methods. @@ -2605,6 +2544,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 compatability. +(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.") @@ -2620,9 +2564,6 @@ a string, be sure to use a valid format, see RFC 2616." (defvar gnus-tree-buffer "*Tree*" "Buffer where Gnus thread trees are displayed.") -;; Dummy variable. -(defvar gnus-use-generic-from nil) - ;; Variable holding the user answers to all method prompts. (defvar gnus-method-history nil) @@ -2650,8 +2591,6 @@ a string, be sure to use a valid format, see RFC 2616." ,(nnheader-concat gnus-cache-directory "active")))) "List of predefined (convenience) servers.") -(defvar gnus-topic-indentation "") ;; Obsolete variable. - (defconst gnus-article-mark-lists '((marked . tick) (replied . reply) (expirable . expire) (killed . killed) @@ -2808,13 +2747,12 @@ gnus-registry.el will populate this if it's loaded.") rmail-summary-exists rmail-select-summary) ;; Only used in gnus-util, which has an autoload. ("rmailsum" rmail-update-summary) - ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("score-mode" :interactive t gnus-score-mode) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive t gnus-summary-save-in-folder) - ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail + ("gnus-demon" gnus-demon-add-scanmail gnus-demon-add-rescan gnus-demon-add-scan-timestamps gnus-demon-add-disconnection gnus-demon-add-handler gnus-demon-remove-handler) @@ -2824,16 +2762,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-nocem" gnus-nocem-scan-groups gnus-nocem-close - gnus-nocem-unwanted-article-p) + 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) @@ -3231,7 +3168,6 @@ If ARG, insert string at point." (defun gnus-continuum-version (&optional version) "Return VERSION as a floating point number." - (interactive) (unless version (setq version gnus-version)) (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) @@ -3415,14 +3351,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. @@ -3604,16 +3540,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))) @@ -3642,6 +3568,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) @@ -3839,12 +3775,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." @@ -3888,9 +3825,7 @@ The function `gnus-group-find-parameter' will do that for you." ;; Expand if necessary. (if (and (stringp result) (string-match "\\\\[0-9&]" result)) (setq result (gnus-expand-group-parameter (car head) - result group))) - ;; Exit the loop early. - (setq tail nil)))) + result group)))))) ;; Done. result)))) @@ -3948,8 +3883,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)) @@ -3959,17 +3897,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) @@ -4269,9 +4212,9 @@ Allow completion over sensible values." gnus-predefined-server-alist gnus-server-alist)) (method - (completing-read - prompt servers - nil t nil 'gnus-method-history))) + (gnus-completing-read + prompt (mapcar 'car servers) + t nil 'gnus-method-history))) (cond ((equal method "") (setq method gnus-select-method)) @@ -4390,11 +4333,13 @@ prompt the user for the name of an NNTP server to use." ;; When using the development version of Gnus, load the gnus-load ;; file. (unless (string-match "^Gnus" gnus-version) - (load "gnus-load")) + (load "gnus-load" nil t)) (unless (byte-code-function-p (symbol-function 'gnus)) (message "You should byte-compile Gnus") (sit-for 2)) - (gnus-1 arg dont-connect slave)) + (let ((gnus-action-message-log (list nil))) + (gnus-1 arg dont-connect slave) + (gnus-final-warning))) ;; Allow redefinition of Gnus functions.