;;; gnus-int.el --- backend interface functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(defcustom gnus-after-set-mark-hook nil
"Hook called just after marks are set in a group."
+ :version "24.1"
:group 'gnus-start
:type 'hook)
(defcustom gnus-before-update-mark-hook nil
"Hook called just before marks are updated in a group."
+ :version "24.1"
:group 'gnus-start
:type 'hook)
(const :tag "Deny server" denied)
(const :tag "Unplug Agent" offline)))
+(defcustom gnus-nntp-server nil
+ "The name of the host running the NNTP server."
+ :group 'gnus-server
+ :type '(choice (const :tag "disable" nil)
+ string))
+(make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1")
+
(defvar gnus-internal-registry-spool-current-method nil
"The current method, for the registry.")
(eq (nth 1 (assoc method gnus-opened-servers))
'denied))
-(defvar gnus-backend-trace t)
+(defvar gnus-backend-trace nil)
(defun gnus-open-server (gnus-command-method)
"Open a connection to GNUS-COMMAND-METHOD."
;; If this method was previously denied, we just return nil.
(if (eq (nth 1 elem) 'denied)
(progn
- (gnus-message 1 "Denied server %s" server)
+ (gnus-message
+ 1 "Server %s previously determined to be down; not retrying" server)
nil)
;; Open the server.
(let* ((open-server-function
server (error-message-string err))
nil)
(quit
- (gnus-message 1 "Quit trying to open server %s" server)
+ (if debug-on-quit
+ (debug "Quit")
+ (gnus-message 1 "Quit trying to open server %s" server))
nil)))
open-offline)
;; If this hasn't been opened before, we add it to the list.
infos data))
(defun gnus-retrieve-group-data-early (gnus-command-method infos)
- "Start early async retrival of data from GNUS-COMMAND-METHOD."
+ "Start early async retrieval of data from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early)
result))
(defun gnus-request-compact (gnus-command-method)
- "Request groups compaction from GNUS-COMMAND-METHOD."
+ "Request groups compaction from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'request-compact)
article (gnus-group-real-name group)
(nth 1 gnus-command-method) buffer)))
-(defun gnus-request-thread (header)
+(defun gnus-request-thread (header group)
"Request the headers in the thread containing the article specified by HEADER."
- (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'request-thread)
- header)))
+ header
+ (gnus-group-real-name group))))
+
+(defun gnus-select-group-with-message-id (group message-id)
+ "Activate and select GROUP with the given MESSAGE-ID selected.
+Returns the article number of the message.
+
+If GROUP is not already selected, the message will be the only one in
+the group's summary.
+"
+ ;; TODO: is there a way to know at this point whether the group will
+ ;; be newly-selected? If so we could clean up the logic at the end
+ ;;
+ ;; save the new group's display parameter, if any, so we
+ ;; can replace it temporarily with zero.
+ (let ((saved-display
+ (gnus-group-get-parameter group 'display :allow-list)))
+
+ ;; Tell gnus we really don't want any articles
+ (gnus-group-set-parameter group 'display 0)
+
+ (unwind-protect
+ (gnus-summary-read-group-1
+ group (not :show-all) :no-article (not :kill-buffer)
+ ;; The combination of no-display and this dummy list of
+ ;; articles to select somehow makes it possible to open a
+ ;; group with no articles in it. Black magic.
+ :no-display '(-1); select-articles
+ )
+ ;; Restore the new group's display parameter
+ (gnus-group-set-parameter group 'display saved-display)))
+
+ ;; The summary buffer was suppressed by :no-display above.
+ ;; Create it now and insert the message
+ (let ((group-is-new (gnus-summary-setup-buffer group)))
+ (condition-case err
+ (let ((article-number
+ (gnus-summary-insert-subject message-id)))
+ (unless article-number
+ (signal 'error "message-id not in group"))
+ (gnus-summary-select-article nil nil nil article-number)
+ article-number)
+ ;; Clean up the new summary and propagate the error
+ (error (when group-is-new (gnus-summary-exit))
+ (apply 'signal err)))))
+
+(defun gnus-simplify-group-name (group)
+ "Return the simplest representation of the name of GROUP.
+This is the string that Gnus uses to identify the group."
+ (gnus-group-prefixed-name
+ (gnus-group-real-name group)
+ (gnus-group-method group)))
+
+;; largely based on nnir-warp-to-article
+(defun gnus-try-warping-via-registry ()
+ "Attempt to warp to the current article's source group based on
+data stored in the registry."
+ (interactive)
+ (when (gnus-summary-article-header)
+ (let* ((message-id (mail-header-id (gnus-summary-article-header)))
+ ;; Retrieve the message's group(s) from the registry
+ (groups (gnus-registry-get-id-key message-id 'group))
+ ;; If starting from an ephemeral group, this describes
+ ;; how to restore the window configuration
+ (quit-config
+ (gnus-ephemeral-group-p gnus-newsgroup-name))
+ (seen-groups (list (gnus-group-group-name))))
+
+ (catch 'found
+ (dolist (group (mapcar 'gnus-simplify-group-name groups))
+
+ ;; skip over any groups we really don't want to warp to.
+ (unless (or (member group seen-groups)
+ (gnus-ephemeral-group-p group) ;; any ephemeral group
+ (memq (car (gnus-find-method-for-group group))
+ '(nnir))) ;; Specific methods; this list may need to expand.
+
+ ;; remember that we've seen this group already
+ (push group seen-groups)
+
+ ;; first exit from any ephemeral summary buffer.
+ (when quit-config
+ (gnus-summary-exit)
+ ;; and if the ephemeral summary buffer in turn came from another
+ ;; summary buffer we have to clean that summary up too.
+ (when (eq (cdr quit-config) 'summary)
+ (gnus-summary-exit))
+ ;; remember that we've already done this part
+ (setq quit-config nil))
+
+ ;; Try to activate the group. If that fails, just move
+ ;; along. We may have more groups to work with
+ (ignore-errors
+ (gnus-select-group-with-message-id group message-id))
+ (throw 'found t)))))))
(defun gnus-warp-to-article ()
"Warps from an article in a virtual group to the article in its
(interactive)
(let ((gnus-command-method
(gnus-find-method-for-group gnus-newsgroup-name)))
- (when (gnus-check-backend-function
- 'warp-to-article (car gnus-command-method))
- (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))
+ (or
+ (when (gnus-check-backend-function
+ 'warp-to-article (car gnus-command-method))
+ (funcall (gnus-get-function gnus-command-method 'warp-to-article)))
+ (gnus-try-warping-via-registry))))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
(when (gnus-check-backend-function
'request-marks (car gnus-command-method))
(let ((group (gnus-info-group info)))
- (and (funcall (gnus-get-function gnus-command-method
- 'request-update-info)
+ (and (funcall (gnus-get-function gnus-command-method 'request-marks)
(gnus-group-real-name group)
info (nth 1 gnus-command-method))
;; If the minimum article number is greater than 1, then all
projects / gnus / blobdiff