;;; 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 <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(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)
: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)
: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)
(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
: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."
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
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\")))
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))
: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)
("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.
(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 ()
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',
: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)))
"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"
(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)
;; `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
(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*")
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
("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
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
(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))))
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))
(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...
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)))
;; 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
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)
"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)
(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))))
(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."
(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.
(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."
(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)
(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.
projects / gnus / blobdiff