;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'timer))
(require 'cl))
-(eval-and-compile
- (autoload 'gnus-server-update-server "gnus-srvr")
- (autoload 'gnus-agent-customize-category "gnus-cus")
-)
+(autoload 'gnus-server-update-server "gnus-srvr")
+(autoload 'gnus-agent-customize-category "gnus-cus")
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
:type 'boolean
:group 'gnus-agent)
-(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
+(defcustom gnus-agent-auto-agentize-methods nil
"Initially, all servers from these methods are agentized.
The user may remove or add servers using the Server buffer.
See Info node `(gnus)Server Buffer'."
(defvar gnus-headers)
(defvar gnus-score)
+;; Added to support XEmacs
+(eval-and-compile
+ (unless (fboundp 'directory-files-and-attributes)
+ (defun directory-files-and-attributes (directory
+ &optional full match nosort)
+ (let (result)
+ (dolist (file (directory-files directory full match nosort))
+ (push (cons file (file-attributes file)) result))
+ (nreverse result)))))
+
;;;
;;; Setup
;;;
`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
(when (and gnus-agent-need-update-total-fetched-for
(not gnus-agent-inhibit-update-total-fetched-for))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(setq gnus-agent-need-update-total-fetched-for nil)
(gnus-group-update-group ,group t)))))
(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
(list name `(agent-predicate . ,(or default-agent-predicate 'false))))
-;; Added to support XEmacs
-(eval-and-compile
- (unless (fboundp 'directory-files-and-attributes)
- (defun directory-files-and-attributes (directory
- &optional full match nosort)
- (let (result)
- (dolist (file (directory-files directory full match nosort))
- (push (cons file (file-attributes file)) result))
- (nreverse result)))))
+(defun gnus-agent-read-group ()
+ "Read a group name in the minibuffer, with completion."
+ (let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
+ (when def
+ (setq def (gnus-group-decoded-name def)))
+ (gnus-group-completing-read (if def
+ (concat "Group Name (" def "): ")
+ "Group Name: ")
+ nil nil t nil nil def)))
;;; Fetching setup functions.
(defun gnus-agent-stop-fetch ()
"Save all data structures and clean up."
(setq gnus-agent-spam-hashtb nil)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(widen)))
(defmacro gnus-agent-with-fetch (&rest forms)
(fboundp 'make-mode-line-mouse-map))
(propertize string 'local-map
(make-mode-line-mouse-map mouse-button mouse-func)
- 'mouse-face 'mode-line-highlight)
+ 'mouse-face
+ (cond ((and (featurep 'xemacs)
+ ;; XEmacs' `facep' only checks for a face
+ ;; object, not for a face name, so it's useless
+ ;; to check with `facep'.
+ (find-face 'modeline))
+ 'modeline)
+ ((facep 'mode-line-highlight) ;; Emacs 22
+ 'mode-line-highlight)
+ ((facep 'mode-line) ;; Emacs 21
+ 'mode-line)) )
string))
(defun gnus-agent-toggle-plugged (set-to)
(gnus-agent-make-mode-line-string " Plugged"
'mouse-2
'gnus-agent-toggle-plugged))
- (gnus-agent-go-online gnus-agent-go-online)
- (gnus-agent-possibly-synchronize-flags))
+ (gnus-agent-go-online gnus-agent-go-online))
(t
(gnus-agent-close-connections)
(setq gnus-plugged set-to)
(interactive)
(save-excursion
(dolist (gnus-command-method (gnus-agent-covered-methods))
- (when (and (file-exists-p (gnus-agent-lib-file "flags"))
- (eq (gnus-server-status gnus-command-method) 'ok))
+ (when (eq (gnus-server-status gnus-command-method) 'ok)
(gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
(defun gnus-agent-synchronize-flags-server (method)
(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)))))
+ (when (and (file-exists-p (gnus-agent-lib-file "flags"))
+ (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)))
;;;###autoload
(new-command-method (gnus-find-method-for-group new-group))
(new-path (directory-file-name
(let (gnus-command-method new-command-method)
- (gnus-agent-group-pathname new-group)))))
+ (gnus-agent-group-pathname new-group))))
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-rename-file old-path new-path t)
(let* ((old-real-group (gnus-group-real-name old-group))
(let* ((command-method (gnus-find-method-for-group group))
(path (directory-file-name
(let (gnus-command-method command-method)
- (gnus-agent-group-pathname group)))))
+ (gnus-agent-group-pathname group))))
+ (file-name-coding-system nnmail-pathname-coding-system))
projects / gnus / blobdiff