:group 'gnus-start
:type 'hook)
-(defvar gnus-server-unopen-status nil
+(defcustom gnus-server-unopen-status nil
"The default status if the server is not able to open.
If the server is covered by Gnus agent, the possible values are
`denied', set the server denied; `offline', set the server offline;
`nil', ask user. If the server is not covered by Gnus agent, set the
-server denied.")
+server denied."
+ :group 'gnus-start
+ :type '(choice (const :tag "Ask" nil)
+ (const :tag "Deny server" denied)
+ (const :tag "Unplugg Agent" offline)))
;;;
;;; Server Communication
(setq elem (list gnus-command-method nil)
gnus-opened-servers (cons elem gnus-opened-servers)))
;; Set the status of this server.
- (setcar (cdr elem)
- (if result
+ (setcar (cdr elem)
+ (if result
(if (eq (cadr elem) 'offline)
'offline
'ok)
- (if (and gnus-agent
+ (if (and gnus-agent
(not (eq (cadr elem) 'offline))
(gnus-agent-method-p gnus-command-method))
(or gnus-server-unopen-status
- (if (gnus-y-or-n-p
+ (if (gnus-y-or-n-p
(format "Unable to open %s:%s, go offline? "
(car gnus-command-method)
(cadr gnus-command-method)))
(defun gnus-status-message (gnus-command-method)
"Return the status message from GNUS-COMMAND-METHOD.
-If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method
+If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method
this group uses will be queried."
(let ((gnus-command-method
(if (stringp gnus-command-method)
(gnus-cache-request-article article group))
(setq res (cons group article)
clean-up t))
+ ;; Check the agent cache.
((and gnus-agent gnus-agent-cache gnus-plugged
(numberp article)
(gnus-agent-request-article article group))
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (gnus-check-backend-function
'request-update-info (car gnus-command-method))
- (funcall (gnus-get-function gnus-command-method 'request-update-info)
- (gnus-group-real-name (gnus-info-group info))
- info (nth 1 gnus-command-method))))
+ (let ((group (gnus-info-group info)))
+ (and (funcall (gnus-get-function gnus-command-method
+ 'request-update-info)
+ (gnus-group-real-name group)
+ info (nth 1 gnus-command-method))
+ ;; If the minimum article number is greater than 1, then all
+ ;; smaller article numbers are known not to exist; we'll
+ ;; artificially add those to the 'read range.
+ (let* ((active (gnus-active group))
+ (min (car active)))
+ (when (> min 1)
+ (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
+ (read (gnus-info-read info))
+ (new-read (gnus-range-add read (list range))))
+ (gnus-info-set-read info new-read)))
+ info)))))
(defun gnus-request-expire-articles (articles group &optional force)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-expire-articles)
- articles (gnus-group-real-name group) (nth 1 gnus-command-method)
- force)))
-
-(defun gnus-request-move-article
- (article group server accept-function &optional last)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-move-article)
- article (gnus-group-real-name group)
- (nth 1 gnus-command-method) accept-function last)))
-
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (not-deleted
+ (funcall
+ (gnus-get-function gnus-command-method 'request-expire-articles)
+ articles (gnus-group-real-name group) (nth 1 gnus-command-method)
+ force)))
+ (when (and gnus-agent gnus-agent-cache
+ (gnus-sorted-difference articles not-deleted))
+ (gnus-agent-expire (gnus-sorted-difference articles not-deleted)
+ group 'force))
+ not-deleted))
+
+(defun gnus-request-move-article (article group server accept-function &optional last)
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (result (funcall (gnus-get-function gnus-command-method 'request-move-article)
+ article (gnus-group-real-name group)
+ (nth 1 gnus-command-method) accept-function last)))
+ (when (and result gnus-agent gnus-agent-cache)
+ (gnus-agent-expire (list article) group 'force))
+ result))
+
(defun gnus-request-accept-article (group &optional gnus-command-method last
no-encode)
;; Make sure there's a newline at the end of the article.
(let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer)))
(message-encode-message-body)))
- (let ((func (car (or gnus-command-method
- (gnus-find-method-for-group group)))))
- (funcall (intern (format "%s-request-accept-article" func))
+ (let ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group))))
+ (funcall (gnus-get-function gnus-command-method 'request-accept-article)
(if (stringp group) (gnus-group-real-name group) group)
(cadr gnus-command-method)
last)))
projects / elisp / gnus.git- / blobdiff