X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;ds=inline;f=lisp%2Fgnus.el;h=12d412a244238cd1aa44a49c0032bfe15f24ba94;hb=08c1b3b14a46b72f4ed5f623a116ea85786b5a2a;hp=641405e561fc66b567cb287c375dec1ffc8b002e;hpb=e7f07f2052c10868d054f243c1c7e3ed49b4b5b6;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index 641405e56..12d412a24 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-2013 Free Software +;; Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -36,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) @@ -293,10 +294,10 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.20" +(defconst gnus-version-number "0.8" "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 @@ -1008,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)) @@ -1270,15 +1272,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." @@ -1325,6 +1330,8 @@ 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 @@ -1625,7 +1632,7 @@ slower." ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address respool server-marks) - ("nnmaildir" mail respool address) + ("nnmaildir" mail respool address server-marks) ("nnnil" none)) "*An alist of valid select methods. The first element of each list lists should be a string with the name @@ -1640,12 +1647,13 @@ 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 :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 () @@ -2487,13 +2495,23 @@ 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))) + (defcustom gnus-other-frame-parameters nil "Frame parameters used by `gnus-other-frame' to create a Gnus frame. This should be an alist for Emacs, or a plist for XEmacs." @@ -2618,10 +2636,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) @@ -2636,7 +2655,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 @@ -2797,6 +2816,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 @@ -3403,15 +3424,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... @@ -3580,13 +3592,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))) @@ -3615,6 +3620,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 @@ -3687,21 +3699,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) @@ -3834,12 +3835,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) @@ -3871,9 +3888,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)))) @@ -4122,12 +4150,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." @@ -4211,8 +4244,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. @@ -4326,13 +4358,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." @@ -4364,14 +4405,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) @@ -4391,10 +4434,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.