+2004-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-update-summary-mark-positions): Search for
+ dummy marks in the right way.
+
+2004-10-18 Kevin Greiner <kgreiner@compsol.cc>
+
+ * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to
+ avoid infinite recursion via gnus-get-function.
+
+2004-10-18 Kevin Greiner <kgreiner@compsol.cc>
+
+ * gnus-agent.el (gnus-agent-synchronize-group-flags): When
+ necessary, pass full group name to gnus-request-set-marks.
+ (gnus-agent-synchronize-group-flags): Added support for sync'ing
+ tick marks.
+ (gnus-agent-synchronize-flags-server): Be silent when writing file.
+
+2004-10-18 Kevin Greiner <kgreiner@compsol.cc>
+
+ * gnus-agent.el (gnus-agent-synchronize-group-flags): Replaced
+ gnus-request-update-info with explicit code to sync the in-memory
+ info read flags with the marks being sync'd to the backend.
+
+2004-10-18 Kevin Greiner <kgreiner@compsol.cc>
+
+ * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore
+ servers that are offline. Avoids having gnus-agent-toggle-plugged
+ first ask if you want to open a server and then, even when you
+ responded with no, asking if you want to synchronize the server's
+ flags.
+ (gnus-agent-synchronize-flags-server): Rewrote read loop to handle
+ multi-line expressions.
+ (gnus-agent-synchronize-group-flags): New internal function.
+ Updates marks in memory (in the info structure) AND in the
+ backend.
+ (gnus-agent-check-overview-buffer): Fixed range of
+ deletion to remove entire duplicate line. Fixes merged article
+ number bug.
+
+ * gnus-util.el (gnus-remassoc): Fixed typo in documentation.
+
+ * nnagent.el (nnagent-request-set-mark): Use
+ gnus-agent-synchronize-group-flags, not backend's request-set-mark
+ method, to ensure that synchronization updates marks in the
+ backend and in the info (in memory) structure.
+
+2004-10-18 Kevin Greiner <kgreiner@compsol.cc>
+
+ * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing
+ unless plugged. Disable the agent so that an open failure causes
+ an error.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de>
+ * gnus-agent.el (gnus-agent-fetched-hook): Add :version.
+ (gnus-agent-go-online): Change :version.
+ (gnus-agent-expire-unagentized-dirs)
+ (gnus-agent-auto-agentize-methods): Add :version.
+
+2004-10-18 Kevin Greiner <kgreiner@compsol.cc>
+
+ * legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt):
+ New function. Used internally to only display 'gnus converting
+ files' message when actually necessary.
+
+ * gnus-sum.el (): Removed (require 'gnus-agent) as required
+ methods now autoloaded.
+
+ * gnus-int.el (gnus-request-move-article): Use
+ gnus-agent-unfetch-articles in place of gnus-agent-expire to
+ improve performance.
+
+2004-10-18 Kevin Greiner <kgreiner@compsol.cc>
+
+ * gnus-agent.el (gnus-agent-cat-groups): rewrote avoiding defsetf
+ to avoid run-time CL dependencies.
+ (gnus-agent-unfetch-articles): New function.
+ (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate
+ article numbers even when local .overview file is missing.
+ (gnus-agent-read-article-number): New function. Only accepts
+ 27-bit article numbers.
+ (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use
+ gnus-agent-read-article-number.
+ (gnus-agent-braid-nov): Rewrote to validate article numbers coming
+ from backend while recognizing that article numbers in .overview
+ must be valid.
+
+ * gnus-start.el (gnus-convert-old-newsrc): Changed message text as
+ some users confused by references to .newsrc when they only have a
+ .newsrc.eld file.
+ (gnus-convert-mark-converter-prompt,
+ gnus-convert-converter-needs-prompt): Fixed use of property list.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-get-unread-articles-in-group): Don't do
+ stuff for non-living groups.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil.
+ (gnus-agent-regenerate-group): Using nil messages aren't valid.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-read-agentview): Inline
+ gnus-uncompress-range.
+
+2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * legacy-gnus-agent.el
+ (gnus-agent-convert-to-compressed-agentview): Fixed typos with
+ help from Florian Weimer <fw@deneb.enyo.de>
+
+ * gnus-agent.el (gnus-agentize):
+ gnus-agent-send-mail-real-function no longer set to current value
+ of message-send-mail-function but rather a lambda that calls
+ message-send-mail-function. The change makes the agent real-time
+ responsive to user changes to message-send-mail-function.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-start.el (gnus-get-unread-articles): Fix last commit.
+
+2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-cache.el (gnus-cache-rename-group): New function.
+ (gnus-cache-delete-group): New function.
+
+ * gnus-agent.el (gnus-agent-rename-group): New function.
+ (gnus-agent-delete-group): New function.
+ (gnus-agent-save-group-info): Use gnus-command-method when
+ `method' parameter is nil. Don't write nil entries into the
+ active file.
+ (gnus-agent-get-group-info): New function.
+ (gnus-agent-get-local): Added optional parameters to avoid calling
+ gnus-group-real-name and gnus-find-method-for-group.
+ (gnus-agent-set-local): Delete stored entry if either min, or max,
+ are nil.
+ (gnus-agent-fetch-session): Reworded error/quit messages. On
+ quit, use gnus-agent-regenerate-group to record existance of any
+ articles fetched to disk before the quit occurred.
+
+ * gnus-int.el (gnus-request-delete-group): Use
+ gnus-cache-delete-group and gnus-agent-delete-group to keep the
+ local disk in sync with the server.
+ (gnus-request-rename-group): Use
+ gnus-cache-rename-group and gnus-agent-rename-group to keep the
+ local disk in sync with the server.
+
+ * gnus-start.el (gnus-get-unread-articles): Cosmetic
+ simplification to logic.
+
+ * gnus-group.el (): (gnus-group-delete-group): No longer update
+ gnus-cache-active-altered as gnus-request-delete-group now keeps
+ the cache in sync.
+ (gnus-group-list-active): Let the agent store a server's active
+ list if currently plugged.
+
+ * gnus-util.el (gnus-rename-file): New function.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-regenerate-group): Activate the group
+ when the group's active is not available.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to
+ error.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
+
+ * gnus-start.el (gnus-convert-old-newsrc): Only write the
+ conversion message to newsrc-dribble when an actual conversion is
+ performed.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
+
+ * gnus-agent.el (gnus-agent-read-local): Bind
+ nnheader-file-coding-system to gnus-agent-file-coding-system to
+ avoid the implicit assumption that they will always be equal.
+ (gnus-agent-save-local): Bind buffer-file-coding-system, not
+ coding-system-for-write, as the with-temp-file macro first prints
+ to a buffer then saves the buffer.
+
+2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * legacy-gnus-agent.el (): New. Provides converters that are only
+ loaded when gnus-convert-old-newsrc needs to call them.
+
+ * gnus-agent.el (gnus-agent-read-agentview): Removed support for
+ old file versions.
+ (gnus-group-prepare-hook): Removed function that converted list
+ form of gnus-agent-expire-days to group properties.
+
+ * gnus-start.el (gnus-convert-old-newsrc): Registered new
+ converters to handle old agent file formats. Added logic for a
+ "backup before upgrading warning".
+ (gnus-convert-mark-converter-prompt): Developers can mark
+ functions as needing (default), or not needing,
+ gnus-convert-old-newsrc's "backup before upgrading warning".
+ (gnus-convert-converter-needs-prompt): Tests whether the user
+ should be protected from potentially irreversable changes by the
+ function.
+
+2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-int.el (gnus-request-accept-article): Inform the agent that
+ articles are being added to a group.
+ (gnus-request-replace-article): Inform the agent that articles
+ need to be uncached as the cached contents are no longer valid.
+
+ * gnus-agent.el (gnus-agent-file-header-cache): Removed.
+ (gnus-agent-possibly-alter-active): Avoid null in numeric
+ comparison.
+ (gnus-agent-set-local): Refuse to save null in local object table.
+ (gnus-agent-regenerate-group): The REREAD parameter can now be a
+ list of articles that will be marked as unread.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
+
+ * gnus-range.el (gnus-sorted-range-intersection): Now accepts
+ single-interval range of the form (min . max). Previously the
+ range had to look like ((min . max)). Likewise, return
+ (min . max) rather than ((min . max)).
+ (gnus-range-map): Use gnus-range-normalize to accept
+ single-interval range.
+
+ * gnus-sum.el (gnus-summary-highlight-line): Articles stored in
+ the cache, but not the agent, now appear with their usual face.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
+
+ * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of
+ marks consisting of a single range {for example, (3 . 5)} rather
+ than a list of a single range { ((3 . 5)) }.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
+
+ * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the
+ uncompressed list.
+
+2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
+
+ * gnus-draft.el (gnus-group-send-queue): Pass the group name
+ "nndraft:queue" along to gnus-draft-send. Use
+ gnus-agent-prompt-send-queue.
+ (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group
+ is "nndraft:queue". Suggested by Gaute Strokkenes
+ <gs234@srcf.ucam.org>
+
+ * gnus-group.el (gnus-group-catchup): Use new
+ gnus-sequence-of-unread-articles, not
+ gnus-list-of-unread-articles, to avoid exhausting memory with huge
+ numbers of articles. Use gnus-range-map to avoid having to
+ uncompress the unread list.
+ (gnus-group-archive-directory,
+ gnus-group-recent-archive-directory): Fixed invalid ange-ftp
+ reference.
+
+ * gnus-range.el (gnus-range-map): Iterate over list or sequence.
+ (gnus-sorted-range-intersection): Intersection of two ranges
+ without requiring that they first be uncompressed.
+
+ * gnus-start.el (gnus-activate-group): Unless blocked by the
+ caller, possibly expand the active range to include both cached
+ and agentized articles.
+ (gnus-convert-old-newsrc): Rewrote in anticipation of having
+ multiple version-dependent converters.
+ (gnus-groups-to-gnus-format): Replaced gnus-agent-save-groups with
+ gnus-agent-save-active.
+ (gnus-save-newsrc-file): Save dirty agent range limits.
+
+ * gnus-sum.el (gnus-select-newgroup): Replaced inline code with
+ gnus-agent-possibly-alter-active.
+ (gnus-adjust-marked-articles): Faster handling of simple lists
+
+2004-10-18 David Edmondson <dme@dme.org>
+
+ * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call
+ excessively.
+
2004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
* mml.el (mml-preview): Use `pop-to-buffer'.
:group 'gnus-agent
:type 'function)
-(defcustom gnus-agent-synchronize-flags 'ask
+(defcustom gnus-agent-synchronize-flags nil
"Indicate if flags are synchronized when you plug in.
If this is `ask' the hook will query the user."
:version "21.1"
(gnus-agent-cat-defaccessor
gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
+
+;; This form is equivalent to defsetf except that it calls make-symbol
+;; whereas defsetf calls gensym (Using gensym creates a run-time
+;; dependency on the CL library).
+
(eval-and-compile
- (defsetf gnus-agent-cat-groups (category) (groups)
- (list 'gnus-agent-set-cat-groups category groups)))
+ (define-setf-method gnus-agent-cat-groups (category)
+ (let* ((--category--temp-- (make-symbol "--category--"))
+ (--groups--temp-- (make-symbol "--groups--")))
+ (list (list --category--temp--)
+ (list category)
+ (list --groups--temp--)
+ (let* ((category --category--temp--)
+ (groups --groups--temp--))
+ (list (quote gnus-agent-set-cat-groups) category groups))
+ (list (quote gnus-agent-cat-groups) --category--temp--))))
+ )
(defun gnus-agent-set-cat-groups (category groups)
(unless (eq groups 'ignore)
(unless gnus-agent-send-mail-function
(setq gnus-agent-send-mail-function
(or message-send-mail-real-function
- message-send-mail-function)
+ (function (lambda () (funcall message-send-mail-function))))
message-send-mail-real-function 'gnus-agent-send-mail))
;; If the servers file doesn't exist, auto-agentize some servers and
(interactive)
(save-excursion
(dolist (gnus-command-method (gnus-agent-covered-methods))
- (when (file-exists-p (gnus-agent-lib-file "flags"))
+ (when (and (file-exists-p (gnus-agent-lib-file "flags"))
+ (not (eq (gnus-server-status gnus-command-method) 'offline)))
(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))
+ (let ((gnus-command-method method)
+ (gnus-agent nil))
(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))
- (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method))
- (while (not (eobp))
- (if (null (eval (read (current-buffer))))
- (gnus-delete-line)
- (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")))
+ (cond ((null gnus-plugged)
+ (gnus-message
+ 1 "You must be plugged to synchronize flags with server %s"
+ (nth 1 gnus-command-method)))
+ ((null (gnus-check-server gnus-command-method))
+ (gnus-message
+ 1 "Couldn't open server %s" (nth 1 gnus-command-method)))
+ (t
+ (condition-case err
+ (while t
+ (let ((bgn (point)))
+ (eval (read (current-buffer)))
+ (delete-region bgn (point))))
+ (end-of-file
+ (delete-file (gnus-agent-lib-file "flags")))
+ (error
+ (let ((file (gnus-agent-lib-file "flags")))
+ (write-region (point-min) (point-max)
+ (gnus-agent-lib-file "flags") nil 'silent)
+ (error "Couldn't set flags from file %s due to %s"
+ file (error-message-string err)))))))
(kill-buffer nil))))
(defun gnus-agent-possibly-synchronize-flags-server (method)
(cadr method)))))
(gnus-agent-synchronize-flags-server method)))
+;;;###autoload
+(defun gnus-agent-rename-group (old-group new-group)
+ "Rename fully-qualified OLD-GROUP as NEW-GROUP. Always updates the agent, even when
+disabled, as the old agent files would corrupt gnus when the agent was
+next enabled. Depends upon the caller to determine whether group renaming is supported."
+ (let* ((old-command-method (gnus-find-method-for-group old-group))
+ (old-path (directory-file-name
+ (let (gnus-command-method old-command-method)
+ (gnus-agent-group-pathname old-group))))
+ (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-rename-file old-path new-path t)
+
+ (let* ((old-real-group (gnus-group-real-name old-group))
+ (new-real-group (gnus-group-real-name new-group))
+ (old-active (gnus-agent-get-group-info old-command-method old-real-group)))
+ (gnus-agent-save-group-info old-command-method old-real-group nil)
+ (gnus-agent-save-group-info new-command-method new-real-group old-active)
+
+ (let ((old-local (gnus-agent-get-local old-group
+ old-real-group old-command-method)))
+ (gnus-agent-set-local old-group
+ nil nil
+ old-real-group old-command-method)
+ (gnus-agent-set-local new-group
+ (car old-local) (cdr old-local)
+ new-real-group new-command-method)))))
+
+;;;###autoload
+(defun gnus-agent-delete-group (group)
+ "Delete fully-qualified GROUP. Always updates the agent, even when
+disabled, as the old agent files would corrupt gnus when the agent was
+next enabled. Depends upon the caller to determine whether group deletion is supported."
+ (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-delete-file path)
+
+ (let* ((real-group (gnus-group-real-name group)))
+ (gnus-agent-save-group-info command-method real-group nil)
+
+ (let ((local (gnus-agent-get-local group
+ real-group command-method)))
+ (gnus-agent-set-local group
+ nil nil
+ real-group command-method)))))
+
;;;
;;; Server mode commands
;;;
gnus-downloadable-mark)
'unread))))
+;;;###autoload
(defun gnus-agent-get-undownloaded-list ()
"Construct list of articles that have not been downloaded."
(let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
;;; Internal functions
;;;
+(defun gnus-agent-synchronize-group-flags (group actions server)
+"Update a plugged group by performing the indicated actions."
+ (let* ((gnus-command-method (gnus-server-to-method server))
+ (info
+ ;; This initializer is required as gnus-request-set-mark
+ ;; calls gnus-group-real-name to strip off the host name
+ ;; before calling the backend. Now that the backend is
+ ;; trying to call gnus-request-set-mark, I have to
+ ;; reconstruct the original group name.
+ (or (gnus-get-info group)
+ (gnus-get-info
+ (setq group (gnus-group-full-name
+ group gnus-command-method))))))
+ (gnus-request-set-mark group actions)
+
+ (when info
+ (dolist (action actions)
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (marks (nth 2 action)))
+ (dolist (mark marks)
+ (cond ((eq mark 'read)
+ (gnus-info-set-read
+ info
+ (funcall (if (eq what 'add)
+ 'gnus-range-add
+ 'gnus-remove-from-range)
+ (gnus-info-read info)
+ range))
+ (gnus-get-unread-articles-in-group
+ info
+ (gnus-active (gnus-info-group info))))
+ ((memq mark '(tick))
+ (let ((info-marks (assoc mark (gnus-info-marks info))))
+ (unless info-marks
+ (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info))))
+ (setcdr info-marks (funcall (if (eq what 'add)
+ 'gnus-range-add
+ 'gnus-remove-from-range)
+ (cdr info-marks)
+ range)))))))))
+ nil))
+
(defun gnus-agent-save-active (method)
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
;; will add it while reading the file.
(gnus-write-active-file file new nil)))
+;;;###autoload
(defun gnus-agent-possibly-alter-active (group active &optional info)
"Possibly expand a group's active range to include articles
downloaded into the agent."
(defun gnus-agent-save-group-info (method group active)
"Update a single group's active range in the agent's copy of the server's active file."
(when (gnus-agent-method-p method)
- (let* ((gnus-command-method method)
+ (let* ((gnus-command-method (or method gnus-command-method))
(coding-system-for-write nnheader-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system)
(file (gnus-agent-lib-file "active"))
(when (re-search-forward
(concat "^" (regexp-quote group) " ") nil t)
(save-excursion
- (setq oactive-max (read (current-buffer)) ;; max
+ (setq oactive-max (read (current-buffer)) ;; max
oactive-min (read (current-buffer)))) ;; min
(gnus-delete-line)))
- (insert (format "%S %d %d y\n" (intern group)
- (max (or oactive-max (cdr active)) (cdr active))
- (min (or oactive-min (car active)) (car active))))
- (goto-char (point-max))
- (while (search-backward "\\." nil t)
- (delete-char 1))))))
+ (when active
+ (insert (format "%S %d %d y\n" (intern group)
+ (max (or oactive-max (cdr active)) (cdr active))
+ (min (or oactive-min (car active)) (car active))))
+ (goto-char (point-max))
+ (while (search-backward "\\." nil t)
+ (delete-char 1)))))))
+
+(defun gnus-agent-get-group-info (method group)
+ "Get a single group's active range in the agent's copy of the server's active file."
+ (when (gnus-agent-method-p method)
+ (let* ((gnus-command-method (or method gnus-command-method))
+ (coding-system-for-write nnheader-file-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (file (gnus-agent-lib-file "active"))
+ oactive-min oactive-max)
+ (gnus-make-directory (file-name-directory file))
+ (with-temp-buffer
+ ;; Emacs got problem to match non-ASCII group in multibyte buffer.
+ (mm-disable-multibyte)
+ (when (file-exists-p file)
+ (nnheader-insert-file-contents file)
+
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote group) " ") nil t)
+ (save-excursion
+ (setq oactive-max (read (current-buffer)) ;; max
+ oactive-min (read (current-buffer))) ;; min
+ (cons oactive-min oactive-max))))))))
(defun gnus-agent-group-path (group)
"Translate GROUP into a file name."
(gnus-message 7 ""))
(cdr fetched-articles))))))
+(defun gnus-agent-unfetch-articles (group articles)
+ "Delete ARTICLES that were fetched from GROUP into the agent."
+ (when articles
+ (gnus-agent-load-alist group)
+ (let* ((alist (cons nil gnus-agent-article-alist))
+ (articles (sort articles #'<))
+ (next-possibility alist)
+ (delete-this (pop articles)))
+ (while (and (cdr next-possibility) delete-this)
+ (let ((have-this (caar (cdr next-possibility))))
+ (cond ((< delete-this have-this)
+ (setq delete-this (pop articles)))
+ ((= delete-this have-this)
+ (let ((timestamp (cdar (cdr next-possibility))))
+ (when timestamp
+ (let* ((file-name (concat (gnus-agent-group-pathname group)
+ (number-to-string have-this))))
+ (delete-file file-name))))
+
+ (setcdr next-possibility (cddr next-possibility)))
+ (t
+ (setq next-possibility (cdr next-possibility))))))
+ (setq gnus-agent-article-alist (cdr alist))
+ (gnus-agent-save-alist group))))
+
(defun gnus-agent-crosspost (crosses article &optional date)
(setq date (or date t))
(setq backed-up (gnus-agent-backup-overview-buffer)))
(gnus-message 1
"Duplicate overview line for %d" cur)
- (delete-region (point) (progn (forward-line 1) (point))))
+ (delete-region p (progn (forward-line 1) (point))))
((< cur prev-num)
(or backed-up
(setq backed-up (gnus-agent-backup-overview-buffer)))
(insert "\n"))
(setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
+;;;###autoload
(defun gnus-agent-find-parameter (group symbol)
"Search for GROUPs SYMBOL in the group's parameters, the group's
topic parameters, the group's category, or the customizable
;; of FILE.
(copy-to-buffer
gnus-agent-overview-buffer (point-min) (point-max))
- (when (file-exists-p file)
- (gnus-agent-braid-nov group articles file))
+ ;; NOTE: Call g-a-brand-nov even when the file does not
+ ;; exist. As a minimum, it will validate the article
+ ;; numbers already in the buffer.
+ (gnus-agent-braid-nov group articles file)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
(gnus-agent-check-overview-buffer)
(nnheader-insert-file-contents file)))))
articles))
+(defsubst gnus-agent-read-article-number ()
+ "Reads the article number at point. Returns nil when a valid article number can not be read."
+
+ ;; It is unfortunite but the read function quietly overflows
+ ;; integer. As a result, I have to use string operations to test
+ ;; for overflow BEFORE calling read.
+ (when (looking-at "[0-9]+\t")
+ (let ((len (- (match-end 0) (match-beginning 0))))
+ (cond ((< len 9)
+ (read (current-buffer)))
+ ((= len 9)
+ ;; Many 9 digit base-10 numbers can be represented in a 27-bit int
+ ;; Back convert from int to string to ensure that this is one of them.
+ (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0))))
+ (num (read (current-buffer)))
+ (str2 (int-to-string num)))
+ (when (equal str1 str2)
+ num)))))))
+
(defsubst gnus-agent-copy-nov-line (article)
+ "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer."
(let (art b e)
(set-buffer gnus-agent-overview-buffer)
(while (and (not (eobp))
- (< (setq art (read (current-buffer))) article))
+ (or (not (setq art (gnus-agent-read-article-number)))
+ (< art article)))
(forward-line 1))
(beginning-of-line)
(if (or (eobp)
(defun gnus-agent-braid-nov (group articles file)
"Merge agent overview data with given file.
-Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given
-FILE and places the combined headers into `nntp-server-buffer'."
+Takes unvalidated headers for ARTICLES from
+`gnus-agent-overview-buffer' and validated headers from the given
+FILE and places the combined valid headers into
+`nntp-server-buffer'. This function can be used, when file
+doesn't exist, to valid the overview buffer."
(let (start last)
(set-buffer gnus-agent-overview-buffer)
(goto-char (point-min))
(set-buffer nntp-server-buffer)
(erase-buffer)
- (nnheader-insert-file-contents file)
+ (when (file-exists-p file)
+ (nnheader-insert-file-contents file))
(goto-char (point-max))
(forward-line -1)
- (unless (looking-at "[0-9]+\t")
- ;; Remove corrupted lines
- (gnus-message
- 1 "Overview %s is corrupted. Removing corrupted lines..." file)
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at "[0-9]+\t")
- (forward-line 1)
- (delete-region (point) (progn (forward-line 1) (point)))))
- (forward-line -1))
+
(unless (or (= (point-min) (point-max))
(< (setq last (read (current-buffer))) (car articles)))
- ;; We do it the hard way.
+ ;; Old and new overlap -- We do it the hard way.
(when (nnheader-find-nov-line (car articles))
;; Replacing existing NOV entry
(delete-region (point) (progn (forward-line 1) (point))))
(gnus-agent-copy-nov-line (pop articles))
(ignore-errors
- (while articles
- (while (let ((art (read (current-buffer))))
- (cond ((< art (car articles))
- (forward-line 1)
- t)
- ((= art (car articles))
- (beginning-of-line)
- (delete-region
- (point) (progn (forward-line 1) (point)))
- nil)
- (t
- (beginning-of-line)
- nil))))
-
- (gnus-agent-copy-nov-line (pop articles)))))
-
- ;; Copy the rest lines
- (set-buffer nntp-server-buffer)
+ (while articles
+ (while (let ((art (read (current-buffer))))
+ (cond ((< art (car articles))
+ (forward-line 1)
+ t)
+ ((= art (car articles))
+ (beginning-of-line)
+ (delete-region
+ (point) (progn (forward-line 1) (point)))
+ nil)
+ (t
+ (beginning-of-line)
+ nil))))
+
+ (gnus-agent-copy-nov-line (pop articles)))))
+
(goto-char (point-max))
+
+ ;; Append the remaining lines
(when articles
(when last
(set-buffer gnus-agent-overview-buffer)
- (ignore-errors
- (while (<= (read (current-buffer)) last)
- (forward-line 1)))
- (beginning-of-line)
(setq start (point))
(set-buffer nntp-server-buffer))
- (insert-buffer-substring gnus-agent-overview-buffer start))))
+
+ (let ((p (point)))
+ (insert-buffer-substring gnus-agent-overview-buffer start)
+ (goto-char p))
+
+ (setq last (or last -134217728))
+ (let (sort art)
+ (while (not (eobp))
+ (setq art (gnus-agent-read-article-number))
+ (cond ((not art)
+ ;; Bad art num - delete this line
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((< art last)
+ ;; Art num out of order - enable sort
+ (setq sort t)
+ (forward-line 1))
+ (t
+ ;; Good art num
+ (setq last art)
+ (forward-line 1))))
+ (when sort
+ (sort-numeric-fields 1 (point-min) (point-max)))))))
;; Keeps the compiler from warning about the free variable in
;; gnus-agent-read-agentview.
(defun gnus-agent-read-agentview (file)
"Load FILE and do a `read' there."
(with-temp-buffer
- (ignore-errors
+ (condition-case nil
+ (progn
(nnheader-insert-file-contents file)
(goto-char (point-min))
(let ((alist (read (current-buffer)))
changed-version)
(cond
+ ((< version 2)
+ (error "gnus-agent-read-agentview no longer supports version %d. Stop gnus, manually evaluate gnus-agent-convert-to-compressed-agentview, then restart gnus." version))
((= version 0)
(let ((inhibit-quit t)
entry)
(mapcar
(lambda (comp-list)
(let ((state (car comp-list))
- (sequence (gnus-uncompress-sequence
- (cdr comp-list))))
+ (sequence (inline
+ (gnus-uncompress-range
+ (cdr comp-list)))))
(mapcar (lambda (article-id)
(setq uncomp (cons (cons article-id state) uncomp)))
sequence)))
(when changed-version
(let ((gnus-agent-article-alist alist))
(gnus-agent-save-alist gnus-agent-read-agentview)))
- alist))))
+ alist))
+ (file-error nil))))
(defun gnus-agent-save-alist (group &optional articles state)
"Save the article-state alist for GROUP."
(line 1))
(with-temp-buffer
(condition-case nil
- (nnheader-insert-file-contents file)
+ (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
+ (nnheader-insert-file-contents file))
(file-error))
(goto-char (point-min))
;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
(dest (gnus-agent-lib-file "local")))
(gnus-make-directory (gnus-agent-lib-file ""))
- (with-temp-file dest
- (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
- (file-name-coding-system nnmail-pathname-coding-system)
- (coding-system-for-write
- gnus-agent-file-coding-system)
- print-level print-length item article
- (standard-output (current-buffer)))
- (mapatoms (lambda (symbol)
- (cond ((not (boundp symbol))
- nil)
- ((member (symbol-name symbol) '("+dirty" "+method"))
- nil)
- (t
- (prin1 symbol)
- (let ((range (symbol-value symbol)))
- (princ " ")
- (princ (car range))
- (princ " ")
- (princ (cdr range))
- (princ "\n")))))
- my-obarray)))))))
-
-(defun gnus-agent-get-local (group)
- (let* ((gmane (gnus-group-real-name group))
- (gnus-command-method (gnus-find-method-for-group group))
+
+ (let ((buffer-file-coding-system gnus-agent-file-coding-system))
+ (with-temp-file dest
+ (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ print-level print-length item article
+ (standard-output (current-buffer)))
+ (mapatoms (lambda (symbol)
+ (cond ((not (boundp symbol))
+ nil)
+ ((member (symbol-name symbol) '("+dirty" "+method"))
+ nil)
+ (t
+ (prin1 symbol)
+ (let ((range (symbol-value symbol)))
+ (princ " ")
+ (princ (car range))
+ (princ " ")
+ (princ (cdr range))
+ (princ "\n")))))
+ my-obarray))))))))
+
+(defun gnus-agent-get-local (group &optional gmane method)
+ (let* ((gmane (or gmane (gnus-group-real-name group)))
+ (gnus-command-method (or method (gnus-find-method-for-group group)))
(local (gnus-agent-load-local))
(symb (intern gmane local))
(minmax (and (boundp symb) (symbol-value symb))))
nil)
((and min max)
(set symb (cons min max))
- t))
+ t)
+ (t
+ (unintern symb local)))
(set (intern "+dirty" local) t))))
(defun gnus-agent-article-name (article group)
group gnus-command-method)
(error
(unless (funcall gnus-agent-confirmation-function
- (format "Error %s. Continue? "
+ (format "Error %s while fetching session. Should gnus continue? "
(error-message-string err)))
(error "Cannot fetch articles into the Gnus agent")))
(quit
+ (gnus-agent-regenerate-group group)
(unless (funcall gnus-agent-confirmation-function
(format
- "Quit fetching session %s. Continue? "
+ "%s while fetching session. Should gnus continue? "
(error-message-string err)))
(signal 'quit
"Cannot fetch articles into the Gnus agent")))))))))
(let ((dir (gnus-agent-group-pathname group)))
(when (boundp 'gnus-agent-expire-current-dirs)
(set 'gnus-agent-expire-current-dirs
- (cons dir
- (symbol-value 'gnus-agent-expire-current-dirs))))
+ (cons dir
+ (symbol-value 'gnus-agent-expire-current-dirs))))
(if (and (not force)
- (eq 'DISABLE (gnus-agent-find-parameter group
- 'agent-enable-expiration)))
- (gnus-message 5 "Expiry skipping over %s" group)
+ (eq 'DISABLE (gnus-agent-find-parameter group
+ 'agent-enable-expiration)))
+ (gnus-message 5 "Expiry skipping over %s" group)
(gnus-message 5 "Expiring articles in %s" group)
(gnus-agent-load-alist group)
- (let* ((stats (if (boundp 'gnus-agent-expire-stats)
- ;; Use the list provided by my caller
- (symbol-value 'gnus-agent-expire-stats)
- ;; otherwise use my own temporary list
- (list 0 0 0.0)))
- (info (gnus-get-info group))
- (alist gnus-agent-article-alist)
- (day (- (time-to-days (current-time))
- (gnus-agent-find-parameter group 'agent-days-until-old)))
- (specials (if (and alist
- (not force))
- ;; This could be a bit of a problem. I need to
- ;; keep the last article to avoid refetching
- ;; headers when using nntp in the backend. At
- ;; the same time, if someone uses a backend
- ;; that supports article moving then I may have
- ;; to remove the last article to complete the
- ;; move. Right now, I'm going to assume that
- ;; FORCE overrides specials.
- (list (caar (last alist)))))
- (unreads ;; Articles that are excluded from the
- ;; expiration process
- (cond (gnus-agent-expire-all
- ;; All articles are marked read by global decree
- nil)
- ((eq articles t)
- ;; All articles are marked read by function
- ;; parameter
- nil)
- ((not articles)
- ;; Unread articles are marked protected from
- ;; expiration Don't call
- ;; gnus-list-of-unread-articles as it returns
- ;; articles that have not been fetched into the
- ;; agent.
- (ignore-errors
- (gnus-agent-unread-articles group)))
- (t
- ;; All articles EXCEPT those named by the caller
- ;; are protected from expiration
- (gnus-sorted-difference
- (gnus-uncompress-range
- (cons (caar alist)
- (caar (last alist))))
- (sort articles '<)))))
- (marked ;; More articles that are excluded from the
- ;; expiration process
- (cond (gnus-agent-expire-all
- ;; All articles are unmarked by global decree
- nil)
- ((eq articles t)
- ;; All articles are unmarked by function
- ;; parameter
- nil)
- (articles
- ;; All articles may as well be unmarked as the
- ;; unreads list already names the articles we are
- ;; going to keep
- nil)
- (t
- ;; Ticked and/or dormant articles are excluded
- ;; from expiration
- (nconc
- (gnus-uncompress-range
- (cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
- (cdr (assq 'dormant
- (gnus-info-marks info))))))))
- (nov-file (concat dir ".overview"))
- (cnt 0)
- (completed -1)
- dlist
- type)
-
- ;; The normal article alist contains elements that look like
- ;; (article# . fetch_date) I need to combine other
- ;; information with this list. For example, a flag indicating
- ;; that a particular article MUST BE KEPT. To do this, I'm
- ;; going to transform the elements to look like (article#
- ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
- ;; the process to generate the expired article alist.
-
- ;; Convert the alist elements to (article# fetch_date nil
- ;; nil).
- (setq dlist (mapcar (lambda (e)
- (list (car e) (cdr e) nil nil)) alist))
-
- ;; Convert the keep lists to elements that look like (article#
- ;; nil keep_flag nil) then append it to the expanded dlist
- ;; These statements are sorted by ascending precidence of the
- ;; keep_flag.
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'unread nil))
- unreads)))
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'marked nil))
- marked)))
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'special nil))
- specials)))
-
- (set-buffer overview)
- (erase-buffer)
- (buffer-disable-undo)
- (when (file-exists-p nov-file)
- (gnus-message 7 "gnus-agent-expire: Loading overview...")
- (nnheader-insert-file-contents nov-file)
- (goto-char (point-min))
-
- (let (p)
- (while (< (setq p (point)) (point-max))
- (condition-case nil
- ;; If I successfully read an integer (the plus zero
- ;; ensures a numeric type), prepend a marker entry
- ;; to the list
- (push (list (+ 0 (read (current-buffer))) nil nil
- (set-marker (make-marker) p))
- dlist)
- (error
- (gnus-message 1 "gnus-agent-expire: read error \
+ (let* ((bytes-freed 0)
+ (files-deleted 0)
+ (nov-entries-deleted 0)
+ (info (gnus-get-info group))
+ (alist gnus-agent-article-alist)
+ (day (- (time-to-days (current-time))
+ (gnus-agent-find-parameter group 'agent-days-until-old)))
+ (specials (if (and alist
+ (not force))
+ ;; This could be a bit of a problem. I need to
+ ;; keep the last article to avoid refetching
+ ;; headers when using nntp in the backend. At
+ ;; the same time, if someone uses a backend
+ ;; that supports article moving then I may have
+ ;; to remove the last article to complete the
+ ;; move. Right now, I'm going to assume that
+ ;; FORCE overrides specials.
+ (list (caar (last alist)))))
+ (unreads ;; Articles that are excluded from the
+ ;; expiration process
+ (cond (gnus-agent-expire-all
+ ;; All articles are marked read by global decree
+ nil)
+ ((eq articles t)
+ ;; All articles are marked read by function
+ ;; parameter
+ nil)
+ ((not articles)
+ ;; Unread articles are marked protected from
+ ;; expiration Don't call
+ ;; gnus-list-of-unread-articles as it returns
+ ;; articles that have not been fetched into the
+ ;; agent.
+ (ignore-errors
+ (gnus-agent-unread-articles group)))
+ (t
+ ;; All articles EXCEPT those named by the caller
+ ;; are protected from expiration
+ (gnus-sorted-difference
+ (gnus-uncompress-range
+ (cons (caar alist)
+ (caar (last alist))))
+ (sort articles '<)))))
+ (marked ;; More articles that are excluded from the
+ ;; expiration process
+ (cond (gnus-agent-expire-all
+ ;; All articles are unmarked by global decree
+ nil)
+ ((eq articles t)
+ ;; All articles are unmarked by function
+ ;; parameter
+ nil)
+ (articles
+ ;; All articles may as well be unmarked as the
+ ;; unreads list already names the articles we are
+ ;; going to keep
+ nil)
+ (t
+ ;; Ticked and/or dormant articles are excluded
+ ;; from expiration
+ (nconc
+ (gnus-uncompress-range
+ (cdr (assq 'tick (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'dormant
+ (gnus-info-marks info))))))))
+ (nov-file (concat dir ".overview"))
+ (cnt 0)
+ (completed -1)
+ dlist
+ type)
+
+ ;; The normal article alist contains elements that look like
+ ;; (article# . fetch_date) I need to combine other
+ ;; information with this list. For example, a flag indicating
+ ;; that a particular article MUST BE KEPT. To do this, I'm
+ ;; going to transform the elements to look like (article#
+ ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
+ ;; the process to generate the expired article alist.
+
+ ;; Convert the alist elements to (article# fetch_date nil
+ ;; nil).
+ (setq dlist (mapcar (lambda (e)
+ (list (car e) (cdr e) nil nil)) alist))
+
+ ;; Convert the keep lists to elements that look like (article#
+ ;; nil keep_flag nil) then append it to the expanded dlist
+ ;; These statements are sorted by ascending precidence of the
+ ;; keep_flag.
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e)
+ (list e nil 'unread nil))
+ unreads)))
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e)
+ (list e nil 'marked nil))
+ marked)))
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e)
+ (list e nil 'special nil))
+ specials)))
+
+ (set-buffer overview)
+ (erase-buffer)
+ (buffer-disable-undo)
+ (when (file-exists-p nov-file)
+ (gnus-message 7 "gnus-agent-expire: Loading overview...")
+ (nnheader-insert-file-contents nov-file)
+ (goto-char (point-min))
+
+ (let (p)
+ (while (< (setq p (point)) (point-max))
+ (condition-case nil
+ ;; If I successfully read an integer (the plus zero
+ ;; ensures a numeric type), prepend a marker entry
+ ;; to the list
+ (push (list (+ 0 (read (current-buffer))) nil nil
+ (set-marker (make-marker) p))
+ dlist)
+ (error
+ (gnus-message 1 "gnus-agent-expire: read error \
occurred when reading expression at %s in %s. Skipping to next \
line." (point) nov-file)))
- ;; Whether I succeeded, or failed, it doesn't matter.
- ;; Move to the next line then try again.
- (forward-line 1)))
-
- (gnus-message
- 7 "gnus-agent-expire: Loading overview... Done"))
- (set-buffer-modified-p nil)
-
- ;; At this point, all of the information is in dlist. The
- ;; only problem is that much of it is spread across multiple
- ;; entries. Sort then MERGE!!
- (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
- ;; If two entries have the same article-number then sort by
- ;; ascending keep_flag.
- (let ((special 0)
- (marked 1)
- (unread 2))
- (setq dlist
- (sort dlist
- (lambda (a b)
- (cond ((< (nth 0 a) (nth 0 b))
- t)
- ((> (nth 0 a) (nth 0 b))
- nil)
- (t
- (let ((a (or (symbol-value (nth 2 a))
- 3))
- (b (or (symbol-value (nth 2 b))
- 3)))
- (<= a b))))))))
- (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
- (gnus-message 7 "gnus-agent-expire: Merging entries... ")
- (let ((dlist dlist))
- (while (cdr dlist) ; I'm not at the end-of-list
- (if (eq (caar dlist) (caadr dlist))
- (let ((first (cdr (car dlist)))
- (secnd (cdr (cadr dlist))))
- (setcar first (or (car first)
- (car secnd))) ; fetch_date
- (setq first (cdr first)
- secnd (cdr secnd))
- (setcar first (or (car first)
- (car secnd))) ; Keep_flag
- (setq first (cdr first)
- secnd (cdr secnd))
- (setcar first (or (car first)
- (car secnd))) ; NOV_entry_marker
-
- (setcdr dlist (cddr dlist)))
- (setq dlist (cdr dlist)))))
- (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
-
- (let* ((len (float (length dlist)))
- (alist (list nil))
- (tail-alist alist))
- (while dlist
- (let ((new-completed (truncate (* 100.0
- (/ (setq cnt (1+ cnt))
- len))))
+ ;; Whether I succeeded, or failed, it doesn't matter.
+ ;; Move to the next line then try again.
+ (forward-line 1)))
+
+ (gnus-message
+ 7 "gnus-agent-expire: Loading overview... Done"))
+ (set-buffer-modified-p nil)
+
+ ;; At this point, all of the information is in dlist. The
+ ;; only problem is that much of it is spread across multiple
+ ;; entries. Sort then MERGE!!
+ (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
+ ;; If two entries have the same article-number then sort by
+ ;; ascending keep_flag.
+ (let ((special 0)
+ (marked 1)
+ (unread 2))
+ (setq dlist
+ (sort dlist
+ (lambda (a b)
+ (cond ((< (nth 0 a) (nth 0 b))
+ t)
+ ((> (nth 0 a) (nth 0 b))
+ nil)
+ (t
+ (let ((a (or (symbol-value (nth 2 a))
+ 3))
+ (b (or (symbol-value (nth 2 b))
+ 3)))
+ (<= a b))))))))
+ (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
+ (gnus-message 7 "gnus-agent-expire: Merging entries... ")
+ (let ((dlist dlist))
+ (while (cdr dlist) ; I'm not at the end-of-list
+ (if (eq (caar dlist) (caadr dlist))
+ (let ((first (cdr (car dlist)))
+ (secnd (cdr (cadr dlist))))
+ (setcar first (or (car first)
+ (car secnd))) ; fetch_date
+ (setq first (cdr first)
+ secnd (cdr secnd))
+ (setcar first (or (car first)
+ (car secnd))) ; Keep_flag
+ (setq first (cdr first)
+ secnd (cdr secnd))
+ (setcar first (or (car first)
+ (car secnd))) ; NOV_entry_marker
+
+ (setcdr dlist (cddr dlist)))
+ (setq dlist (cdr dlist)))))
+ (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
+
+ (let* ((len (float (length dlist)))
+ (alist (list nil))
+ (tail-alist alist))
+ (while dlist
+ (let ((new-completed (truncate (* 100.0
+ (/ (setq cnt (1+ cnt))
+ len))))
message-log-max)
- (when (> new-completed completed)
- (setq completed new-completed)
- (gnus-message 7 "%3d%% completed..." completed)))
- (let* ((entry (car dlist))
- (article-number (nth 0 entry))
- (fetch-date (nth 1 entry))
- (keep (nth 2 entry))
- (marker (nth 3 entry)))
-
- (cond
- ;; Kept articles are unread, marked, or special.
- (keep
- (gnus-agent-message 10
- "gnus-agent-expire: %s:%d: Kept %s article%s."
- group article-number keep (if fetch-date " and file" ""))
- (when fetch-date
- (unless (file-exists-p
- (concat dir (number-to-string
- article-number)))
- (setf (nth 1 entry) nil)
- (gnus-agent-message 3 "gnus-agent-expire cleared \
+ (when (> new-completed completed)
+ (setq completed new-completed)
+ (gnus-message 7 "%3d%% completed..." completed)))
+ (let* ((entry (car dlist))
+ (article-number (nth 0 entry))
+ (fetch-date (nth 1 entry))
+ (keep (nth 2 entry))
+ (marker (nth 3 entry)))
+
+ (cond
+ ;; Kept articles are unread, marked, or special.
+ (keep
+ (gnus-agent-message 10
+ "gnus-agent-expire: %s:%d: Kept %s article%s."
+ group article-number keep (if fetch-date " and file" ""))
+ (when fetch-date
+ (unless (file-exists-p
+ (concat dir (number-to-string
+ article-number)))
+ (setf (nth 1 entry) nil)
+ (gnus-agent-message 3 "gnus-agent-expire cleared \
download flag on %s:%d as the cached article file is missing."
- group (caar dlist)))
- (unless marker
- (gnus-message 1 "gnus-agent-expire detected a \
+ group (caar dlist)))
+ (unless marker
+ (gnus-message 1 "gnus-agent-expire detected a \
missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
- (gnus-agent-append-to-list
- tail-alist
- (cons article-number fetch-date)))
-
- ;; The following articles are READ, UNMARKED, and
- ;; ORDINARY. See if they can be EXPIRED!!!
- ((setq type
- (cond
- ((not (integerp fetch-date))
- 'read) ;; never fetched article (may expire
- ;; right now)
- ((not (file-exists-p
- (concat dir (number-to-string
- article-number))))
- (setf (nth 1 entry) nil)
- 'externally-expired) ;; Can't find the cached
- ;; article. Handle case
- ;; as though this article
- ;; was never fetched.
-
- ;; We now have the arrival day, so we see
- ;; whether it's old enough to be expired.
- ((< fetch-date day)
- 'expired)
- (force
- 'forced)))
-
- ;; I found some reason to expire this entry.
-
- (let ((actions nil))
- (when (memq type '(forced expired))
- (ignore-errors ; Just being paranoid.
- (let ((file-name (concat dir (number-to-string
- article-number))))
- (incf (nth 2 stats) (nth 7 (file-attributes file-name)))
- (incf (nth 1 stats))
- (delete-file file-name))
- (push "expired cached article" actions))
- (setf (nth 1 entry) nil)
- )
-
- (when marker
- (push "NOV entry removed" actions)
- (goto-char marker)
-
- (incf (nth 0 stats))
-
- (let ((from (gnus-point-at-bol))
- (to (progn (forward-line 1) (point))))
- (incf (nth 2 stats) (- to from))
- (delete-region from to)))
-
- ;; If considering all articles is set, I can only
- ;; expire article IDs that are no longer in the
- ;; active range (That is, articles that preceed the
- ;; first article in the new alist).
- (if (and gnus-agent-consider-all-articles
- (>= article-number (car active)))
- ;; I have to keep this ID in the alist
- (gnus-agent-append-to-list
- tail-alist (cons article-number fetch-date))
- (push (format "Removed %s article number from \
+ (gnus-agent-append-to-list
+ tail-alist
+ (cons article-number fetch-date)))
+
+ ;; The following articles are READ, UNMARKED, and
+ ;; ORDINARY. See if they can be EXPIRED!!!
+ ((setq type
+ (cond
+ ((not (integerp fetch-date))
+ 'read) ;; never fetched article (may expire
+ ;; right now)
+ ((not (file-exists-p
+ (concat dir (number-to-string
+ article-number))))
+ (setf (nth 1 entry) nil)
+ 'externally-expired) ;; Can't find the cached
+ ;; article. Handle case
+ ;; as though this article
+ ;; was never fetched.
+
+ ;; We now have the arrival day, so we see
+ ;; whether it's old enough to be expired.
+ ((< fetch-date day)
+ 'expired)
+ (force
+ 'forced)))
+
+ ;; I found some reason to expire this entry.
+
+ (let ((actions nil))
+ (when (memq type '(forced expired))
+ (ignore-errors ; Just being paranoid.
+ (let* ((file-name (nnheader-concat dir (number-to-string
+ article-number)))
+ (size (float (nth 7 (file-attributes file-name)))))
+ (incf bytes-freed size)
+ (incf files-deleted)
+ (delete-file file-name))
+ (push "expired cached article" actions))
+ (setf (nth 1 entry) nil)
+ )
+
+ (when marker
+ (push "NOV entry removed" actions)
+ (goto-char marker)
+
+ (incf nov-entries-deleted)
+
+ (let ((from (gnus-point-at-bol))
+ (to (progn (forward-line 1) (point))))
+ (incf bytes-freed (- to from))
+ (delete-region from to)))
+
+ ;; If considering all articles is set, I can only
+ ;; expire article IDs that are no longer in the
+ ;; active range (That is, articles that preceed the
+ ;; first article in the new alist).
+ (if (and gnus-agent-consider-all-articles
+ (>= article-number (car active)))
+ ;; I have to keep this ID in the alist
+ (gnus-agent-append-to-list
+ tail-alist (cons article-number fetch-date))
+ (push (format "Removed %s article number from \
article alist" type) actions))
(when actions
(gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
group article-number
(mapconcat 'identity actions ", ")))))
- (t
- (gnus-agent-message
- 10 "gnus-agent-expire: %s:%d: Article kept as \
+ (t
+ (gnus-agent-message
+ 10 "gnus-agent-expire: %s:%d: Article kept as \
expiration tests failed." group article-number)
- (gnus-agent-append-to-list
- tail-alist (cons article-number fetch-date)))
- )
-
- ;; Clean up markers as I want to recycle this buffer
- ;; over several groups.
- (when marker
- (set-marker marker nil))
-
- (setq dlist (cdr dlist))))
-
- (setq alist (cdr alist))
-
- (let ((inhibit-quit t))
- (unless (equal alist gnus-agent-article-alist)
- (setq gnus-agent-article-alist alist)
- (gnus-agent-save-alist group))
-
- (when (buffer-modified-p)
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (gnus-make-directory dir)
- (write-region (point-min) (point-max) nov-file nil
- 'silent)
- ;; clear the modified flag as that I'm not confused by
- ;; its status on the next pass through this routine.
- (set-buffer-modified-p nil)))
-
- (when (eq articles t)
- (gnus-summary-update-info))))))))
+ (gnus-agent-append-to-list
+ tail-alist (cons article-number fetch-date)))
+ )
+
+ ;; Clean up markers as I want to recycle this buffer
+ ;; over several groups.
+ (when marker
+ (set-marker marker nil))
+
+ (setq dlist (cdr dlist))))
+
+ (setq alist (cdr alist))
+
+ (let ((inhibit-quit t))
+ (unless (equal alist gnus-agent-article-alist)
+ (setq gnus-agent-article-alist alist)
+ (gnus-agent-save-alist group))
+
+ (when (buffer-modified-p)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-make-directory dir)
+ (write-region (point-min) (point-max) nov-file nil
+ 'silent)
+ ;; clear the modified flag as that I'm not confused by
+ ;; its status on the next pass through this routine.
+ (set-buffer-modified-p nil)))
+
+ (when (eq articles t)
+ (gnus-summary-update-info))))
+
+ (when (boundp 'gnus-agent-expire-stats)
+ (let ((stats (symbol-value 'gnus-agent-expire-stats)))
+ (incf (nth 2 stats) bytes-freed)
+ (incf (nth 1 stats) files-deleted)
+ (incf (nth 0 stats) nov-entries-deleted)))
+ ))))
(defun gnus-agent-expire (&optional articles group force)
"Expire all old articles.
(defun gnus-agent-uncached-articles (articles group &optional cached-header)
"Restrict ARTICLES to numbers already fetched.
-Returns a sublist of ARTICLES that excludes thos article ids in GROUP
+Returns a sublist of ARTICLES that excludes those article ids in GROUP
that have already been fetched.
If CACHED-HEADER is nil, articles are only excluded if the article itself
has been fetched."
;; Get the list of articles that were fetched
(goto-char (point-min))
- (let ((pm (point-max)))
+ (let ((pm (point-max))
+ art)
(while (< (point) pm)
- (when (looking-at "[0-9]+\t")
- (gnus-agent-append-to-list
- tail-fetched-articles
- (read (current-buffer))))
+ (when (setq art (gnus-agent-read-article-number))
+ (gnus-agent-append-to-list tail-fetched-articles art))
(forward-line 1)))
;; Clip this list to the headers that will
(set-buffer nntp-server-buffer)
(copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
- ;; Merge the temp buffer with the known headers (found on
- ;; disk in FILE) into the nntp-server-buffer
- (when (and uncached-articles (file-exists-p file))
+ ;; Merge the temp buffer with the known headers (found on
+ ;; disk in FILE) into the nntp-server-buffer
+ (when uncached-articles
(gnus-agent-braid-nov group uncached-articles file))
- ;; Save the new set of known headers to FILE
+ ;; Save the new set of known headers to FILE
(set-buffer nntp-server-buffer)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
(gnus-message 3 "Ignoring unexpected input")
(sit-for 1)
t)))))
-
(when group
(gnus-message 5 "Regenerating in %s" group)
(let* ((gnus-command-method (or gnus-command-method
(gnus-delete-line)
(setq nov-arts (cdr nov-arts))
(gnus-message 4 "gnus-agent-regenerate-group: NOV\
-entry of article %s deleted." l1))
+ entry of article %s deleted." l1))
((not l2)
nil)
((< l1 l2)
gnus-agent-article-alist))))
(when (gnus-buffer-live-p gnus-group-buffer)
- (gnus-group-update-group group t)
- (sit-for 0)))
+ (gnus-group-update-group group t)))
- (gnus-message 5 nil)
+ (gnus-message 5 "")
regenerated)))
;;;###autoload
(defun gnus-agent-group-covered-p (group)
(gnus-agent-method-p (gnus-group-method group)))
-(add-hook 'gnus-group-prepare-hook
- (lambda ()
- 'gnus-agent-do-once
-
- (when (listp gnus-agent-expire-days)
- (beep)
- (beep)
- (gnus-message 1 "WARNING: gnus-agent-expire-days no longer\
- supports being set to a list.")(sleep-for 3)
- (gnus-message 1 "Change your configuration to set it to an\
- integer.")(sleep-for 3)
- (gnus-message 1 "I am now setting group parameters on each\
- group to match the configuration that the list offered.")
-
- (save-excursion
- (let ((groups (gnus-group-listed-groups)))
- (while groups
- (let* ((group (pop groups))
- (days gnus-agent-expire-days)
- (day (catch 'found
- (while days
- (when (eq 0 (string-match
- (caar days)
- group))
- (throw 'found (cadar days)))
- (setq days (cdr days)))
- nil)))
- (when day
- (gnus-group-set-parameter group 'agent-days-until-old
- day))))))
-
- (let ((h gnus-group-prepare-hook))
- (while h
- (let ((func (pop h)))
- (when (and (listp func)
- (eq (cadr (caddr func)) 'gnus-agent-do-once))
- (remove-hook 'gnus-group-prepare-hook func)
- (setq h nil)))))
-
- (gnus-message 1 "I have finished setting group parameters on\
- each group. You may now customize your groups and/or topics to control the\
- agent."))))
-
(provide 'gnus-agent)
;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
(or (not gnus-uncacheable-groups)
(not (string-match gnus-uncacheable-groups group)))))))
+;;;###autoload
+(defun gnus-cache-rename-group (old-group new-group)
+ "Rename OLD-GROUP as NEW-GROUP. Always updates the cache, even when
+disabled, as the old cache files would corrupt gnus when the cache was
+next enabled. Depends upon the caller to determine whether group renaming is supported."
+ (let ((old-dir (gnus-cache-file-name old-group ""))
+ (new-dir (gnus-cache-file-name new-group "")))
+ (gnus-rename-file old-dir new-dir t))
+
+ (let ((no-save gnus-cache-active-hashtb))
+ (unless gnus-cache-active-hashtb
+ (gnus-cache-read-active))
+ (let* ((old-group-hash-value (gnus-gethash old-group gnus-cache-active-hashtb))
+ (new-group-hash-value (gnus-gethash new-group gnus-cache-active-hashtb))
+ (delta (or old-group-hash-value new-group-hash-value)))
+ (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)
+ (gnus-sethash old-group nil gnus-cache-active-hashtb)
+
+ (if no-save
+ (setq gnus-cache-active-altered delta)
+ (gnus-cache-write-active delta)))))
+
+;;;###autoload
+(defun gnus-cache-delete-group (group)
+ "Delete GROUP. Always updates the cache, even when
+disabled, as the old cache files would corrupt gnus when the cache was
+next enabled. Depends upon the caller to determine whether group deletion is supported."
+ (let ((dir (gnus-cache-file-name group "")))
+ (gnus-delete-file dir))
+
+ (let ((no-save gnus-cache-active-hashtb))
+ (unless gnus-cache-active-hashtb
+ (gnus-cache-read-active))
+ (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))
+ (gnus-sethash group nil gnus-cache-active-hashtb)
+
+ (if no-save
+ (setq gnus-cache-active-altered group-hash-value)
+ (gnus-cache-write-active group-hash-value)))))
+
(provide 'gnus-cache)
;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
(defun gnus-draft-send (article &optional group interactive)
"Send message ARTICLE."
- (let ((message-syntax-checks (if interactive message-syntax-checks
- 'dont-check-for-anything-just-trust-me))
- (message-hidden-headers nil)
- (message-inhibit-body-encoding (or (not group)
- (equal group "nndraft:queue")
- message-inhibit-body-encoding))
- (message-send-hook (and group (not (equal group "nndraft:queue"))
- message-send-hook))
- (message-setup-hook (and group (not (equal group "nndraft:queue"))
- message-setup-hook))
- type method move-to)
+ (let* ((is-queue (or (not group)
+ (equal group "nndraft:queue")))
+ (message-syntax-checks (if interactive message-syntax-checks
+ 'dont-check-for-anything-just-trust-me))
+ (message-hidden-headers nil)
+ (message-inhibit-body-encoding (or is-queue
+ message-inhibit-body-encoding))
+ (message-send-hook (and (not is-queue)
+ message-send-hook))
+ (message-setup-hook (and (not is-queue)
+ message-setup-hook))
+ (gnus-agent-queue-mail (and (not is-queue)
+ gnus-agent-queue-mail))
+ (rfc2047-encode-encoded-words nil)
+ type method move-to)
(gnus-draft-setup article (or group "nndraft:queue"))
;; We read the meta-information that says how and where
;; this message is to be sent.
(defun gnus-group-send-queue ()
"Send all sendable articles from the queue group."
(interactive)
- (gnus-activate-group "nndraft:queue")
- (save-excursion
- (let* ((articles (nndraft-articles))
- (unsendable (gnus-uncompress-range
- (cdr (assq 'unsend
- (gnus-info-marks
- (gnus-get-info "nndraft:queue"))))))
- (gnus-posting-styles nil)
- (total (length articles))
- article)
- (while (setq article (pop articles))
- (unless (memq article unsendable)
- (let ((message-sending-message
- (format "Sending message %d of %d..."
- (- total (length articles)) total)))
- (gnus-draft-send article)))))))
+ (when (or gnus-plugged
+ (not gnus-agent-prompt-send-queue)
+ (gnus-y-or-n-p "Gnus is unplugged; really send queue? "))
+ (gnus-activate-group "nndraft:queue")
+ (save-excursion
+ (let* ((articles (nndraft-articles))
+ (unsendable (gnus-uncompress-range
+ (cdr (assq 'unsend
+ (gnus-info-marks
+ (gnus-get-info "nndraft:queue"))))))
+ (gnus-posting-styles nil)
+ (total (length articles))
+ article)
+ (while (setq article (pop articles))
+ (unless (memq article unsendable)
+ (let ((message-sending-message
+ (format "Sending message %d of %d..."
+ (- total (length articles)) total)))
+ (gnus-draft-send article))))))))
;;;###autoload
(defun gnus-draft-reminder ()
`(lambda (arg)
(gnus-post-method arg ,(car ga))))
(unless (equal (cadr ga) "")
- (message-add-action
- `(progn
- (gnus-add-mark ,(car ga) 'replied ,(cadr ga))
- (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga))
- 'add '(reply)))))
- 'send))))))
+ (dolist (article (cdr ga))
+ (message-add-action
+ `(progn
+ (gnus-add-mark ,(car ga) 'replied ,article)
+ (gnus-request-set-mark ,(car ga) (list (list (list ,article)
+ 'add '(reply)))))
+ 'send)))))))
(defun gnus-draft-article-sendable-p (article)
"Say whether ARTICLE is sendable."
(eval-when-compile (require 'mm-url))
(defcustom gnus-group-archive-directory
- "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
+ "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"*The address of the (ding) archives."
:group 'gnus-group-foreign
:type 'directory)
(defcustom gnus-group-recent-archive-directory
- "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
+ "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
"*The address of the most recent (ding) articles."
:group 'gnus-group-foreign
:type 'directory)
(lambda (group)
(gnus-group-delete-group group nil t))))))
-(defvar gnus-cache-active-altered)
-
(defun gnus-group-delete-group (group &optional force no-prompt)
"Delete the current group. Only meaningful with editable groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-sethash group nil gnus-active-hashtb)
- (if (boundp 'gnus-cache-active-hashtb)
- (when gnus-cache-active-hashtb
- (gnus-sethash group nil gnus-cache-active-hashtb)
- (setq gnus-cache-active-altered t)))
t))
(gnus-group-position-point)))
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
(num (car entry))
(marks (nth 3 (nth 2 entry)))
- (unread (gnus-list-of-unread-articles group)))
+ (unread (gnus-sequence-of-unread-articles group)))
;; Remove entries for this group.
(nnmail-purge-split-history (gnus-group-real-name group))
;; Do the updating only if the newsgroup isn't killed.
'del '(tick))
(list (cdr (assq 'dormant marks))
'del '(dormant))))
- (setq unread (gnus-uncompress-range
- (gnus-range-add (gnus-range-add
- unread (cdr (assq 'dormant marks)))
- (cdr (assq 'tick marks)))))
+ (setq unread (gnus-range-add (gnus-range-add
+ unread (cdr (assq 'dormant marks)))
+ (cdr (assq 'tick marks))))
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
(when (gnus-group-auto-expirable-p group)
- (gnus-add-marked-articles group 'expire unread)
- (gnus-request-set-mark group (list (list unread 'add '(expire)))))
+ (gnus-range-map (lambda (article)
+ (gnus-add-marked-articles group 'expire (list article))
+ (gnus-request-set-mark group (list (list (list article) 'add '(expire)))))
+ unread))
(let ((gnus-newsgroup-name group))
(gnus-run-hooks 'gnus-group-catchup-group-hook))
num)))
;; First we make sure that we have really read the active file.
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t)
- (gnus-agent nil)) ; Trick the agent into ignoring the active file.
+ (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
(gnus-read-active-file)))
;; Find all groups and sort them.
(let ((groups
(require 'gnus-range)
(autoload 'gnus-agent-expire "gnus-agent")
+(autoload 'gnus-agent-regenerate-group "gnus-agent")
(autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
(defcustom gnus-open-server-hook nil
(setq method (gnus-server-to-method method)))
;; Check cache of constructed names.
(let* ((method-sym (if gnus-agent
- (gnus-agent-get-function method)
+ (inline (gnus-agent-get-function method))
(car method)))
(method-fns (get method-sym 'gnus-method-functions))
(func (let ((method-fnlist-elt (assq function method-fns)))
(nth 1 gnus-command-method) accept-function last)))
(when (and result gnus-agent
(gnus-agent-method-p gnus-command-method))
- (gnus-agent-expire (list article) group 'force))
+ (gnus-agent-unfetch-articles group (list article)))
result))
(defun gnus-request-accept-article (group &optional gnus-command-method last
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (and (not gnus-command-method)
(stringp group))
- (setq gnus-command-method (gnus-group-name-to-method group)))
+ (setq gnus-command-method (or (gnus-find-method-for-group group)
+ (gnus-group-name-to-method group))))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer)))
(message-encode-message-body)))
- (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)))
+(let ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group)))
+ (result
+ (funcall
+ (gnus-get-function gnus-command-method 'request-accept-article)
+ (if (stringp group) (gnus-group-real-name group) group)
+ (cadr gnus-command-method)
+ last)))
+ (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
+ (gnus-agent-regenerate-group group (list (cdr result))))
+ result))
(defun gnus-request-replace-article (article group buffer &optional no-encode)
(unless no-encode
(let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer)))
(message-encode-message-body)))
- (let ((func (car (gnus-group-name-to-method group))))
- (funcall (intern (format "%s-request-replace-article" func))
- article (gnus-group-real-name group) buffer)))
+ (let* ((func (car (gnus-group-name-to-method group)))
+ (result (funcall (intern (format "%s-request-replace-article" func))
+ article (gnus-group-real-name group) buffer)))
+ (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
+ (gnus-agent-regenerate-group group (list article)))
+ result))
(defun gnus-request-associate-buffer (group)
(let ((gnus-command-method (gnus-find-method-for-group group)))
(gnus-group-real-name group) (nth 1 gnus-command-method) args)))
(defun gnus-request-delete-group (group &optional force)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-delete-group)
- (gnus-group-real-name group) force (nth 1 gnus-command-method))))
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (result
+ (funcall (gnus-get-function gnus-command-method 'request-delete-group)
+ (gnus-group-real-name group) force (nth 1 gnus-command-method))))
+ (when result
+ (gnus-cache-delete-group group)
+ (gnus-agent-delete-group group))
+ result))
(defun gnus-request-rename-group (group new-name)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-rename-group)
- (gnus-group-real-name group)
- (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (result
+ (funcall (gnus-get-function gnus-command-method 'request-rename-group)
+ (gnus-group-real-name group)
+ (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
+ (when result
+ (gnus-cache-rename-group group new-name)
+ (gnus-agent-rename-group group new-name))
+ result))
(defun gnus-close-backends ()
;; Send a close request to all backends that support such a request.
;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(setq list2 (cdr list2)))))
(nreverse out)))
+;;;###autoload
+(defun gnus-sorted-range-intersection (range1 range2)
+ "Return intersection of RANGE1 and RANGE2.
+RANGE1 and RANGE2 have to be sorted over <."
+ (let* (out
+ (min1 (car range1))
+ (max1 (if (numberp min1)
+ (if (numberp (cdr range1))
+ (prog1 (cdr range1)
+ (setq range1 nil)) min1)
+ (prog1 (cdr min1)
+ (setq min1 (car min1)))))
+ (min2 (car range2))
+ (max2 (if (numberp min2)
+ (if (numberp (cdr range2))
+ (prog1 (cdr range2)
+ (setq range2 nil)) min2)
+ (prog1 (cdr min2)
+ (setq min2 (car min2))))))
+ (setq range1 (cdr range1)
+ range2 (cdr range2))
+ (while (and min1 min2)
+ (cond ((< max1 min2) ; range1 preceeds range2
+ (setq range1 (cdr range1)
+ min1 nil))
+ ((< max2 min1) ; range2 preceeds range1
+ (setq range2 (cdr range2)
+ min2 nil))
+ (t ; some sort of overlap is occurring
+ (let ((min (max min1 min2))
+ (max (min max1 max2)))
+ (setq out (if (= min max)
+ (cons min out)
+ (cons (cons min max) out))))
+ (if (< max1 max2) ; range1 ends before range2
+ (setq min1 nil) ; incr range1
+ (setq min2 nil)))) ; incr range2
+ (unless min1
+ (setq min1 (car range1)
+ max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1))))
+ range1 (cdr range1)))
+ (unless min2
+ (setq min2 (car range2)
+ max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
+ range2 (cdr range2))))
+ (cond ((cdr out)
+ (nreverse out))
+ ((numberp (car out))
+ out)
+ (t
+ (car out)))))
+
;;;###autoload
(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
(setcdr prev (cons num list)))
(cdr top)))
+(defun gnus-range-map (func range)
+ "Apply FUNC to each value contained by RANGE."
+ (setq range (gnus-range-normalize range))
+ (while range
+ (let ((span (pop range)))
+ (if (numberp span)
+ (funcall func span)
+ (let ((first (car span))
+ (last (cdr span)))
+ (while (<= first last)
+ (funcall func first)
+ (setq first (1+ first))))))))
+
(provide 'gnus-range)
;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad
;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'gnus-util)
(autoload 'message-make-date "message")
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
+(autoload 'gnus-agent-save-local "gnus-agent")
(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
-(eval-when-compile (require 'cl))
+
+(eval-when-compile
+ (require 'cl)
+
+ (defvar gnus-agent-covered-methods nil)
+ (defvar gnus-agent-file-loading-local nil)
+ (defvar gnus-agent-file-loading-cache nil))
(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
"Your `.newsrc' file.
(setq gnus-list-of-killed-groups nil
gnus-have-read-active-file nil
gnus-agent-covered-methods nil
+ gnus-agent-file-loading-local nil
+ gnus-agent-file-loading-cache nil
gnus-server-method-cache nil
gnus-newsrc-alist nil
gnus-newsrc-hashtb nil
(gnus-active group))
(gnus-active group)
+ ;; If a cache is present, we may have to alter the active info.
+ (when gnus-use-cache
+ (inline (gnus-cache-possibly-alter-active
+ group active)))
+
+ ;; If the agent is enabled, we may have to alter the active info.
+ (when gnus-agent
+ (gnus-agent-possibly-alter-active group active))
+
(gnus-set-active group active)
;; Return the new active info.
active)))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
- (when active
+ (when (and info active)
;; Allow the backend to update the info in the group.
(when (and update
(gnus-request-update-info
(let* ((range (gnus-info-read info))
(num 0))
+
+ ;; These checks are present in gnus-activate-group but skipped
+ ;; due to setting dont-check in the preceeding call.
+
;; If a cache is present, we may have to alter the active info.
(when (and gnus-use-cache info)
(inline (gnus-cache-possibly-alter-active
;; If the agent is enabled, we may have to alter the active info.
(when (and gnus-agent info)
- (gnus-agent-possibly-alter-active
- (gnus-info-group info) active))
+ (gnus-agent-possibly-alter-active (gnus-info-group info) active info))
;; Modify the list of read articles according to what articles
;; are available; then tally the unread articles and add the
(while newsrc
(setq active (gnus-active (setq group (gnus-info-group
- (setq info (pop newsrc))))))
+ (setq info (pop newsrc))))))
;; Check newsgroups. If the user doesn't want to check them, or
;; they can't be checked (for instance, if the news server can't
(when (and method
(not (setq method-type (cdr (assoc method type-cache)))))
(setq method-type
- (cond
- ((gnus-secondary-method-p method)
- 'secondary)
- ((inline (gnus-server-equal gnus-select-method method))
- 'primary)
- (t
- 'foreign)))
+ (cond
+ ((gnus-secondary-method-p method)
+ 'secondary)
+ ((inline (gnus-server-equal gnus-select-method method))
+ 'primary)
+ (t
+ 'foreign)))
(push (cons method method-type) type-cache))
- (if (and method
- (eq method-type 'foreign))
- ;; These groups are foreign. Check the level.
- (when (and (<= (gnus-info-level info) foreign-level)
- (setq active (gnus-activate-group group 'scan)))
- ;; Let the Gnus agent save the active file.
- (when (and gnus-agent active (gnus-online method))
- (gnus-agent-save-group-info
- method (gnus-group-real-name group) active))
- (unless (inline (gnus-virtual-group-p group))
- (inline (gnus-close-group group)))
- (when (fboundp (intern (concat (symbol-name (car method))
- "-request-update-info")))
- (inline (gnus-request-update-info info method))))
- ;; These groups are native or secondary.
- (cond
- ;; We don't want these groups.
- ((> (gnus-info-level info) level)
- (setq active 'ignore))
- ;; Activate groups.
- ((not gnus-read-active-file)
- (if (gnus-check-backend-function 'retrieve-groups group)
- ;; if server support gnus-retrieve-groups we push
- ;; the group onto retrievegroups for later checking
- (if (assoc method retrieve-groups)
- (setcdr (assoc method retrieve-groups)
- (cons group (cdr (assoc method retrieve-groups))))
- (push (list method group) retrieve-groups))
- ;; hack: `nnmail-get-new-mail' changes the mail-source depending
- ;; on the group, so we must perform a scan for every group
- ;; if the users has any directory mail sources.
- ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
- ;; for it scan all spool files even when the groups are
- ;; not required.
- (if (and
- (or nnmail-scan-directory-mail-source-once
- (null (assq 'directory
- (or mail-sources
- (if (listp nnmail-spool-file)
- nnmail-spool-file
- (list nnmail-spool-file))))))
- (member method scanned-methods))
- (setq active (gnus-activate-group group))
- (setq active (gnus-activate-group group 'scan))
- (push method scanned-methods))
- (when active
- (gnus-close-group group))))))
+
+ (cond ((and method (eq method-type 'foreign))
+ ;; These groups are foreign. Check the level.
+ (when (and (<= (gnus-info-level info) foreign-level)
+ (setq active (gnus-activate-group group 'scan)))
+ ;; Let the Gnus agent save the active file.
+ (when (and gnus-agent active (gnus-online method))
+ (gnus-agent-save-group-info
+ method (gnus-group-real-name group) active))
+ (unless (inline (gnus-virtual-group-p group))
+ (inline (gnus-close-group group)))
+ (when (fboundp (intern (concat (symbol-name (car method))
+ "-request-update-info")))
+ (inline (gnus-request-update-info info method)))))
+ ;; These groups are native or secondary.
+ ((> (gnus-info-level info) level)
+ ;; We don't want these groups.
+ (setq active 'ignore))
+ ;; Activate groups.
+ ((not gnus-read-active-file)
+ (if (gnus-check-backend-function 'retrieve-groups group)
+ ;; if server support gnus-retrieve-groups we push
+ ;; the group onto retrievegroups for later checking
+ (if (assoc method retrieve-groups)
+ (setcdr (assoc method retrieve-groups)
+ (cons group (cdr (assoc method retrieve-groups))))
+ (push (list method group) retrieve-groups))
+ ;; hack: `nnmail-get-new-mail' changes the mail-source depending
+ ;; on the group, so we must perform a scan for every group
+ ;; if the users has any directory mail sources.
+ ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
+ ;; for it scan all spool files even when the groups are
+ ;; not required.
+ (if (and
+ (or nnmail-scan-directory-mail-source-once
+ (null (assq 'directory
+ (or mail-sources
+ (if (listp nnmail-spool-file)
+ nnmail-spool-file
+ (list nnmail-spool-file))))))
+ (member method scanned-methods))
+ (setq active (gnus-activate-group group))
+ (setq active (gnus-activate-group group 'scan))
+ (push method scanned-methods))
+ (when active
+ (gnus-close-group group)))))
;; Get the number of unread articles in the group.
(cond
(when (gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan nil method))
(gnus-read-active-file-2
- (mapcar (lambda (group) (gnus-group-real-name group)) groups)
- method)
+ (mapcar (lambda (group) (gnus-group-real-name group)) groups)
+ method)
(dolist (group groups)
(cond
((setq active (gnus-active (gnus-info-group
(while (setq info (pop newsrc))
(when (inline
(gnus-server-equal
- (inline
- (gnus-find-method-for-group
- (gnus-info-group info) info))
- gmethod))
+ (inline
+ (gnus-find-method-for-group
+ (gnus-info-group info) info))
+ gmethod))
(push (gnus-group-real-name (gnus-info-group info))
groups)))
(gnus-read-active-file-2 groups method)))
(gnus-online method)
(gnus-agent-method-p method))
(progn
- (gnus-agent-save-groups method)
+ (gnus-agent-save-active method)
(gnus-active-to-gnus-format method hashtb nil real-active))
(goto-char (point-min))
(gnus-convert-old-newsrc))))
(defun gnus-convert-old-newsrc ()
- "Convert old newsrc into the new format, if needed."
+ "Convert old newsrc formats into the current format, if needed."
(let ((fcv (and gnus-newsrc-file-version
(gnus-continuum-version gnus-newsrc-file-version))))
- (cond
- ;; No .newsrc.eld file was loaded.
- ((null fcv) nil)
- ;; Gnus 5 .newsrc.eld was loaded.
- ((< fcv (gnus-continuum-version "September Gnus v0.1"))
- (gnus-convert-old-ticks)))))
-
-(defun gnus-convert-old-ticks ()
+ (when fcv
+ ;; A newsrc file was loaded.
+ (let (prompt-displayed
+ (converters
+ (sort
+ (mapcar (lambda (date-func)
+ (cons (gnus-continuum-version (car date-func))
+ date-func))
+ ;; This is a list of converters that must be run
+ ;; to bring the newsrc file up to the current
+ ;; version. If you create an incompatibility
+ ;; with older versions, you should create an
+ ;; entry here. The entry should consist of the
+ ;; current gnus version (hardcoded so that it
+ ;; doesn't change with each release) and the
+ ;; function that must be applied to convert the
+ ;; previous version into the current version.
+ '(("September Gnus v0.1" nil
+ gnus-convert-old-ticks)
+ ("Oort Gnus v0.08" "legacy-gnus-agent"
+ gnus-agent-convert-to-compressed-agentview)
+ ("No Gnus v0.2" "legacy-gnus-agent"
+ gnus-agent-unlist-expire-days)
+ ("No Gnus v0.2" "legacy-gnus-agent"
+ gnus-agent-unhook-expire-days)))
+ #'car-less-than-car)))
+ ;; Skip converters older than the file version
+ (while (and converters (>= fcv (caar converters)))
+ (pop converters))
+
+ ;; Perform converters to bring older version up to date.
+ (when (and converters (< fcv (caar converters)))
+ (while (and converters (< fcv (caar converters)))
+ (let* ((converter-spec (pop converters))
+ (convert-to (nth 1 converter-spec))
+ (load-from (nth 2 converter-spec))
+ (func (nth 3 converter-spec)))
+ (when (and load-from
+ (not (fboundp func)))
+ (load load-from t))
+
+ (or prompt-displayed
+ (not (gnus-convert-converter-needs-prompt func))
+ (while (let (c
+ (cursor-in-echo-area t)
+ (echo-keystrokes 0))
+ (message "Convert gnus from version '%s' to '%s'? (n/y/?)"
+ gnus-newsrc-file-version gnus-version)
+ (setq c (read-char-exclusive))
+
+ (cond ((or (eq c ?n) (eq c ?N))
+ (error "Can not start gnus without converting"))
+ ((or (eq c ?y) (eq c ?Y))
+ (setq prompt-displayed t)
+ nil)
+ ((eq c ?\?)
+ (message "This conversion is irreversible. \
+ To be safe, you should backup your files before proceeding.")
+ (sit-for 5)
+ t)
+ (t
+ (gnus-message 3 "Ignoring unexpected input")
+ (sit-for 3)
+ t)))))
+
+ (funcall func convert-to)))
+ (gnus-dribble-enter
+ (format ";Converted gnus from version '%s' to '%s'."
+ gnus-newsrc-file-version gnus-version)))))))
+
+(defun gnus-convert-mark-converter-prompt (converter no-prompt)
+ "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
+ display the conversion prompt. NO-PROMPT may be nil (prompt),
+ t (no prompt), or any form that can be called as a function.
+ The form should return either t or nil."
+ (put converter 'gnus-convert-no-prompt no-prompt))
+
+(defun gnus-convert-converter-needs-prompt (converter)
+ (let ((no-prompt (get converter 'gnus-convert-no-prompt)))
+ (not (if (memq no-prompt '(t nil))
+ no-prompt
+ (funcall no-prompt)))))
+
+(defun gnus-convert-old-ticks (converting-to)
(let ((newsrc (cdr gnus-newsrc-alist))
marks info dormant ticked)
(while (setq info (pop newsrc))
;; from the variable gnus-newsrc-alist.
(when (and (or gnus-newsrc-alist gnus-killed-list)
gnus-current-startup-file)
+ ;; Save agent range limits for the currently active method.
+ (when gnus-agent
+ (gnus-agent-save-local force))
+
(save-excursion
(if (and (or gnus-use-dribble-file gnus-slave)
(not force)
(gnus-message 8 "Saving %s..." gnus-current-startup-file)
(gnus-gnus-to-newsrc-format)
(gnus-message 8 "Saving %s...done" gnus-current-startup-file))
+
;; Save .newsrc.eld.
(set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
(make-local-variable 'version-control)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec)
- (gnus-newsgroup-downloadable '(0)))
+ (gnus-newsgroup-downloadable '(0))
+ marks)
+ (insert ?\200 "\200" ?\201 "\201" ?\202 "\202" ?\203 "\203")
+ (while (not (bobp))
+ (push (buffer-substring (1- (point)) (point)) marks)
+ (backward-char))
+ (erase-buffer)
(gnus-summary-insert-line
[0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
0 nil t 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread
- (and (search-forward
- (mm-string-as-multibyte "\200") nil t)
+ (and (or (search-forward (nth 0 marks) nil t)
+ (search-forward (nth 1 marks) nil t))
(- (point) (point-min) 1)))))
(goto-char (point-min))
- (push (cons 'replied (and (search-forward
- (mm-string-as-multibyte "\201") nil t)
+ (push (cons 'replied (and (or (search-forward (nth 2 marks) nil t)
+ (search-forward (nth 3 marks) nil t))
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
- (push (cons 'score (and (search-forward
- (mm-string-as-multibyte "\202") nil t)
+ (push (cons 'score (and (or (search-forward (nth 4 marks) nil t)
+ (search-forward (nth 5 marks) nil t))
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
- (push (cons 'download (and (search-forward
- (mm-string-as-multibyte "\203") nil t)
+ (push (cons 'download (and (or (search-forward (nth 6 marks) nil t)
+ (search-forward (nth 7 marks) nil t))
(- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
group (gnus-status-message group)))
(when gnus-agent
- ;; The agent may be storing articles that are no longer in the
- ;; server's active range. If that is the case, the active range
- ;; needs to be expanded such that the agent's articles can be
- ;; included in the summary.
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (alist (gnus-agent-load-alist group))
- (active (gnus-active group)))
- (if (and (car alist)
- (< (caar alist) (car active)))
- (gnus-set-active group (cons (caar alist) (cdr active)))))
-
+ (gnus-agent-possibly-alter-active group (gnus-active group) info)
+
(setq gnus-summary-use-undownloaded-faces
(gnus-agent-find-parameter
group
(min (car active))
(max (cdr active))
(types gnus-article-mark-lists)
- marks var articles article mark mark-type)
+ marks var articles article mark mark-type
+ bgn end)
(dolist (marks marked-lists)
(setq mark (car marks)
;; We set the variable according to the type of the marks list,
;; and then adjust the marks to a subset of the active articles.
(cond
- ;; Adjust "simple" lists.
+ ;; Adjust "simple" lists - compressed yet unsorted
((eq mark-type 'list)
- (set var (setq articles (gnus-uncompress-range (cdr marks))))
- (when (memq mark '(tick dormant expire reply save))
- (while articles
- (when (or (< (setq article (pop articles)) min) (> article max))
- (set var (delq article (symbol-value var)))))))
+ ;; Simultaneously uncompress and clip to active range
+ ;; See gnus-uncompress-range for a description of possible marks
+ (let (l lh)
+ (if (not (cadr marks))
+ (set var nil)
+ (setq articles (if (numberp (cddr marks))
+ (list (cdr marks))
+ (cdr marks))
+ lh (cons nil nil)
+ l lh)
+
+ (while (setq article (pop articles))
+ (cond ((consp article)
+ (setq bgn (max (car article) min)
+ end (min (cdr article) max))
+ (while (<= bgn end)
+ (setq l (setcdr l (cons bgn nil))
+ bgn (1+ bgn))))
+ ((and (<= min article)
+ (>= max article))
+ (setq l (setcdr l (cons article nil))))))
+ (set var (cdr lh)))))
;; Adjust assocs.
((eq mark-type 'tuple)
(set var (setq articles (cdr marks)))
(while read
(when first
(while (< first nlast)
- (push first unread)
- (setq first (1+ first))))
+ (setq unread (cons first unread)
+ first (1+ first))))
(setq first (1+ (if (atom (car read)) (car read) (cdar read))))
(setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
(while (<= first last)
- (push first unread)
- (setq first (1+ first)))
+ (setq unread (cons first unread)
+ first (1+ first)))
;; Return the list of unread articles.
(delq 0 (nreverse unread))))
(cdr (assq 'dormant marked)))
(cdr (assq 'tick marked))))))
+;; This function returns a sequence of article numbers based on the
+;; difference between the ranges of read articles in this group and
+;; the range of active articles.
+(defun gnus-sequence-of-unread-articles (group)
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (active (or (gnus-active group) (gnus-activate-group group)))
+ (last (cdr active))
+ first nlast unread)
+ ;; If none are read, then all are unread.
+ (if (not read)
+ (setq first (car active))
+ ;; If the range of read articles is a single range, then the
+ ;; first unread article is the article after the last read
+ ;; article. Sounds logical, doesn't it?
+ (if (and (not (listp (cdr read)))
+ (or (< (car read) (car active))
+ (progn (setq read (list read))
+ nil)))
+ (setq first (max (car active) (1+ (cdr read))))
+ ;; `read' is a list of ranges.
+ (when (/= (setq nlast (or (and (numberp (car read)) (car read))
+ (caar read)))
+ 1)
+ (setq first (car active)))
+ (while read
+ (when first
+ (push (cons first nlast) unread))
+ (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
+ (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
+ (setq read (cdr read)))))
+ ;; And add the last unread articles.
+ (cond ((< first last)
+ (push (cons first last) unread))
+ ((= first last)
+ (push first unread)))
+ ;; Return the sequence of unread articles.
+ (delq 0 (nreverse unread))))
+
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
(default-high gnus-summary-default-high-score)
(default-low gnus-summary-default-low-score)
(uncached (and gnus-summary-use-undownloaded-faces
- (memq article gnus-newsgroup-undownloaded))))
+ (memq article gnus-newsgroup-undownloaded)
+ (not (memq article gnus-newsgroup-cached)))))
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
(eval-when-compile
(require 'cl)
;; Fixme: this should be a gnus variable, not nnmail-.
- (defvar nnmail-pathname-coding-system))
+ (defvar nnmail-pathname-coding-system)
+
+ ;; Inappropriate references to other parts of Gnus.
+ (defvar gnus-emphasize-whitespace-regexp)
+ )
(require 'time-date)
(require 'netrc)
"Delete by side effect any elements of LIST whose car is `equal' to KEY.
The modified LIST is returned. If the first member
of LIST has a car that is `equal' to KEY, there is no way to remove it
-by side effect; therefore, write `(setq foo (remassoc key foo))' to be
+by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be
sure of changing the value of `foo'."
(when alist
(if (equal key (caar alist))
"")))
(t emacs-version))))
+(defun gnus-rename-file (old-path new-path &optional trim)
+ "Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete
+empty directories from OLD-PATH."
+ (when (file-exists-p old-path)
+ (let* ((old-dir (file-name-directory old-path))
+ (old-name (file-name-nondirectory old-path))
+ (new-dir (file-name-directory new-path))
+ (new-name (file-name-nondirectory new-path))
+ temp)
+ (gnus-make-directory new-dir)
+ (rename-file old-path new-path t)
+ (when trim
+ (while (progn (setq temp (directory-files old-dir))
+ (while (member (car temp) '("." ".."))
+ (setq temp (cdr temp)))
+ (= (length temp) 0))
+ (delete-directory old-dir)
+ (setq old-dir (file-name-as-directory
+ (file-truename
+ (concat old-dir "..")))))))))
+
+
(provide 'gnus-util)
;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
(setq w3m-display-inline-images mm-inline-text-html-with-images))
(defun mm-w3m-cid-retrieve-1 (url handle)
- (if (mm-multiple-handles handle)
- (dolist (elem handle)
- (mm-w3m-cid-retrieve-1 url elem))
- (when (and (listp handle)
- (equal url (mm-handle-id handle)))
- (mm-insert-part handle)
- (throw 'found-handle (mm-handle-media-type handle)))))
+ (dolist (elem handle)
+ (when (listp elem)
+ (if (equal url (mm-handle-id elem))
+ (progn
+ (mm-insert-part elem)
+ (throw 'found-handle (mm-handle-media-type elem))))
+ (if (equal "multipart" (mm-handle-media-supertype elem))
+ (mm-w3m-cid-retrieve-1 url elem)))))
(defun mm-w3m-cid-retrieve (url &rest args)
"Insert a content pointed by URL if it has the cid: scheme."
(defun nnagent-request-type (group article)
(unless (stringp article)
- (let ((gnus-plugged t))
+ (let ((gnus-agent nil))
(if (not (gnus-check-backend-function
'request-type (car gnus-command-method)))
'unknown
(deffoo nnagent-request-set-mark (group action server)
(with-temp-buffer
- (insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n"
- (nth 0 gnus-command-method) group action
- (or server (nth 1 gnus-command-method))))
+ (insert "(gnus-agent-synchronize-group-flags \""
+ group
+ "\" '")
+ (gnus-pp action)
+ (insert " \""
+ (gnus-method-to-server gnus-command-method)
+ "\"")
+ (insert ")\n")
(append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags")))
nil)
HCoop / bpt / emacs.git / commitdiff