X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=3ee91de583bbd48cc4910e85abee69abfd7943d6;hb=2ec37f63143ecc8adf5054974df68062c5498e75;hp=2b2e0a96f451e38515e28578a2258655b0aa14d5;hpb=992509a3574f9add376cc480db9bb5656285bd5b;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index 2b2e0a96f..3ee91de58 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-2014 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.6" +(defconst gnus-version-number "0.10" "Version number for this version of Gnus.") (defconst gnus-version (format "Ma Gnus v%s" gnus-version-number) @@ -309,6 +305,7 @@ be set in `.emacs' instead." (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) + (defalias 'gnus-copy-overlay 'copy-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) (defalias 'gnus-overlay-get 'overlay-get) (defalias 'gnus-overlay-put 'overlay-put) @@ -316,6 +313,7 @@ be set in `.emacs' instead." (defalias 'gnus-overlay-buffer 'overlay-buffer) (defalias 'gnus-overlay-start 'overlay-start) (defalias 'gnus-overlay-end 'overlay-end) + (defalias 'gnus-overlays-at 'overlays-at) (defalias 'gnus-overlays-in 'overlays-in) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) @@ -1614,7 +1612,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) @@ -1628,10 +1626,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. @@ -1647,12 +1645,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 () @@ -2494,13 +2494,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." @@ -2676,7 +2686,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*") @@ -2692,7 +2701,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 @@ -2996,7 +3008,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 @@ -3023,7 +3035,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)))) @@ -3235,9 +3247,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)) @@ -3824,12 +3836,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) @@ -3861,9 +3889,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)))) @@ -4206,8 +4245,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. @@ -4321,13 +4359,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." @@ -4359,14 +4406,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) @@ -4386,12 +4435,13 @@ prompt the user for the name of an NNTP server to use." (gnus-1 arg dont-connect slave) (gnus-final-warning))) -(eval-and-compile - (unless (fboundp 'debbugs-gnu) - (autoload 'debbugs-gnu "debbugs-gnu" "List all outstanding Emacs bugs." t))) +(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.