X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus.el;h=19807fce69e6baf9748a62d6ed95252df5f56fff;hp=19b19aaf78a99dc97a11cc0ab2cc2f49d58abbce;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=e9cbcce5e08949322618dfaa89494d3905e3486b diff --git a/lisp/gnus.el b/lisp/gnus.el index 19b19aaf7..19807fce6 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,7 +1,7 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987-1990, 1993-1998, 2000-2012 -;; Free Software Foundation, Inc. +;; Copyright (C) 1987-1990, 1993-1998, 2000-2016 Free Software +;; Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -28,10 +28,6 @@ (eval '(run-hooks 'gnus-load-hook)) -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'wid-edit) (require 'mm-util) @@ -294,7 +290,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.2" +(defconst gnus-version-number "0.14" "Version number for this version of Gnus.") (defconst gnus-version (format "Ma Gnus v%s" gnus-version-number) @@ -308,15 +304,6 @@ be set in `.emacs' instead." :type 'boolean) (unless (featurep 'gnus-xmas) - (defalias 'gnus-make-overlay 'make-overlay) - (defalias 'gnus-delete-overlay 'delete-overlay) - (defalias 'gnus-overlay-get 'overlay-get) - (defalias 'gnus-overlay-put 'overlay-put) - (defalias 'gnus-move-overlay 'move-overlay) - (defalias 'gnus-overlay-buffer 'overlay-buffer) - (defalias 'gnus-overlay-start 'overlay-start) - (defalias 'gnus-overlay-end 'overlay-end) - (defalias 'gnus-overlays-in 'overlays-in) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) @@ -328,8 +315,9 @@ be set in `.emacs' instead." (if (fboundp 'find-image) (defun gnus-mode-line-buffer-identification (line) (let ((str (car-safe line)) - (load-path (mm-image-load-path))) - (if (and (stringp str) + (load-path (append (mm-image-load-path) load-path))) + (if (and (display-graphic-p) + (stringp str) (string-match "^Gnus:" str)) (progn (add-text-properties 0 5 @@ -1272,15 +1260,18 @@ Set this variable in `.emacs' instead." :type '(choice (const :tag "current" nil) directory)) -;; Site dependent variables. These variables should be defined in -;; paths.el. +;; Site dependent variables. -(defvar gnus-default-nntp-server nil - "Specify a default NNTP server. -This variable should be defined in paths.el, and should never be set -by the user. -If you want to change servers, you should use `gnus-select-method'. -See the documentation to that variable.") +;; Should this be obsolete? +(defcustom gnus-default-nntp-server nil + "The hostname of the default NNTP server. +The empty string, or nil, means to use the local host. +You may wish to set this on a site-wide basis. + +If you want to change servers, you should use `gnus-select-method'." + :group 'gnus-server + :type '(choice (const :tag "local host" nil) + (string :tag "host name"))) (defcustom gnus-nntpserver-file "/etc/nntpserver" "A file with only the name of the nntp server in it." @@ -1317,16 +1308,18 @@ news is to be fetched, the second is the address. For instance, if you want to get your news via \"flab.flab.edu\" using NNTP, you could say: -\(setq gnus-select-method '(nntp \"flab.flab.edu\")) +\(setq gnus-select-method \\='(nntp \"flab.flab.edu\")) If you want to use your local spool, say: -\(setq gnus-select-method (list 'nnspool (system-name))) +\(setq gnus-select-method (list \\='nnspool (system-name))) If you use this variable, you must set `gnus-nntp-server' to nil. There is a lot more to know about select methods and virtual servers - see the manual for details." + ;; Emacs has set-after since 22.1. + ;set-after '(gnus-default-nntp-server) :group 'gnus-server :group 'gnus-start :initialize 'custom-initialize-default @@ -1368,8 +1361,8 @@ group (or nil) as a parameter. If you want to save your mail in one group and the news articles you write in another group, you could say something like: - \(setq gnus-message-archive-group - '((if (message-news-p) + (setq gnus-message-archive-group + \\='((if (message-news-p) \"misc-news\" \"misc-mail\"))) @@ -1404,7 +1397,7 @@ This is a list where each element is a complete select method (see If, for instance, you want to read your mail with the nnml back end, you could set this variable: -\(setq gnus-secondary-select-methods '((nnml \"\")))" +\(setq gnus-secondary-select-methods \\='((nnml \"\")))" :group 'gnus-server :type '(repeat gnus-select-method)) @@ -1609,7 +1602,7 @@ slower." :type 'string) (defcustom gnus-valid-select-methods - '(("nntp" post address prompt-address physical-address) + '(("nntp" post address prompt-address physical-address cloud) ("nnspool" post address) ("nnvirtual" post-mail virtual prompt-address) ("nnmbox" mail respool address) @@ -1623,10 +1616,10 @@ slower." ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) - ("nnrss" none) + ("nnrss" none global) ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address respool - server-marks) + server-marks cloud) ("nnmaildir" mail respool address server-marks) ("nnnil" none)) "*An alist of valid select methods. @@ -1642,12 +1635,14 @@ this variable. I think." (const :format "%v " mail) (const :format "%v " none) (const post-mail)) - (checklist :inline t + (checklist :inline t :greedy t (const :format "%v " address) + (const global) (const :format "%v " prompt-address) (const :format "%v " physical-address) - (const :format "%v " virtual) - (const respool)))) + (const virtual) + (const :format "%v " respool) + (const server-marks)))) :version "24.1") (defun gnus-redefine-select-method-widget () @@ -2401,7 +2396,7 @@ less space and be faster as a result. This variable can also be a list of visual elements to switch on. For instance, to switch off all visual things except menus, you can say: - (setq gnus-visual '(menu)) + (setq gnus-visual \\='(menu)) Valid elements include `summary-highlight', `group-highlight', `article-highlight', `mouse-face', `summary-menu', `group-menu', @@ -2489,9 +2484,19 @@ Disabling the agent may result in noticeable loss of performance." :type 'boolean) (defcustom gnus-other-frame-function 'gnus - "Function called by the command `gnus-other-frame'." + "Function called by the command `gnus-other-frame' when starting Gnus." + :group 'gnus-start + :type '(choice (function-item gnus) + (function-item gnus-no-server) + (function-item gnus-slave) + (function-item gnus-slave-no-server))) + +(defcustom gnus-other-frame-resume-function 'gnus-group-get-new-news + "Function called by the command `gnus-other-frame' when resuming Gnus." + :version "24.4" :group 'gnus-start :type '(choice (function-item gnus) + (function-item gnus-group-get-new-news) (function-item gnus-no-server) (function-item gnus-slave) (function-item gnus-slave-no-server))) @@ -2512,10 +2517,10 @@ This should be an alist for Emacs, or a plist for XEmacs." "Which information should be exposed in the User-Agent header. Can be a list of symbols or a string. Valid symbols are `gnus' -\(show Gnus version\) and `emacs' \(show Emacs version\). In +\(show Gnus version) and `emacs' \(show Emacs version). In addition to the Emacs version, you can add `codename' \(show -\(S\)XEmacs codename\) or either `config' \(show system -configuration\) or `type' \(show system type\). If you set it to +\(S)XEmacs codename) or either `config' \(show system +configuration) or `type' \(show system type). If you set it to a string, be sure to use a valid format, see RFC 2616." :version "22.1" @@ -2620,10 +2625,11 @@ a string, be sure to use a valid format, see RFC 2616." (scored . score) (saved . save) (cached . cache) (downloadable . download) (unsendable . unsend) (forwarded . forward) - (seen . seen))) + (seen . seen) (unexist . unexist))) (defconst gnus-article-special-mark-lists '((seen range) + (unexist range) (killed range) (bookmark tuple) (uid tuple) @@ -2638,7 +2644,7 @@ a string, be sure to use a valid format, see RFC 2616." ;; `score' is not a proper mark ;; `bookmark': don't propagated it, or fix the bug in update-mark. (defconst gnus-article-unpropagated-mark-lists - '(seen cache download unsend score bookmark) + '(seen cache download unsend score bookmark unexist) "Marks that shouldn't be propagated to back ends. Typical marks are those that make no sense in a standalone back end, such as a mark that says whether an article is stored in the cache @@ -2670,7 +2676,6 @@ such as a mark that says whether an article is stored in the cache (gnus-tree-mode "(gnus)Tree Display")) "Alist of major modes and related Info nodes.") -(defvar gnus-group-buffer "*Group*") (defvar gnus-summary-buffer "*Summary*") (defvar gnus-article-buffer "*Article*") (defvar gnus-server-buffer "*Server*") @@ -2686,7 +2691,10 @@ 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-topic-topology gnus-topic-alist + gnus-cloud-sequence + gnus-cloud-covered-servers + gnus-cloud-file-timestamps) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-alist nil @@ -2799,6 +2807,8 @@ gnus-registry.el will populate this if it's loaded.") ("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) + ("gnus-registry" gnus-try-warping-via-registry + gnus-registry-handle-action) ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers gnus-cache-possibly-remove-articles gnus-cache-request-article gnus-cache-retrieve-headers gnus-cache-possibly-alter-active @@ -2988,7 +2998,7 @@ with some simple extensions. 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'. + defined in `gnus-user-date-format-alist'. The %U (status), %R (replied) and %z (zcore) specs have to be handled @@ -3015,7 +3025,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-suppress-keymap (keymap) (suppress-keymap keymap) - (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2 + (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 (while keys (define-key keymap (pop keys) 'undefined)))) @@ -3227,9 +3237,9 @@ If ARG, insert string at point." 0)) (string-to-number (if (zerop major) - (format "%s00%02d%02d" + (format "%1.2f00%02d%02d" (if (member alpha '("(ding)" "d")) - "4.99" + 4.99 (+ 5 (* 0.02 (abs (- (mm-char-int (aref (downcase alpha) 0)) @@ -3405,15 +3415,6 @@ that that variable is buffer-local to the summary buffers." (t ;Has positive number (eq (gnus-request-type group article) 'news)))) ;use it. -;; Returns a list of writable groups. -(defun gnus-writable-groups () - (let ((alist gnus-newsrc-alist) - groups group) - (while (setq group (car (pop alist))) - (unless (gnus-group-read-only-p group) - (push group groups))) - (nreverse groups))) - ;; Check whether to use long file names. (defun gnus-use-long-file-name (symbol) ;; The variable has to be set... @@ -3582,13 +3583,6 @@ that that variable is buffer-local to the summary buffers." gnus-valid-select-methods))) (equal (nth 1 m1) (nth 1 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 equality. (let ((p1 (copy-sequence (cddr m1))) @@ -3617,6 +3611,13 @@ that that variable is buffer-local to the summary buffers." ;; If p2 now is empty, they were equal. (null p2)))) +(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)) + (defun gnus-methods-sloppily-equal (m1 m2) ;; Same method. (or @@ -3689,21 +3690,10 @@ server is native)." group (concat (gnus-method-to-server-name method) ":" group))) -(defun gnus-group-guess-prefixed-name (group) - "Guess the whole name from GROUP and METHOD." - (gnus-group-prefixed-name group (gnus-find-method-for-group - group))) - (defun gnus-group-full-name (group method) "Return the full name from GROUP and METHOD, even if the method is native." (gnus-group-prefixed-name group method t)) -(defun gnus-group-guess-full-name (group) - "Guess the full name from GROUP, even if the method is native." - (if (gnus-group-prefixed-p group) - group - (gnus-group-full-name group (gnus-find-method-for-group group)))) - (defun gnus-group-guess-full-name-from-command-method (group) "Guess the full name from GROUP, even if the method is native." (if (gnus-group-prefixed-p group) @@ -3836,12 +3826,28 @@ You should probably use `gnus-find-method-for-group' instead." "Go through PARAMETERS and expand them according to the match data." (let (new) (dolist (elem parameters) - (if (and (stringp (cdr elem)) - (string-match "\\\\[0-9&]" (cdr elem))) - (push (cons (car elem) - (gnus-expand-group-parameter match (cdr elem) group)) - new) - (push elem new))) + (cond + ((and (stringp (cdr elem)) + (string-match "\\\\[0-9&]" (cdr elem))) + (push (cons (car elem) + (gnus-expand-group-parameter match (cdr elem) group)) + new)) + ;; For `sieve' group parameters, perform substitutions for every + ;; string within the match rule. This allows for parameters such + ;; as: + ;; ("list\\.\\(.*\\)" + ;; (sieve header :is "list-id" "<\\1.domain.org>")) + ((eq 'sieve (car elem)) + (push (mapcar (lambda (sieve-elem) + (if (and (stringp sieve-elem) + (string-match "\\\\[0-9&]" sieve-elem)) + (gnus-expand-group-parameter match sieve-elem + group) + sieve-elem)) + (cdr elem)) + new)) + (t + (push elem new)))) new)) (defun gnus-group-fast-parameter (group symbol &optional allow-list) @@ -3873,9 +3879,20 @@ The function `gnus-group-find-parameter' will do that for you." (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))))))) + (cond + ((and (stringp result) (string-match "\\\\[0-9&]" result)) + (setq result (gnus-expand-group-parameter + (car head) result group))) + ;; For `sieve' group parameters, perform substitutions + ;; for every string within the match rule (see above). + ((eq symbol 'sieve) + (setq result + (mapcar (lambda (elem) + (if (stringp elem) + (gnus-expand-group-parameter (car head) + elem group) + elem)) + result)))))))) ;; Done. result)))) @@ -4124,12 +4141,17 @@ parameters." (if (or (not (inline (gnus-similar-server-opened method))) (not (cddr method))) method - (setq method - `(,(car method) ,(concat (cadr method) "+" group) - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method))) - (push method gnus-extended-servers) - method)) + (let ((address-slot + (intern (format "%s-address" (car method))))) + (setq method + (if (assq address-slot (cddr method)) + `(,(car method) ,(concat (cadr method) "+" group) + ,@(cddr method)) + `(,(car method) ,(concat (cadr method) "+" group) + (,address-slot ,(cadr method)) + ,@(cddr method)))) + (push method gnus-extended-servers) + method))) (defun gnus-server-status (method) "Return the status of METHOD." @@ -4213,8 +4235,7 @@ parameters." (setq valids (cdr valids))) outs)) -(eval-and-compile - (autoload 'message-y-or-n-p "message" nil nil 'macro)) +(autoload 'message-y-or-n-p "message" nil nil 'macro) (defun gnus-read-group (prompt &optional default) "Prompt the user for a group name. @@ -4328,13 +4349,22 @@ server." (interactive "P") (gnus arg nil 'slave)) +(defun gnus-delete-gnus-frame () + "Delete gnus frame unless it is the only one. +Used for `gnus-exit-gnus-hook' in `gnus-other-frame'." + (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-other-frame (&optional arg display) "Pop up a frame to read news. This will call one of the Gnus commands which is specified by the user option `gnus-other-frame-function' (default `gnus') with the argument -ARG if Gnus is not running, otherwise just pop up a Gnus frame. The -optional second argument DISPLAY should be a standard display string +ARG if Gnus is not running, otherwise pop up a Gnus frame and run the +command specified by `gnus-other-frame-resume-function'. +The optional second argument DISPLAY should be a standard display string such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is omitted or the function `make-frame-on-display' is not available, the current display is used." @@ -4366,14 +4396,16 @@ current display is used." (make-frame-on-display display gnus-other-frame-parameters) (make-frame gnus-other-frame-parameters)))) (if alive - (switch-to-buffer gnus-group-buffer) + (progn (switch-to-buffer gnus-group-buffer) + (funcall gnus-other-frame-resume-function arg)) (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))))))) + (add-hook 'gnus-exit-gnus-hook 'gnus-delete-gnus-frame) + ;; One might argue that `gnus-delete-gnus-frame' should not be called + ;; from `gnus-suspend-gnus-hook', but, on the other hand, one might + ;; argue that it should. No matter what you think, for the sake of + ;; those who want it to be called from it, please keep (defun + ;; gnus-delete-gnus-frame) even if you remove the next `add-hook'. + (add-hook 'gnus-suspend-gnus-hook 'gnus-delete-gnus-frame))))) ;;;###autoload (defun gnus (&optional arg dont-connect slave) @@ -4393,10 +4425,13 @@ 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") +(declare-function debbugs-gnu "ext:debbugs-gnu" + (severities &optional packages archivedp suppress tags)) + (defun gnus-list-debbugs () "List all open Gnus bug reports." (interactive) + (require 'debbugs-gnu) (debbugs-gnu nil "gnus")) ;; Allow redefinition of Gnus functions.