;;; 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 <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.2"
+(defconst gnus-version-number "0.6"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Ma Gnus v%s" gnus-version-number)
: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."
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
(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 ()
: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-no-server)
("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
(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...
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))))
(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")
+(eval-and-compile
+ (unless (fboundp 'debbugs-gnu)
+ (autoload 'debbugs-gnu "debbugs-gnu" "List all outstanding Emacs bugs." t)))
(defun gnus-list-debbugs ()
"List all open Gnus bug reports."
(interactive)
projects / gnus / blobdiff