(require 'gnus-cache)
(require 'nnvirtual)
(require 'gnus-sum)
+(require 'gnus-score)
(eval-when-compile
(if (featurep 'xemacs)
(require 'itimer)
(defcustom gnus-agent-confirmation-function 'y-or-n-p
"Function to confirm when error happens."
+ :version "21.1"
:group 'gnus-agent
:type 'function)
+(defcustom gnus-agent-synchronize-flags 'ask
+ "Indicate if flags are synchronized when you plug in.
+If this is `ask' the hook will query the user."
+ :version "21.1"
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask))
+ :group 'gnus-agent)
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
(defun gnus-agent-lib-file (file)
"The full path of the Gnus agent library FILE."
- (concat (gnus-agent-directory) "agent.lib/" file))
+ (expand-file-name file
+ (file-name-as-directory
+ (expand-file-name "agent.lib" (gnus-agent-directory)))))
;;; Fetching setup functions.
(defmacro gnus-agent-with-fetch (&rest forms)
"Do FORMS safely."
`(unwind-protect
- (progn
+ (let ((gnus-agent-fetching t))
(gnus-agent-start-fetch)
,@forms)
(gnus-agent-stop-fetch)))
"Jc" gnus-enter-category-buffer
"Jj" gnus-agent-toggle-plugged
"Js" gnus-agent-fetch-session
- "JY" gnus-agent-synchronize
+ "JY" gnus-agent-synchronize-flags
"JS" gnus-group-send-drafts
"Ja" gnus-agent-add-group
"Jr" gnus-agent-remove-group)
(if plugged
(progn
(setq gnus-plugged plugged)
+ (gnus-agent-possibly-synchronize-flags)
(gnus-run-hooks 'gnus-agent-plugged-hook)
(setcar (cdr gnus-agent-mode-status) " Plugged"))
(gnus-agent-close-connections)
(while (search-backward "\n" nil t)
(replace-match "\\n" t t))))
+(defun gnus-agent-restore-gcc ()
+ "Restore GCC field from saved header."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t)
+ (replace-match "Gcc:" 'fixedcase))))
+
+(defun gnus-agent-any-covered-gcc ()
+ (save-restriction
+ (message-narrow-to-headers)
+ (let* ((gcc (mail-fetch-field "gcc" nil t))
+ (methods (and gcc
+ (mapcar 'gnus-inews-group-method
+ (message-unquote-tokens
+ (message-tokenize-header
+ gcc " ,")))))
+ covered)
+ (while (and (not covered) methods)
+ (setq covered
+ (member (car methods) gnus-agent-covered-methods)
+ methods (cdr methods)))
+ covered)))
+
+(defun gnus-agent-possibly-save-gcc ()
+ "Save GCC if Gnus is unplugged."
+ (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while (re-search-forward "^gcc:" nil t)
+ (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase))))))
+
+(defun gnus-agent-possibly-do-gcc ()
+ "Do GCC if Gnus is plugged."
+ (when (or gnus-plugged (not (gnus-agent-any-covered-gcc)))
+ (gnus-inews-do-gcc)))
+
;;;
;;; Group mode commands
;;;
(setf (cadddr c) (delete group (cadddr c))))))
(gnus-category-write)))
-(defun gnus-agent-synchronize ()
- "Synchronize local, unplugged, data with backend.
-Currently sends flag setting requests, if any."
+(defun gnus-agent-synchronize-flags ()
+ "Synchronize unplugged flags with servers."
+ (interactive)
+ (save-excursion
+ (dolist (gnus-command-method gnus-agent-covered-methods)
+ (when (file-exists-p (gnus-agent-lib-file "flags"))
+ (gnus-agent-synchronize-flags-server gnus-command-method)))))
+
+(defun gnus-agent-possibly-synchronize-flags ()
+ "Synchronize flags according to `gnus-agent-synchronize-flags'."
(interactive)
(save-excursion
(dolist (gnus-command-method gnus-agent-covered-methods)
(when (file-exists-p (gnus-agent-lib-file "flags"))
- (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
- (erase-buffer)
- (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
- (if (null (gnus-check-server gnus-command-method))
- (message "Couldn't open server %s" (nth 1 gnus-command-method))
- (while (not (eobp))
- (if (null (eval (read (current-buffer))))
- (progn (forward-line)
- (kill-line -1))
- (write-file (gnus-agent-lib-file "flags"))
- (error "Couldn't set flags from file %s"
- (gnus-agent-lib-file "flags"))))
- (write-file (gnus-agent-lib-file "flags")))
- (kill-buffer nil)))))
+ (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
+
+(defun gnus-agent-synchronize-flags-server (method)
+ "Synchronize flags set when unplugged for server."
+ (let ((gnus-command-method method))
+ (when (file-exists-p (gnus-agent-lib-file "flags"))
+ (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
+ (erase-buffer)
+ (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
+ (if (null (gnus-check-server gnus-command-method))
+ (message "Couldn't open server %s" (nth 1 gnus-command-method))
+ (while (not (eobp))
+ (if (null (eval (read (current-buffer))))
+ (progn (forward-line)
+ (kill-line -1))
+ (write-file (gnus-agent-lib-file "flags"))
+ (error "Couldn't set flags from file %s"
+ (gnus-agent-lib-file "flags"))))
+ (delete-file (gnus-agent-lib-file "flags")))
+ (kill-buffer nil))))
+
+(defun gnus-agent-possibly-synchronize-flags-server (method)
+ "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
+ (when (or (and gnus-agent-synchronize-flags
+ (not (eq gnus-agent-synchronize-flags 'ask)))
+ (and (eq gnus-agent-synchronize-flags 'ask)
+ (gnus-y-or-n-p (format "Synchronize flags on server `%s'? "
+ (cadr method)))))
+ (gnus-agent-synchronize-flags-server method)))
;;;
;;; Server mode commands
(insert "\n"))
(pop gnus-agent-group-alist))))
-(if (fboundp 'union)
- (defalias 'gnus-agent-union 'union)
- (defun gnus-agent-union (l1 l2)
- "Set union of lists L1 and L2."
- (cond ((null l1) l2)
- ((null l2) l1)
- ((equal l1 l2) l1)
- (t
- (or (>= (length l1) (length l2))
- (setq l1 (prog1 l2 (setq l2 l1))))
- (while l2
- (or (memq (car l2) l1)
- (push (car l2) l1))
- (pop l2))
- l1))))
-
(defun gnus-agent-fetch-headers (group &optional force)
(let ((articles (gnus-list-of-unread-articles group))
(gnus-decode-encoded-word-function 'identity)
(file (gnus-agent-article-name ".overview" group)))
;; Add article with marks to list of article headers we want to fetch.
(dolist (arts (gnus-info-marks (gnus-get-info group)))
- (setq articles (gnus-agent-union (gnus-uncompress-sequence (cdr arts))
+ (setq articles (gnus-union (gnus-uncompress-sequence (cdr arts))
articles)))
(setq articles (sort articles '<))
;; Remove known articles.
(setq gnus-agent-article-alist
(gnus-agent-read-file
(if dir
- (concat dir ".agentview")
+ (expand-file-name ".agentview" dir)
(gnus-agent-article-name ".agentview" group)))))
(defun gnus-agent-save-alist (group &optional articles state dir)
"Save the article-state alist for GROUP."
(let ((file-name-coding-system nnmail-pathname-coding-system))
(with-temp-file (if dir
- (concat dir ".agentview")
+ (expand-file-name ".agentview" dir)
(gnus-agent-article-name ".agentview" group))
(princ (setq gnus-agent-article-alist
(nconc gnus-agent-article-alist
(insert "\n"))))
(defun gnus-agent-article-name (article group)
- (concat (gnus-agent-directory) (gnus-agent-group-path group) "/"
- (if (stringp article) article (string-to-number article))))
+ (expand-file-name (if (stringp article) article (string-to-number article))
+ (file-name-as-directory
+ (expand-file-name (gnus-agent-group-path group)
+ (gnus-agent-directory)))))
(defun gnus-agent-batch-confirmation (msg)
"Show error message and return t."
(error
(unless (funcall gnus-agent-confirmation-function
(format "Error (%s). Continue? " err))
- (error "Cannot fetch articles into the Gnus agent."))))
+ (error "Cannot fetch articles into the Gnus agent.")))
+ (quit
+ (unless (funcall gnus-agent-confirmation-function
+ (format "Quit (%s). Continue? " err))
+ (signal 'quit "Cannot fetch articles into the Gnus agent."))))
(pop methods))
(gnus-message 6 "Finished fetching articles into the Gnus agent"))))
;; Fetch headers.
(when (and (or (gnus-active group) (gnus-activate-group group))
(setq articles (gnus-agent-fetch-headers group))
- (progn
+ (let ((nntp-server-buffer gnus-agent-overview-buffer))
;; Parse them and see which articles we want to fetch.
(setq gnus-newsgroup-dependencies
(make-vector (length articles) 0))
(gnus-get-predicate
(or (gnus-group-find-parameter group 'agent-predicate t)
(cadr category))))
- (setq score-param
- (or (gnus-group-get-parameter group 'agent-score)
- (caddr category)))
- (when score-param
- (gnus-score-headers (list (list score-param))))
- (setq arts nil)
- (while (setq gnus-headers (pop gnus-newsgroup-headers))
- (setq gnus-score
- (or (cdr (assq (mail-header-number gnus-headers)
- gnus-newsgroup-scored))
- gnus-summary-default-score))
- (when (funcall predicate)
- (push (mail-header-number gnus-headers)
- arts)))
+ (if (memq (caaddr predicate) '(gnus-agent-true gnus-agent-false))
+ ;; Simple implementation
+ (setq arts
+ (and (eq (caaddr predicate) 'gnus-agent-true) articles))
+ (setq arts nil)
+ (setq score-param
+ (or (gnus-group-get-parameter group 'agent-score t)
+ (caddr category)))
+ ;; Translate score-param into real one
+ (cond
+ ((not score-param))
+ ((eq score-param 'file)
+ (setq score-param (gnus-all-score-files group)))
+ ((stringp (car score-param)))
+ (t
+ (setq score-param (list (list score-param)))))
+ (when score-param
+ (gnus-score-headers score-param))
+ (while (setq gnus-headers (pop gnus-newsgroup-headers))
+ (setq gnus-score
+ (or (cdr (assq (mail-header-number gnus-headers)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score))
+ (when (funcall predicate)
+ (push (mail-header-number gnus-headers)
+ arts))))
;; Fetch the articles.
(when arts
(gnus-agent-fetch-articles group arts)))
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward "^\t")
- (if (> (read (current-buffer)) day)
+ (if (let ((fetch-date (read (current-buffer))))
+ (if (numberp fetch-date)
+ (> fetch-date day)
+ ;; History file is corrupted.
+ (gnus-message
+ 5
+ (format "File %s is corrupted!"
+ (gnus-agent-lib-file "history")))
+ (sit-for 1)
+ ;; Ignore it
+ t))
;; New article; we don't expire it.
(forward-line 1)
;; Old article. Schedule it for possible nuking.
projects / gnus / blobdiff