From: yamaoka Date: Thu, 8 Apr 2004 05:21:27 +0000 (+0000) Subject: Synch to No Gnus 200404080152. X-Git-Tag: t-gnus-6_17_4-quimby-~985 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=edd186427a52b6e096896aaad979b3314154b721;p=elisp%2Fgnus.git- Synch to No Gnus 200404080152. * gnus-util.el (gnus-set-work-buffer): Set buffer multibyte. (gnus-select-frame-set-input-focus): Don't check whether `focus-follows-mouse' is bound. (frame-parameter): Remove. --- diff --git a/ChangeLog b/ChangeLog index 46b2826..461c23e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2004-04-08 Katsumi Yamaoka + + * lisp/gnus-util.el (gnus-set-work-buffer): Set buffer multibyte. + (gnus-select-frame-set-input-focus): Don't check whether + `focus-follows-mouse' is bound. + (frame-parameter): Remove. + 2004-03-25 Katsumi Yamaoka * lisp/pop3.el: Don't require `advice', `pces' and `path-util'. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index de70933..de839f5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,87 @@ +2004-04-07 Kevin Greiner + * gnus-agent.el (gnus-agent-total-fetched-hashtb): New variable. + (gnus-agent-with-refreshed-group): New macro. + (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-fetch-articles): Use + gnus-agent-update-files-total-fetched-for to increment disk space + used. + (gnus-agent-fetch-headers, gnus-agent-save-alist): Use + gnus-agent-update-view-total-fetched-for to increment disk space + used. + (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-agent-expire-group-1): Use gnus-agent-with-refreshed-group, + gnus-agent-update-view-total-fetched-for, and + gnus-agent-update-files-total-fetched-for to decrement disk space + used. + (gnus-agent-retrieve-headers): Use + gnus-agent-update-view-total-fetched-for to increment disk space + used. + (gnus-agent-regenerate-group): Replace gnus-group-update-group + with gnus-agent-update-files-total-fetched-for to decrement disk + space and fresh group buffer. + (gnus-agent-inhibit-update-total-fetched-for): New variable. + (gnus-agent-need-update-total-fetched-for): New variable. + (gnus-agent-update-files-total-fetched-for): New function. + (gnus-agent-update-view-total-fetched-for): New function. + (gnus-agent-total-fetched-for): New function. + + * gnus-cache.el (gnus-cache-save-buffers): Use + gnus-cache-update-overview-total-fetched-for to change disk space + used by this group. + (gnus-cache-possibly-enter-article): Use + gnus-cache-update-file-total-fetched-for to increment disk space + used by this group. + (gnus-cache-possibly-remove-article): Use + gnus-cache-update-file-total-fetched-for to decrement disk space + used by this group. + (gnus-cache-generate-nov-databases): Purge total fetched cache. + (gnus-cache-rename-group): New function. + (gnus-cache-delete-group): New function. + (gnus-cache-inhibit-update-total-fetched-for): New variable. + (gnus-cache-need-update-total-fetched-for): New variable. + (gnus-cache-with-refreshed-group): New macro. + (gnus-cache-update-file-total-fetched-for): New function. + (gnus-cache-update-overview-total-fetched-for): New function. + (gnus-cache-rename-group-total-fetched-for): New function. + (gnus-cache-delete-group-total-fetched-for): New function. + (gnus-cache-total-fetched-for): New function. + + * gnus-group.el (): Require gnus-sum and autoload functions to + resolve warnings when gnus-group.el compiled alone. + (gnus-group-line-format): Documented new %F + (size of Fetched data) group line format; identifies disk space + used by agent and cache. + (gnus-group-line-format-alist): Defined new F format. + (gnus-total-fetched-for): New function. + (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-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-util.el (gnus-rename-file): New function. + 2004-04-07 Jesper Harder * rfc2047.el (rfc2047-encoded-word-regexp): Remove unnecessary diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 18e3157..84a1d33 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -240,6 +240,9 @@ NOTES: (defvar gnus-agent-send-mail-function nil) (defvar gnus-agent-file-coding-system 'raw-text) (defvar gnus-agent-file-loading-cache nil) +(defvar gnus-agent-total-fetched-hashtb nil) +(defvar gnus-agent-inhibit-update-total-fetched-for nil) +(defvar gnus-agent-need-update-total-fetched-for nil) ;; Dynamic variables (defvar gnus-headers) @@ -279,6 +282,17 @@ NOTES: ;;; Utility functions ;;; +(defmacro gnus-agent-with-refreshed-group (group &rest body) + "Performs the body then updates the group's line in the group +buffer. Automatically blocks multiple updates due to recursion." +`(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) + (setq gnus-agent-need-update-total-fetched-for nil) + (gnus-group-update-group ,group t))))) + (defun gnus-agent-read-file (file) "Load FILE and do a `read' there." (with-temp-buffer @@ -828,6 +842,56 @@ be a select 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 ;;; @@ -1191,7 +1255,7 @@ 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")) @@ -1207,15 +1271,39 @@ downloaded into the agent." (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." @@ -1416,6 +1504,8 @@ downloaded into the agent." (setq pos (cdr pos))))) (gnus-agent-save-alist group (cdr fetched-articles) date) + (gnus-agent-update-files-total-fetched-for group (cdr fetched-articles)) + (gnus-message 7 "")) (cdr fetched-articles)))))) @@ -1641,6 +1731,7 @@ article numbers will be returned." (write-region-as-coding-system gnus-agent-file-coding-system (point-min) (point-max) file nil 'silent) + (gnus-agent-update-view-total-fetched-for group t) (gnus-agent-save-alist group articles nil) articles) (ignore-errors @@ -1844,7 +1935,9 @@ FILE and places the combined headers into `nntp-server-buffer'." (princ compressed (current-buffer))))) (insert "\n") (princ gnus-agent-article-alist-save-format (current-buffer)) - (insert "\n")))) + (insert "\n")) + + (gnus-agent-update-view-total-fetched-for group nil))) (defvar gnus-agent-article-local nil) (defvar gnus-agent-file-loading-local nil) @@ -1942,9 +2035,9 @@ modified) original contents, they are first saved to their own file." (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)) +(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)))) @@ -1979,7 +2072,9 @@ modified) original contents, they are first saved to their own file." 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) @@ -2029,13 +2124,14 @@ modified) original contents, they are first saved to their own file." 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"))))))))) @@ -2720,7 +2816,7 @@ FORCE is equivalent to setting the expiration predicates to true." (if (not group) (gnus-agent-expire articles group force) (let ( ;; Bind gnus-agent-expire-stats to enable tracking of - ;; expiration statistics of this single group + ;; expiration statistics of this single group (gnus-agent-expire-stats (list 0 0 0.0))) (if (or (not (eq articles t)) (yes-or-no-p @@ -2751,329 +2847,341 @@ FORCE is equivalent to setting the expiration predicates to true." ;; provided a non-nil active (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)))) - - (if (and (not force) - (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 \ + (gnus-agent-with-refreshed-group + group + (when (boundp 'gnus-agent-expire-current-dirs) + (set '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) + (gnus-message 5 "Expiring articles in %s" group) + (gnus-agent-load-alist group) + (let* ((bytes-freed 0) + (size-files-deleted 0.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)))) - 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 \ + ;; 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 \ 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 (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 size-files-deleted 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 (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 \ + (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 \ expiration tests failed." group article-number) - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date))) - ) + (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)) - ;; Clean up markers as I want to recycle this buffer - ;; over several groups. - (when marker - (set-marker marker nil)) + (setq dlist (cdr dlist)))) - (setq dlist (cdr dlist)))) + (setq alist (cdr alist)) - (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)) - (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) + (gnus-make-directory dir) + (write-region-as-coding-system gnus-agent-file-coding-system + (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) + (gnus-agent-update-view-total-fetched-for group t)) - (when (buffer-modified-p) - (gnus-make-directory dir) - (write-region-as-coding-system gnus-agent-file-coding-system - (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 (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))) + + (gnus-agent-update-files-total-fetched-for group (- size-files-deleted))))))) (defun gnus-agent-expire (&optional articles group force) "Expire all old articles. @@ -3396,18 +3504,20 @@ has been fetched." (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 + ;; 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)) (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) (gnus-agent-check-overview-buffer) (write-region-as-coding-system gnus-agent-file-coding-system (point-min) (point-max) file nil 'silent) + (gnus-agent-update-view-total-fetched-for group t) + ;; Update the group's article alist to include the newly ;; fetched articles. (gnus-agent-load-alist group) @@ -3481,196 +3591,195 @@ If REREAD is not nil, downloaded articles are marked as unread." (sit-for 1) t))))) (when group - (gnus-message 5 "Regenerating in %s" group) - (let* ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group))) - (file (gnus-agent-article-name ".overview" group)) - (dir (file-name-directory file)) - point - (downloaded (if (file-exists-p dir) - (sort (mapcar (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)) - '>) - (progn (gnus-make-directory dir) nil))) - dl nov-arts - alist header - regenerated) - - (mm-with-unibyte-buffer - (if (file-exists-p file) - (let ((nnheader-file-coding-system - gnus-agent-file-coding-system)) - (nnheader-insert-file-contents file))) - (set-buffer-modified-p nil) - - ;; Load the article IDs found in the overview file. As a - ;; side-effect, validate the file contents. - (let ((load t)) - (while load - (setq load nil) - (goto-char (point-min)) - (while (< (point) (point-max)) - (cond ((and (looking-at "[0-9]+\t") - (<= (- (match-end 0) (match-beginning 0)) 9)) - (push (read (current-buffer)) nov-arts) - (forward-line 1) - (let ((l1 (car nov-arts)) - (l2 (cadr nov-arts))) - (cond ((and (listp reread) (memq l1 reread)) - (gnus-delete-line) - (setq nov-arts (cdr nov-arts)) - (gnus-message 4 "gnus-agent-regenerate-group: NOV\ + (gnus-message 5 "Regenerating in %s" group) + (let* ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (file (gnus-agent-article-name ".overview" group)) + (dir (file-name-directory file)) + point + (downloaded (if (file-exists-p dir) + (sort (mapcar (lambda (name) (string-to-int name)) + (directory-files dir nil "^[0-9]+$" t)) + '>) + (progn (gnus-make-directory dir) nil))) + dl nov-arts + alist header + regenerated) + + (mm-with-unibyte-buffer + (if (file-exists-p file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))) + (set-buffer-modified-p nil) + + ;; Load the article IDs found in the overview file. As a + ;; side-effect, validate the file contents. + (let ((load t)) + (while load + (setq load nil) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond ((and (looking-at "[0-9]+\t") + (<= (- (match-end 0) (match-beginning 0)) 9)) + (push (read (current-buffer)) nov-arts) + (forward-line 1) + (let ((l1 (car nov-arts)) + (l2 (cadr nov-arts))) + (cond ((and (listp reread) (memq l1 reread)) + (gnus-delete-line) + (setq nov-arts (cdr nov-arts)) + (gnus-message 4 "gnus-agent-regenerate-group: NOV\ entry of article %s deleted." l1)) - ((not l2) - nil) - ((< l1 l2) - (gnus-message 3 "gnus-agent-regenerate-group: NOV\ + ((not l2) + nil) + ((< l1 l2) + (gnus-message 3 "gnus-agent-regenerate-group: NOV\ entries are NOT in ascending order.") - ;; Don't sort now as I haven't verified - ;; that every line begins with a number - (setq load t)) - ((= l1 l2) - (forward-line -1) - (gnus-message 4 "gnus-agent-regenerate-group: NOV\ + ;; Don't sort now as I haven't verified + ;; that every line begins with a number + (setq load t)) + ((= l1 l2) + (forward-line -1) + (gnus-message 4 "gnus-agent-regenerate-group: NOV\ entries contained duplicate of article %s. Duplicate deleted." l1) - (gnus-delete-line) - (setq nov-arts (cdr nov-arts)))))) - (t - (gnus-message 1 "gnus-agent-regenerate-group: NOV\ + (gnus-delete-line) + (setq nov-arts (cdr nov-arts)))))) + (t + (gnus-message 1 "gnus-agent-regenerate-group: NOV\ entries contained line that did not begin with an article number. Deleted\ line.") - (gnus-delete-line)))) - (when load - (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ + (gnus-delete-line)))) + (when load + (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ entries into ascending order.") - (sort-numeric-fields 1 (point-min) (point-max)) - (setq nov-arts nil)))) - (gnus-agent-check-overview-buffer) - - ;; Construct a new article alist whose nodes match every header - ;; in the .overview file. As a side-effect, missing headers are - ;; reconstructed from the downloaded article file. - (while (or downloaded nov-arts) - (cond ((and downloaded - (or (not nov-arts) - (> (car downloaded) (car nov-arts)))) - ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group - (car downloaded)) - (let ((file (concat dir (number-to-string (car downloaded))))) - (mm-with-unibyte-buffer - (nnheader-insert-file-contents file) - (nnheader-remove-body) - (setq header (nnheader-parse-naked-head))) - (mail-header-set-number header (car downloaded)) - (if nov-arts - (let ((key (concat "^" (int-to-string (car nov-arts)) - "\t"))) - (or (re-search-backward key nil t) - (re-search-forward key)) - (forward-line 1)) - (goto-char (point-min))) - (nnheader-insert-nov header)) - (setq nov-arts (cons (car downloaded) nov-arts))) - ((eq (car downloaded) (car nov-arts)) - ;; This entry in the overview has been downloaded - (push (cons (car downloaded) - (time-to-days - (nth 5 (file-attributes - (concat dir (number-to-string - (car downloaded))))))) alist) - (setq downloaded (cdr downloaded)) - (setq nov-arts (cdr nov-arts))) - (t - ;; This entry in the overview has not been downloaded - (push (cons (car nov-arts) nil) alist) - (setq nov-arts (cdr nov-arts))))) - - ;; When gnus-agent-consider-all-articles is set, - ;; gnus-agent-regenerate-group should NOT remove article IDs from - ;; the alist. Those IDs serve as markers to indicate that an - ;; attempt has been made to fetch that article's header. - - ;; When gnus-agent-consider-all-articles is NOT set, - ;; gnus-agent-regenerate-group can remove the article ID of every - ;; article (with the exception of the last ID in the list - it's - ;; special) that no longer appears in the overview. In this - ;; situtation, the last article ID in the list implies that it, - ;; and every article ID preceeding it, have been fetched from the - ;; server. - - (if gnus-agent-consider-all-articles - ;; Restore all article IDs that were not found in the overview file. - (let* ((n (cons nil alist)) - (merged n) - (o (gnus-agent-load-alist group))) - (while o - (let ((nID (caadr n)) - (oID (caar o))) - (cond ((not nID) - (setq n (setcdr n (list (list oID)))) - (setq o (cdr o))) - ((< oID nID) - (setcdr n (cons (list oID) (cdr n))) - (setq o (cdr o))) - ((= oID nID) - (setq o (cdr o)) - (setq n (cdr n))) - (t - (setq n (cdr n)))))) - (setq alist (cdr merged))) - ;; Restore the last article ID if it is not already in the new alist - (let ((n (last alist)) - (o (last (gnus-agent-load-alist group)))) - (cond ((not o) - nil) - ((not n) - (push (cons (caar o) nil) alist)) - ((< (caar n) (caar o)) - (setcdr n (list (car o))))))) - - (let ((inhibit-quit t)) - (if (setq regenerated (buffer-modified-p)) - (write-region-as-coding-system - gnus-agent-file-coding-system - (point-min) (point-max) file nil 'silent)) - - (setq regenerated (or regenerated - (and reread gnus-agent-article-alist) - (not (equal alist gnus-agent-article-alist)))) - - (setq gnus-agent-article-alist alist) - - (when regenerated - (gnus-agent-save-alist group) + (sort-numeric-fields 1 (point-min) (point-max)) + (setq nov-arts nil)))) + (gnus-agent-check-overview-buffer) + + ;; Construct a new article alist whose nodes match every header + ;; in the .overview file. As a side-effect, missing headers are + ;; reconstructed from the downloaded article file. + (while (or downloaded nov-arts) + (cond ((and downloaded + (or (not nov-arts) + (> (car downloaded) (car nov-arts)))) + ;; This entry is missing from the overview file + (gnus-message 3 "Regenerating NOV %s %d..." group + (car downloaded)) + (let ((file (concat dir (number-to-string (car downloaded))))) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (nnheader-remove-body) + (setq header (nnheader-parse-naked-head))) + (mail-header-set-number header (car downloaded)) + (if nov-arts + (let ((key (concat "^" (int-to-string (car nov-arts)) + "\t"))) + (or (re-search-backward key nil t) + (re-search-forward key)) + (forward-line 1)) + (goto-char (point-min))) + (nnheader-insert-nov header)) + (setq nov-arts (cons (car downloaded) nov-arts))) + ((eq (car downloaded) (car nov-arts)) + ;; This entry in the overview has been downloaded + (push (cons (car downloaded) + (time-to-days + (nth 5 (file-attributes + (concat dir (number-to-string + (car downloaded))))))) alist) + (setq downloaded (cdr downloaded)) + (setq nov-arts (cdr nov-arts))) + (t + ;; This entry in the overview has not been downloaded + (push (cons (car nov-arts) nil) alist) + (setq nov-arts (cdr nov-arts))))) + + ;; When gnus-agent-consider-all-articles is set, + ;; gnus-agent-regenerate-group should NOT remove article IDs from + ;; the alist. Those IDs serve as markers to indicate that an + ;; attempt has been made to fetch that article's header. + + ;; When gnus-agent-consider-all-articles is NOT set, + ;; gnus-agent-regenerate-group can remove the article ID of every + ;; article (with the exception of the last ID in the list - it's + ;; special) that no longer appears in the overview. In this + ;; situtation, the last article ID in the list implies that it, + ;; and every article ID preceeding it, have been fetched from the + ;; server. + + (if gnus-agent-consider-all-articles + ;; Restore all article IDs that were not found in the overview file. + (let* ((n (cons nil alist)) + (merged n) + (o (gnus-agent-load-alist group))) + (while o + (let ((nID (caadr n)) + (oID (caar o))) + (cond ((not nID) + (setq n (setcdr n (list (list oID)))) + (setq o (cdr o))) + ((< oID nID) + (setcdr n (cons (list oID) (cdr n))) + (setq o (cdr o))) + ((= oID nID) + (setq o (cdr o)) + (setq n (cdr n))) + (t + (setq n (cdr n)))))) + (setq alist (cdr merged))) + ;; Restore the last article ID if it is not already in the new alist + (let ((n (last alist)) + (o (last (gnus-agent-load-alist group)))) + (cond ((not o) + nil) + ((not n) + (push (cons (caar o) nil) alist)) + ((< (caar n) (caar o)) + (setcdr n (list (car o))))))) + + (let ((inhibit-quit t)) + (if (setq regenerated (buffer-modified-p)) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) file nil 'silent)) + + (setq regenerated (or regenerated + (and reread gnus-agent-article-alist) + (not (equal alist gnus-agent-article-alist)))) + + (setq gnus-agent-article-alist alist) + + (when regenerated + (gnus-agent-save-alist group) - ;; I have to alter the group's active range NOW as - ;; gnus-make-ascending-articles-unread will use it to - ;; recalculate the number of unread articles in the group - - (let ((group (gnus-group-real-name group)) - (group-active (or (gnus-active group) - (gnus-activate-group group)))) - (gnus-agent-possibly-alter-active group group-active))))) - - (when (and reread gnus-agent-article-alist) - (gnus-make-ascending-articles-unread - group - (if (listp reread) - reread - (delq nil (mapcar (function (lambda (c) - (cond ((eq reread t) - (car c)) - ((cdr c) - (car c))))) - gnus-agent-article-alist)))) - - (when (gnus-buffer-live-p gnus-group-buffer) - (gnus-group-update-group group t) - (sit-for 0))) - - (gnus-message 5 nil) - regenerated))) + ;; I have to alter the group's active range NOW as + ;; gnus-make-ascending-articles-unread will use it to + ;; recalculate the number of unread articles in the group + + (let ((group (gnus-group-real-name group)) + (group-active (or (gnus-active group) + (gnus-activate-group group)))) + (gnus-agent-possibly-alter-active group group-active))))) + + (when (and reread gnus-agent-article-alist) + (gnus-make-ascending-articles-unread + group + (if (listp reread) + reread + (delq nil (mapcar (function (lambda (c) + (cond ((eq reread t) + (car c)) + ((cdr c) + (car c))))) + gnus-agent-article-alist)))) + + (when regenerated + (gnus-agent-update-files-total-fetched-for group nil))) + + (gnus-message 5 nil) + regenerated))) ;;;###autoload (defun gnus-agent-regenerate (&optional clean reread) @@ -3715,6 +3824,77 @@ If CLEAN, obsolete (ignore)." (defun gnus-agent-group-covered-p (group) (gnus-agent-method-p (gnus-group-method group))) +(defun gnus-agent-update-files-total-fetched-for + (group delta &optional method path) + "Update, or set, the total disk space used by the articles that the +agent has fetched." + (when gnus-agent-total-fetched-hashtb + (gnus-agent-with-refreshed-group + group + ;; if null, gnus-agent-group-pathname will calc method. + (let* ((gnus-command-method method) + (path (or path (gnus-agent-group-pathname group))) + (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) + (gnus-sethash path (make-list 3 0) + gnus-agent-total-fetched-hashtb)))) + (when (listp delta) + (unless delta + (setq delta (directory-files path nil "^-?[0-9]+$" t))) + + (let ((sum 0.0) + file) + (while (setq file (pop delta)) + (incf sum (float (or (nth 7 (file-attributes + (nnheader-concat + path + (if (numberp file) + (number-to-string file) + file)))) 0)))) + (setq delta sum))) + + (setq gnus-agent-need-update-total-fetched-for t) + (incf (nth 2 entry) delta))))) + +(defun gnus-agent-update-view-total-fetched-for + (group agent-over &optional method path) + "Update, or set, the total disk space used by the .agentview and +.overview files. These files are calculated separately as they can be +modified." + (when gnus-agent-total-fetched-hashtb + (gnus-agent-with-refreshed-group + group + ;; if null, gnus-agent-group-pathname will calc method. + (let* ((gnus-command-method method) + (path (or path (gnus-agent-group-pathname group))) + (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) + (gnus-sethash path (make-list 3 0) + gnus-agent-total-fetched-hashtb))) + (size (or (nth 7 (file-attributes + (nnheader-concat + path (if agent-over + ".overview" + ".agentview")))) + 0))) + (setq gnus-agent-need-update-total-fetched-for t) + (setf (nth (if agent-over 1 0) entry) size))))) + +(defun gnus-agent-total-fetched-for (group &optional method no-inhibit) + "Get the total disk space used by the specified GROUP." + (unless gnus-agent-total-fetched-hashtb + (setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024))) + + ;; if null, gnus-agent-group-pathname will calc method. + (let* ((gnus-command-method method) + (path (gnus-agent-group-pathname group)) + (entry (gnus-gethash path gnus-agent-total-fetched-hashtb))) + (if entry + (apply '+ entry) + (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit))) + (+ + (gnus-agent-update-view-total-fetched-for group nil method path) + (gnus-agent-update-view-total-fetched-for group t method path) + (gnus-agent-update-files-total-fetched-for group nil method path)))))) + (provide 'gnus-agent) ;;; gnus-agent.el ends here diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index c24fd93..1d5a81b 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -31,11 +31,8 @@ (eval-when-compile (require 'cl)) (require 'gnus) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-start) (eval-when-compile - (if (not (fboundp 'gnus-agent-load-alist)) + (unless (fboundp 'gnus-agent-load-alist) (defun gnus-agent-load-alist (group))) (require 'gnus-sum)) @@ -93,6 +90,7 @@ it's not cached." (defvar gnus-cache-buffer nil) (defvar gnus-cache-active-hashtb nil) (defvar gnus-cache-active-altered nil) +(defvar gnus-cache-total-fetched-hashtb nil) (defvar gnus-cache-write-file-coding-system 'raw-text) (eval-and-compile @@ -143,7 +141,10 @@ it's not cached." ;; of any inconsistencies (articles w/o nov entries?). ;; for now, just be conservative...delete only if safe -- sj (delete-directory (file-name-directory overview-file)) - (error nil))))) + (error))) + + (gnus-cache-update-overview-total-fetched-for (car gnus-cache-buffer) + overview-file))) ;; Kill the buffer -- it's either unmodified or saved. (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) @@ -183,6 +184,7 @@ it's not cached." (when (> (buffer-size) 0) (gnus-write-buffer-as-coding-system gnus-cache-write-file-coding-system file) + (gnus-cache-update-file-total-fetched-for group file) (nnheader-remove-body) (setq headers (nnheader-parse-naked-head)) (mail-header-set-number headers number) @@ -470,13 +472,15 @@ Returns the list of articles removed." (gnus-cache-member-of-class gnus-cache-remove-articles ticked dormant unread))) (save-excursion + (gnus-cache-update-file-total-fetched-for group file t) (delete-file file) + (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-min)) (when (or (looking-at (concat (int-to-string number) "\t")) (search-forward (concat "\n" (int-to-string number) "\t") (point-max) t)) - (gnus-delete-line))) + (gnus-delete-line))) (unless (setq gnus-newsgroup-cached (delq article gnus-newsgroup-cached)) (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) @@ -709,6 +713,9 @@ If LOW, update the lower bound instead." (gnus-cache-close) (let ((nnml-generate-active-function 'identity)) (nnml-generate-nov-databases-1 dir)) + + (setq gnus-cache-total-fetched-hashtb nil) + (gnus-cache-open)) (defun gnus-cache-move-cache (dir) @@ -729,6 +736,126 @@ If GROUP is non-nil, also cater to `gnus-cacheable-groups' and (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)) + + (gnus-cache-rename-group-total-fetched-for old-group new-group) + + (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)) + + (gnus-cache-delete-group-total-fetched-for group) + + (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))))) + +(defvar gnus-cache-inhibit-update-total-fetched-for nil) +(defvar gnus-cache-need-update-total-fetched-for nil) + +(defmacro gnus-cache-with-refreshed-group (group &rest body) + `(prog1 (let ((gnus-cache-inhibit-update-total-fetched-for t)) + ,@body) + (when (and gnus-cache-need-update-total-fetched-for + (not gnus-cache-inhibit-update-total-fetched-for)) + (save-excursion + (set-buffer gnus-group-buffer) + (setq gnus-cache-need-update-total-fetched-for nil) + (gnus-group-update-group ,group t))))) + +(defun gnus-cache-update-file-total-fetched-for (group file &optional subtract) + (when gnus-cache-total-fetched-hashtb + (gnus-cache-with-refreshed-group + group + (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) + (gnus-sethash group (make-vector 2 0) + gnus-cache-total-fetched-hashtb))) + size) + + (if file + (setq size (or (nth 7 (file-attributes file)) 0)) + (let ((files (directory-files (gnus-cache-file-name group "") + t nil t)) + file attrs) + (setq size 0.0) + (while (setq file (pop files)) + (setq attrs (file-attributes file)) + (unless (nth 0 attrs) + (incf size (float (nth 7 attrs))))))) + + (setq gnus-cache-need-update-total-fetched-for t) + + (incf (nth 1 entry) (if subtract (- size) size)))))) + +(defun gnus-cache-update-overview-total-fetched-for (group file) + (when gnus-cache-total-fetched-hashtb + (gnus-cache-with-refreshed-group + group + (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) + (gnus-sethash group (make-list 2 0) + gnus-cache-total-fetched-hashtb))) + (size (or (nth 7 (file-attributes + (or file + (gnus-cache-file-name group ".overview")))) + 0))) + (setq gnus-cache-need-update-total-fetched-for t) + (setf (nth 0 entry) size))))) + +(defun gnus-cache-rename-group-total-fetched-for (old-group new-group) + "Record of disk space used by OLD-GROUP now associated with NEW-GROUP." + (when gnus-cache-total-fetched-hashtb + (let ((entry (gnus-gethash old-group gnus-cache-total-fetched-hashtb))) + (gnus-sethash new-group entry gnus-cache-total-fetched-hashtb) + (gnus-sethash old-group nil gnus-cache-total-fetched-hashtb)))) + +(defun gnus-cache-delete-group-total-fetched-for (group) + "Delete record of disk space used by GROUP being deleted." + (when gnus-cache-total-fetched-hashtb + (gnus-sethash group nil gnus-cache-total-fetched-hashtb))) + +(defun gnus-cache-total-fetched-for (group &optional no-inhibit) + "Get total disk space used by the cache for the specified GROUP." + (unless gnus-cache-total-fetched-hashtb + (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024))) + + (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb))) + (if entry + (apply '+ entry) + (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) + (+ + (gnus-cache-update-overview-total-fetched-for group nil) + (gnus-cache-update-file-total-fetched-for group nil)))))) + (provide 'gnus-cache) ;;; gnus-cache.el ends here diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 5fb04d8..eb55584 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -41,7 +41,15 @@ (require 'time-date) (require 'gnus-ems) -(eval-when-compile (require 'mm-url)) +(eval-when-compile + (require 'mm-url) + (let ((features (cons 'gnus-group features))) + (require 'gnus-sum)) + (unless (boundp 'gnus-cache-active-hashtb) + (defvar gnus-cache-active-hashtb nil))) + +(autoload 'gnus-agent-total-fetched-for "gnus-agent") +(autoload 'gnus-cache-total-fetched-for "gnus-cache") (defcustom gnus-group-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" @@ -178,6 +186,7 @@ with some simple extensions. %z A string that look like `<%s:%n>' if a foreign select method is used %d The date the group was last entered. %E Icon as defined by `gnus-group-icon-list'. +%F The disk space used by the articles fetched by both the cache and agent. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed a @@ -192,10 +201,10 @@ output may end up looking strange when listing both alive and killed groups. If you use %o or %O, reading the active file will be slower and quite -a bit of extra memory will be used. %D will also worsen performance. -Also note that if you change the format specification to include any -of these specs, you must probably re-start Gnus to see them go into -effect. +a bit of extra memory will be used. %D and %F will also worsen +performance. Also note that if you change the format specification to +include any of these specs, you must probably re-start Gnus to see +them go into effect. General format specifiers can also be used. See Info node `(gnus)Formatting Variables'." @@ -503,7 +512,9 @@ simple manner.") ))) ?s) (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) - (?u gnus-tmp-user-defined ?s))) + (?u gnus-tmp-user-defined ?s) + (?F (gnus-total-fetched-for gnus-tmp-group) ?s) + )) (defvar gnus-group-mode-line-format-alist `((?S gnus-tmp-news-server ?s) @@ -1701,6 +1712,18 @@ If FIRST-TOO, the current line is also eligible as a target." (goto-char (or pos beg)) (and pos t)))) +(defun gnus-total-fetched-for (group) + (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0)) + (size-in-agent (or (gnus-agent-total-fetched-for group) 0)) + (size (+ size-in-cache size-in-agent)) + (suffix '("B" "K" "M" "G")) + (scale 1024.0) + (cutoff (* 10 scale))) + (while (> size cutoff) + (setq size (/ size scale) + suffix (cdr suffix))) + (format "%5.1f%s" size (car suffix)))) + ;;; Gnus group mode commands ;; Group marking. @@ -2310,8 +2333,6 @@ ADDRESS." (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 @@ -2341,10 +2362,6 @@ be removed from the server, even when it's empty." (gnus-group-goto-group group) (gnus-group-kill-group 1 t) (gnus-set-active group nil) - (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))) @@ -3546,7 +3563,7 @@ entail asking the server for the groups." ;; 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 diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 96694cb..2801d43 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -339,7 +339,7 @@ name. The method this group uses will be queried." (when (stringp gnus-command-method) (setq gnus-command-method (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group)) + (funcall (inline (gnus-get-function gnus-command-method 'request-group)) (gnus-group-real-name group) (nth 1 gnus-command-method) dont-check))) @@ -626,15 +626,25 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (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. diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 59ecf72..f39a7d4 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1663,7 +1663,7 @@ newsgroup." (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 @@ -1686,61 +1686,60 @@ newsgroup." (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 ((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 @@ -1767,8 +1766,8 @@ newsgroup." (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 @@ -2012,10 +2011,10 @@ newsgroup." (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))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 6021b19..b77af79 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -31,19 +31,24 @@ ;; Gnus first. ;; [Unfortunately, it does depend on other parts of Gnus, e.g. the -;; autoloads below...] +;; autoloads and defvars below...] ;;; Code: (eval-when-compile (require 'cl) ;; Fixme: this should be a gnus variable, not nnmail-. - (defvar nnmail-pathname-coding-system)) -(eval-when-compile (require 'static)) + (defvar nnmail-pathname-coding-system) + + ;; Inappropriate references to other parts of Gnus. + (defvar gnus-emphasize-whitespace-regexp) + ) (require 'time-date) (require 'netrc) +(eval-when-compile (require 'static)) + (eval-and-compile (autoload 'message-fetch-field "message") (autoload 'gnus-get-buffer-window "gnus-win") @@ -560,7 +565,8 @@ If N, return the Nth ancestor instead." (set-buffer gnus-work-buffer) (erase-buffer)) (set-buffer (gnus-get-buffer-create gnus-work-buffer)) - (kill-all-local-variables))) + (kill-all-local-variables) + (set-buffer-multibyte t))) (defmacro gnus-group-real-name (group) "Find the real name of a foreign newsgroup." @@ -1364,17 +1370,9 @@ CHOICE is a list of the choice char and help message at IDX." (x-focus-frame frame)) ((eq window-system 'w32) (w32-focus-frame frame))) - (when (or (not (boundp 'focus-follows-mouse)) - (symbol-value 'focus-follows-mouse)) + (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0))))) -(unless (fboundp 'frame-parameter) - (defalias 'frame-parameter - (lambda (frame parameter) - "Return FRAME's value for parameter PARAMETER. -If FRAME is nil, describe the currently selected frame." - (cdr (assq parameter (frame-parameters frame)))))) - (defun gnus-frame-or-window-display-name (object) "Given a frame or window, return the associated display name. Return nil otherwise." @@ -1478,6 +1476,28 @@ predicate on the elements." ""))) (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) ;;; gnus-util.el ends here