From 896bf29c3c858c65aee9d5a2669ba4164a7d651a Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 9 Apr 2003 23:16:30 +0000 Subject: [PATCH] Synch to Oort Gnus 200304091622. --- lisp/ChangeLog | 35 +++++++++++ lisp/gnus-agent.el | 178 +++++++++++++++++++++++++++++++--------------------- lisp/gnus-async.el | 12 ++-- lisp/gnus-sum.el | 24 +++++-- lisp/gnus-util.el | 22 +++---- 5 files changed, 178 insertions(+), 93 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f985678..0a30a10 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,40 @@ 2003-04-09 Jesper Harder + * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Import file" + and "Create article" items in non-editable groups. + +2003-04-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-write-active): Added option of + replacing, rather than updating, the agent's active file. Do NOT + use the fully qualified group name as gnus-active-to-gnus-format + blindly prefixes group names with server names. + (gnus-agent-save-group-info): Merge BOTH min/max of current active + range, was just merging min, with specified active range. + (gnus-agent-expire): Save agent's active ranges after + expiring all groups. + (gnus-agent-expire-group-1): Update min of agent's active range to + min article currently fetched. + (gnus-agent-expire-unagentized-dirs): Avoid asking to delete the + same ancestor multiple times. + + * gnus-async.el (gnus-asynchronous): Moved defcustom of + gnus-asynchronous away from defgroup of gnus-asynchronous. This + seems to fix an intermittant error in which loading gnus-async + fails to define gnus-asynchronous (the variable). + + * gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is + non-essential. Removed on all platforms. + (gnus-select-newsgroup): When the agent is active, expand the + group's active range to include fetched articles that are no + longer in the server's active range. + + * gnus-util.el (gnus-with-output-to-file): Removed all of the + print-* bindings as they should be handled by the function doing + the printing. + +2003-04-09 Jesper Harder + * mm-uu.el (mm-uu-copy-to-buffer): buffer-file-coding-system might be unbound in non-MULE XEmacsen. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 61b218b..b064c70 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -404,6 +404,10 @@ manipulated as follows: (defmacro gnus-agent-append-to-list (tail value) `(setq ,tail (setcdr ,tail (cons ,value nil)))) +(defmacro gnus-agent-message (level &rest args) + `(if (<= ,level gnus-verbose) + (message ,@args))) + ;;; ;;; Mode infestation ;;; @@ -1038,6 +1042,15 @@ This can be added to `gnus-select-article-hook' or ;;; Internal functions ;;; +;;; NOTES: +;;; The agent's active range is defined as follows: +;;; If the agent has no record of the group, use the actual active +;;; range. +;;; If the agent has a record, set the agent's active range to +;;; include the max limit of the actual active range. +;;; When expiring, update the min limit to match the smallest of the +;;; min article not expired or the min actual active range. + (defun gnus-agent-save-active (method) (gnus-agent-save-active-1 method 'gnus-active-to-gnus-format)) @@ -1051,32 +1064,41 @@ This can be added to `gnus-select-article-hook' or (erase-buffer) (nnheader-insert-file-contents file)))) -(defun gnus-agent-write-active (file new) - (let ((orig (gnus-make-hashtable (count-lines (point-min) (point-max)))) - (file (gnus-agent-lib-file "active")) - elem osym) - (when (file-exists-p file) +(defun gnus-agent-write-active (file new &optional literal-replacement) + (let ((old new)) + (when (and (not literal-replacement) + (file-exists-p file)) + (setq old (gnus-make-hashtable (count-lines (point-min) (point-max)))) (with-temp-buffer - (nnheader-insert-file-contents file) - (gnus-active-to-gnus-format nil orig)) + (nnheader-insert-file-contents file) + (gnus-active-to-gnus-format nil old)) + ;; Iterate over the current active groups, the current active + ;; range may expand, but NOT CONTRACT, the agent's active range. (mapatoms - (lambda (sym) - (when (and sym (boundp sym)) - (if (and (boundp (setq osym (intern (symbol-name sym) orig))) - (setq elem (symbol-value osym))) - (progn - (if (and (integerp (car (symbol-value sym))) - (> (car elem) (car (symbol-value sym)))) - (setcar elem (car (symbol-value sym)))) - (if (integerp (cdr (symbol-value sym))) - (setcdr elem (cdr (symbol-value sym))))) - (set (intern (symbol-name sym) orig) (symbol-value sym))))) + (lambda (nsym) + (let ((new-active (and nsym (boundp nsym) (symbol-value nsym)))) + (when new-active + (let* ((osym (intern (symbol-name nsym) old)) + (old-active (and (boundp osym) (symbol-value osym)))) + (if old-active + (let ((new-min (car new-active)) + (old-min (car old-active)) + (new-max (cdr new-active)) + (old-max (cdr old-active))) + (if (and (integerp new-min) + (< new-min old-min)) + (setcar old-active new-min)) + (if (and (integerp new-max) + (> new-max old-max)) + (setcdr old-active new-max))) + (set osym new-active)))))) new)) (gnus-make-directory (file-name-directory file)) (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) - ;; The hashtable contains real names of groups, no more prefix - ;; removing, so set `full' to `t'. - (gnus-write-active-file file orig t)))) + ;; The hashtable contains real names of groups. However, do NOT + ;; add the foreign server prefix as gnus-active-to-gnus-format + ;; will add it while reading the file. + (gnus-write-active-file file old nil)))) (defun gnus-agent-save-groups (method) (gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format)) @@ -1089,23 +1111,24 @@ This can be added to `gnus-select-article-hook' or (file-name-coding-system nnmail-pathname-coding-system) (pathname-coding-system nnmail-pathname-coding-system) (file (gnus-agent-lib-file "active")) - oactive-min) + oactive-min oactive-max) (gnus-make-directory (file-name-directory file)) (with-temp-file file ;; Emacs got problem to match non-ASCII group in multibyte buffer. (set-buffer-multibyte nil) (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 - (read (current-buffer)) ;; max - (setq oactive-min (read (current-buffer)))) ;; min - (gnus-delete-line)) + (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 + (gnus-delete-line))) (insert (format "%S %d %d y\n" (intern group) - (cdr active) - (or oactive-min (car active)))) + (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)))))) @@ -2428,25 +2451,22 @@ FORCE is equivalent to setting the expiration predicates to true." (overview (gnus-get-buffer-create " *expire overview*")) orig) (unwind-protect - (when (file-exists-p (gnus-agent-lib-file "active")) - (with-temp-buffer - (nnheader-insert-file-contents - (gnus-agent-lib-file "active")) - (gnus-active-to-gnus-format - gnus-command-method - (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) - (save-excursion - (gnus-agent-expire-group-1 - group overview (gnus-gethash-safe group orig) - articles force))) + (let ((active-file (gnus-agent-lib-file "active"))) + (when (file-exists-p active-file) + (with-temp-buffer + (nnheader-insert-file-contents active-file) + (gnus-active-to-gnus-format + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (save-excursion + (gnus-agent-expire-group-1 + group overview (gnus-gethash-safe group orig) + articles force)) + (gnus-agent-write-active active-file orig t))) (kill-buffer overview)))) (gnus-message 4 "Expiry...done"))) -(defmacro gnus-agent-message (level &rest args) - `(if (<= ,level gnus-verbose) - (message ,@args))) - (defun gnus-agent-expire-group-1 (group overview active articles force) ;; Internal function - requires caller to have set ;; gnus-command-method, initialized overview buffer, and to have @@ -2716,7 +2736,8 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) ;; If considering all articles is set, I can only ;; expire article IDs that are no longer in the - ;; active range. + ;; 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 @@ -2748,7 +2769,12 @@ expiration tests failed." article-number) (let ((inhibit-quit t)) (unless (equal alist gnus-agent-article-alist) (setq gnus-agent-article-alist alist) - (gnus-agent-save-alist group)) + (gnus-agent-save-alist group) + + ;; The active list changed, set the agent's active range + ;; to match the beginning of the list. + (if alist + (setcar active (caar alist)))) (when (buffer-modified-p) (gnus-make-directory dir) @@ -2788,23 +2814,24 @@ articles in every agentized group.")) (setq overview (gnus-get-buffer-create " *expire overview*")) (unwind-protect (while (setq gnus-command-method (pop methods)) - (when (file-exists-p (gnus-agent-lib-file "active")) - (with-temp-buffer - (nnheader-insert-file-contents - (gnus-agent-lib-file "active")) - (gnus-active-to-gnus-format - gnus-command-method - (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) - (dolist (expiring-group (gnus-groups-from-server - gnus-command-method)) - (let* ((active - (gnus-gethash-safe expiring-group orig))) + (let ((active-file (gnus-agent-lib-file "active"))) + (when (file-exists-p active-file) + (with-temp-buffer + (nnheader-insert-file-contents active-file) + (gnus-active-to-gnus-format + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (dolist (expiring-group (gnus-groups-from-server + gnus-command-method)) + (let* ((active + (gnus-gethash-safe expiring-group orig))) - (when active - (save-excursion - (gnus-agent-expire-group-1 - expiring-group overview active articles force))))))) + (when active + (save-excursion + (gnus-agent-expire-group-1 + expiring-group overview active articles force))))) + (gnus-agent-write-active active-file orig t)))) (kill-buffer overview)) (gnus-agent-expire-unagentized-dirs) (gnus-message 4 "Expiry...done"))))) @@ -2832,21 +2859,32 @@ articles in every agentized group.")) (checker (function (lambda (d) + "Given a directory, check it and its subdirectories for + membership in the keep hash. If it isn't found, add + it to to-remove." (let ((files (directory-files d)) file) (while (setq file (pop files)) - (cond ((equal file ".") + (cond ((equal file ".") ; Ignore self nil) - ((equal file "..") + ((equal file "..") ; Ignore parent nil) - ((equal file ".overview") + ((equal file ".overview") + ;; Directory must contain .overview to be + ;; agent's cache of a group. (let ((d (file-name-as-directory d)) r) + ;; Search ancestor's for last directory NOT + ;; found in keep hash. (while (not (gnus-gethash (setq d (file-name-directory d)) keep)) (setq r d d (directory-file-name d))) - (if r + ;; if ANY ancestor was NOT in keep hash and + ;; it it's already in to-remove, add it to + ;; to-remove. + (if (and r + (not (member r to-remove))) (push r to-remove)))) ((file-directory-p (setq file (nnheader-concat d file))) (funcall checker file))))))))) diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 0a8a798..f3a43c9 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -36,12 +36,6 @@ "Support for asynchronous operations." :group 'gnus) -(defcustom gnus-asynchronous nil - "*If nil, inhibit all Gnus asynchronicity. -If non-nil, let the other asynch variables be heeded." - :group 'gnus-asynchronous - :type 'boolean) - (defcustom gnus-use-article-prefetch 30 "*If non-nil, prefetch articles in groups that allow this. If a number, prefetch only that many articles forward; @@ -51,6 +45,12 @@ if t, prefetch as many articles as possible." (const :tag "all" t) (integer :tag "some" 0))) +(defcustom gnus-asynchronous nil + "*If nil, inhibit all Gnus asynchronicity. +If non-nil, let the other asynch variables be heeded." + :group 'gnus-asynchronous + :type 'boolean) + (defcustom gnus-prefetched-article-deletion-strategy '(read exit) "List of symbols that say when to remove articles from the prefetch buffer. Possible values in this list are `read', which means that diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 51087ab..85439f7 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1451,9 +1451,7 @@ buffers. For example: ;; source file. (if (boundp 'gnus-newsgroup-variables) nil - (if (featurep 'xemacs) - (load "gnus-sum.el" t t t) - (load "gnus-sum.el" t t t t))) + (load "gnus-sum.el" t t t)) (require 'gnus) (require 'gnus-agent) (require 'gnus-art))) @@ -2204,8 +2202,12 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Crosspost article..." gnus-summary-crosspost-article (gnus-check-backend-function 'request-replace-article gnus-newsgroup-name)] - ["Import file..." gnus-summary-import-article t] - ["Create article..." gnus-summary-create-article t] + ["Import file..." gnus-summary-import-article + (gnus-check-backend-function + 'request-accept-article gnus-newsgroup-name)] + ["Create article..." gnus-summary-create-article + (gnus-check-backend-function + 'request-accept-article gnus-newsgroup-name)] ["Check if posted" gnus-summary-article-posted-p t] ["Edit article" gnus-summary-edit-article (not (gnus-group-read-only-p))] @@ -5005,6 +5007,18 @@ If SELECT-ARTICLES, only select those articles from GROUP." (error "Couldn't request group %s: %s" 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)))))) + (setq gnus-newsgroup-name group gnus-newsgroup-unselected nil gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 33dd2a8..e3e447f 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1082,27 +1082,25 @@ Return the modified alist." (defmacro gnus-with-output-to-file (file &rest body) (let ((buffer (make-symbol "output-buffer")) (size (make-symbol "output-buffer-size")) - (leng (make-symbol "output-buffer-length"))) - `(let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - print-level - print-length - (,size 131072) + (leng (make-symbol "output-buffer-length")) + (append (make-symbol "output-buffer-append"))) + `(let* ((,size 131072) (,buffer (make-string ,size 0)) (,leng 0) - (append nil) + (,append nil) (standard-output (lambda (c) - (aset ,buffer ,leng c) + (aset ,buffer ,leng c) + (if (= ,size (setq ,leng (1+ ,leng))) - (progn (write-region ,buffer nil ,file append 'no-msg) + (progn (write-region ,buffer nil ,file ,append 'no-msg) (setq ,leng 0 - append t)))))) + ,append t)))))) ,@body (when (> ,leng 0) + (let ((coding-system-for-write 'no-conversion)) (write-region (substring ,buffer 0 ,leng) nil ,file - append 'no-msg))))) + ,append 'no-msg)))))) (put 'gnus-with-output-to-file 'lisp-indent-function 1) (put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) -- 1.7.10.4