From: shuhei-k Date: Wed, 24 Jun 1998 18:24:06 +0000 (+0000) Subject: Synch up with Chao-gnus 6.7.1. X-Git-Tag: semi-mule-199811302358~60 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=1e28c44173bfa9c7a9b41568726664a05d651ff2;p=elisp%2Fgnus.git- Synch up with Chao-gnus 6.7.1. --- diff --git a/ChangeLog b/ChangeLog index 5bbc223..9edd3f3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,69 @@ +1998-06-24 MORIOKA Tomohiko + + * texi/gnus.texi, texi/message.texi, texi/ChangeLog: Sync up with + Gnus 5.6.13. + +1998-06-14 Tatsuya Ichikawa + + * Sync up with Gnus 5.6.13. + +1998-06-24 MORIOKA Tomohiko + + * lisp/gnus-art.el (gnus-article-display-mime-message): Don't + `save-excursion'. + (gnus-article-prepare): Use `mime-fetch-field' instead of + `mime-entity-fetch-field'. + +1998-06-19 MORIOKA Tomohiko + + * lisp/gnus-art.el (gnus-article-display-mime-message): Use + `mime-display-message' instead of `mime-view-buffer'. + (gnus-article-display-traditional-message): Set + `gnus-article-buffer'. + (gnus-article-display-message-with-encoded-word): Modify for + `gnus-article-display-traditional-message'. + (gnus-article-prepare): Use `mime-parse-buffer' and + `mime-entity-fetch-field'; don't set gnus-article-buffer. + +1998-06-19 MORIOKA Tomohiko + + * lisp/gnus-sum.el (gnus-summary-move-article): Use + `gnus-request-original-article' instead of + `gnus-request-article-this-buffer'. + +1998-06-19 MORIOKA Tomohiko + + * texi/gnus-ja.texi, texi/gnus.texi (Using MIME): Modify + description about new display mechanism. + +1998-06-19 MORIOKA Tomohiko + + * lisp/gnus.el (gnus-version-number): Update to 6.6.0. + (gnus-version): Modify for this branch. + + * lisp/gnus-art.el (gnus-article-display-method-for-mime): New + variable; abolish `gnus-show-mime-method'. + (gnus-article-display-method-for-encoded-word): New variable; + abolish `gnus-decode-encoded-word-method'. + (gnus-article-display-method-for-traditional): New variable. + (gnus-article-display-mime-message): New function; abolish + `gnus-article-preview-mime-message'. + (gnus-article-display-traditional-message): New function. + (gnus-article-display-message-with-encoded-word): New function; + abolish `gnus-article-decode-encoded-word'. + (gnus-article-prepare): Change display mechanism; use + `gnus-request-original-article' instead of + `gnus-request-article-this-buffer'. + (gnus-request-original-article): New function. + +1998-06-22 MORIOKA Tomohiko + + * lisp/gnus.el (gnus-version-number): Update to 6.6.0. + (gnus-version): Modify for SEMI 1.8. + + * lisp/gnus-sum.el: Modify for interface change in SEMI 1.8 about + automatic message/partial combining. + 1998-06-19 MORIOKA Tomohiko * lisp/gnus.el (gnus-version-number): Update to 6.5.0. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7054db5..8b1fe65 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,91 @@ +Wed Jun 24 07:52:30 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.13 is released. + +Wed Jun 24 07:47:04 1998 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-rename): Disallow "nil". + +Wed Jun 24 07:33:17 1998 Vladimir Alexiev + + * nnvirtual.el (nnvirtual-update-xref-header): Regexp-quote group + name. + +Wed Jun 24 06:15:27 1998 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-build-sparse-threads): Give all the sparse + articles the date of the current child. + + * gnus-topic.el (gnus-group-topic-parameters): Didn't compute. + +Wed Jun 24 03:27:44 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.12 is released. + +Wed Jun 10 11:06:35 1998 Andreas Schwab + + * message.el (message-mail-other-window): Bind message-this-is-mail. + (message-mail-other-frame): Likewise. + (message-news-other-window): Bind message-this-is-news. + (message-news-other-frame): Likewise. + +1998-06-09 Sam Steingold + + * gnus-uu.el (gnus-uu-default-view-rules): make sed kill ^M only + at the end of line. + +1998-06-05 Hrvoje Niksic + + * nnmail.el (nnmail-get-split-group): Don't regexp-quote + nnmail-procmail-suffix. + +Wed Jun 24 03:04:05 1998 Kim-Minh Kaplan + + * gnus-sum.el (gnus-build-get-header): Fix obarray. + +Wed Jun 24 02:49:57 1998 Castor + + * nntp.el (nntp-open-ssl-stream): + +Wed Jun 24 02:31:46 1998 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-nov-parse-line): Cleaned up. + (gnus-build-all-threads): Put things in the wrong obarray. + +Wed Jun 24 01:43:26 1998 Decklin Foster + + * nngateway.el (nngateway-mail2news-header-transformation): New + function. + +Wed Jun 24 00:25:45 1998 Lars Magne Ingebrigtsen + + * message.el (message-shorten-references): New function. + (message-header-format-alist): Use it. + + * gnus-start.el (gnus-always-read-dribble-file): Customized. + + * message.el (message-generate-new-buffers): Dox fox. + +Tue Jun 23 23:58:48 1998 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-prepare-topic): Respect visible topic + param. + (gnus-topic-hierarchical-parameters): New function. + +1998-06-02 Didier Verna + + * gnus-picon.el (gnus-get-buffer-name): use get-buffer-create + instead of get-buffer + +Wed Jun 3 04:41:45 1998 Lars Magne Ingebrigtsen + + * nnkiboze.el (nnkiboze-request-delete-group): Delete .newsrc + file. + + * nnmail.el (nnmail-article-group): Nuke looong lines. + + * gnus-art.el (gnus-button-alist): Buggy default. + Wed Jun 3 04:03:37 1998 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.6.11 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 30f024c..5012254 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -368,14 +368,23 @@ be used as possible file names." :group 'gnus-article-mime :type 'boolean) -(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message - "Function to process a MIME message. +(defcustom gnus-article-display-method-for-mime + 'gnus-article-display-mime-message + "Function to display a MIME message. The function is called from the article buffer." :group 'gnus-article-mime :type 'function) -(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word - "*Function to decode MIME encoded words. +(defcustom gnus-article-display-method-for-encoded-word + 'gnus-article-display-message-with-encoded-word + "*Function to display a message with MIME encoded-words. +The function is called from the article buffer." + :group 'gnus-article-mime + :type 'function) + +(defcustom gnus-article-display-method-for-traditional + 'gnus-article-display-traditional-message + "*Function to display a traditional message. The function is called from the article buffer." :group 'gnus-article-mime :type 'function) @@ -1948,7 +1957,8 @@ commands: ;;; @@ article filters ;;; -(defun gnus-article-preview-mime-message () +(defun gnus-article-display-mime-message () + "Article display method for MIME message." (make-local-variable 'mime-button-mother-dispatcher) (setq mime-button-mother-dispatcher (function gnus-article-push-button)) @@ -1957,22 +1967,32 @@ commands: (set-buffer gnus-summary-buffer) default-mime-charset)) ) - (save-excursion - (mime-view-buffer gnus-original-article-buffer gnus-article-buffer - nil gnus-article-mode-map) - )) + (mime-display-message mime-message-structure + gnus-article-buffer nil gnus-article-mode-map) + ) (run-hooks 'gnus-mime-article-prepare-hook) ) -(defun gnus-article-decode-encoded-word () - "Header filter for gnus-article-mode." +(defun gnus-article-display-traditional-message () + "Article display method for traditional message." + (set-buffer gnus-article-buffer) + (let (buffer-read-only) + (erase-buffer) + (insert-buffer-substring gnus-original-article-buffer) + )) + +(defun gnus-article-display-message-with-encoded-word () + "Article display method for message with encoded-words." (let ((charset (save-excursion (set-buffer gnus-summary-buffer) default-mime-charset))) - (eword-decode-header charset) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (decode-mime-charset-region (match-end 0) (point-max) charset)) + (gnus-article-display-traditional-message) + (let (buffer-read-only) + (eword-decode-header charset) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (decode-mime-charset-region (match-end 0) (point-max) charset)) + ) (mime-maybe-hide-echo-buffer) ) (gnus-run-hooks 'gnus-mime-article-prepare-hook) @@ -2000,14 +2020,14 @@ If ALL-HEADERS is non-nil, no headers are hidden." result) (save-excursion (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) + (set-buffer gnus-original-article-buffer) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) - (if (not (setq result (let ((buffer-read-only nil)) - (gnus-request-article-this-buffer - article group)))) + (if (not (setq result + (let ((buffer-read-only nil)) + (gnus-request-original-article article group)))) ;; There is no such article. (save-excursion (when (and (numberp article) @@ -2070,17 +2090,21 @@ If ALL-HEADERS is non-nil, no headers are hidden." (or all-headers gnus-show-all-headers)))) (when (or (numberp article) (stringp article)) - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (let (buffer-read-only) + (let ((method + (if gnus-show-mime + (progn + (mime-parse-buffer) + (if (or (not gnus-strict-mime) + (mime-fetch-field "MIME-Version")) + gnus-article-display-method-for-mime + gnus-article-display-method-for-encoded-word)) + gnus-article-display-method-for-traditional))) + ;; Hooks for getting information from the article. + ;; This hook must be called before being narrowed. (gnus-run-hooks 'internal-hook) (gnus-run-hooks 'gnus-article-prepare-hook) - ;; Decode MIME message. - (when gnus-show-mime - (if (or (not gnus-strict-mime) - (gnus-fetch-field "MIME-Version")) - (funcall gnus-show-mime-method) - (funcall gnus-decode-encoded-word-method))) + ;; Display message. + (funcall method) ;; Perform the article display hooks. (gnus-run-hooks 'gnus-article-display-hook)) ;; Do page break. @@ -2513,6 +2537,124 @@ If given a prefix, show the hidden text instead." (point)) (set-buffer buf)))))) +(defun gnus-request-original-article (article group) + "Get an article and insert it into original article buffer." + (let (do-update-line) + (prog1 + (save-excursion + (erase-buffer) + (gnus-kill-all-overlays) + (setq group (or group gnus-newsgroup-name)) + + ;; Open server if it has closed. + (gnus-check-server (gnus-find-method-for-group group)) + + ;; Using `gnus-request-article' directly will insert the article into + ;; `nntp-server-buffer' - so we'll save some time by not having to + ;; copy it from the server buffer into the article buffer. + + ;; We only request an article by message-id when we do not have the + ;; headers for it, so we'll have to get those. + (when (stringp article) + (let ((gnus-override-method gnus-refer-article-method)) + (gnus-read-header article))) + + ;; If the article number is negative, that means that this article + ;; doesn't belong in this newsgroup (possibly), so we find its + ;; message-id and request it by id instead of number. + (when (and (numberp article) + gnus-summary-buffer + (get-buffer gnus-summary-buffer) + (gnus-buffer-exists-p gnus-summary-buffer)) + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((header (gnus-summary-article-header article))) + (when (< article 0) + (cond + ((memq article gnus-newsgroup-sparse) + ;; This is a sparse gap article. + (setq do-update-line article) + (setq article (mail-header-id header)) + (let ((gnus-override-method gnus-refer-article-method)) + (gnus-read-header article)) + (setq gnus-newsgroup-sparse + (delq article gnus-newsgroup-sparse))) + ((vectorp header) + ;; It's a real article. + (setq article (mail-header-id header))) + (t + ;; It is an extracted pseudo-article. + (setq article 'pseudo) + (gnus-request-pseudo-article header)))) + + (let ((method (gnus-find-method-for-group + gnus-newsgroup-name))) + (when (and (eq (car method) 'nneething) + (vectorp header)) + (let ((dir (concat (file-name-as-directory (nth 1 method)) + (mail-header-subject header)))) + (when (file-directory-p dir) + (setq article 'nneething) + (gnus-group-enter-directory dir)))))))) + + (cond + ;; Refuse to select canceled articles. + ((and (numberp article) + gnus-summary-buffer + (get-buffer gnus-summary-buffer) + (gnus-buffer-exists-p gnus-summary-buffer) + (eq (cdr (save-excursion + (set-buffer gnus-summary-buffer) + (assq article gnus-newsgroup-reads))) + gnus-canceled-mark)) + nil) + ;; Check the backlog. + ((and gnus-keep-backlog + (gnus-backlog-request-article group article (current-buffer))) + 'article) + ;; Check asynchronous pre-fetch. + ((gnus-async-request-fetched-article group article (current-buffer)) + (gnus-async-prefetch-next group article gnus-summary-buffer) + (when (and (numberp article) gnus-keep-backlog) + (gnus-backlog-enter-article group article (current-buffer))) + 'article) + ;; Check the cache. + ((and gnus-use-cache + (numberp article) + (gnus-cache-request-article article group)) + 'article) + ;; Get the article and put into the article buffer. + ((or (stringp article) (numberp article)) + (let ((gnus-override-method + (and (stringp article) gnus-refer-article-method)) + (buffer-read-only nil)) + (erase-buffer) + (gnus-kill-all-overlays) + (when (gnus-request-article article group (current-buffer)) + (when (numberp article) + (gnus-async-prefetch-next group article gnus-summary-buffer) + (when gnus-keep-backlog + (gnus-backlog-enter-article + group article (current-buffer)))) + 'article))) + ;; It was a pseudo. + (t article))) + + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary gnus-summary-buffer) + + ;; Update sparse articles. + (when (and do-update-line + (or (numberp article) + (stringp article))) + (let ((buf (current-buffer))) + (set-buffer gnus-summary-buffer) + (gnus-summary-update-article do-update-line) + (gnus-summary-goto-subject do-update-line nil t) + (set-window-point (get-buffer-window (current-buffer) t) + (point)) + (set-buffer buf)))))) + ;;; ;;; Article editing ;;; @@ -2682,7 +2824,7 @@ groups." ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) - ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 2) + ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-embedded-url 1) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 47f71a0..0291690 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -184,8 +184,9 @@ arguments necessary for the job.") (defun gnus-get-buffer-name (variable) "Returns the buffer name associated with the contents of a variable." - (let ((buf (get-buffer (gnus-window-to-buffer-helper - (cdr (assq variable gnus-window-to-buffer)))))) + (let ((buf (get-buffer-create (gnus-window-to-buffer-helper + (cdr + (assq variable gnus-window-to-buffer)))))) (and buf (buffer-name buf)))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index d83f15f..29b6b04 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -383,10 +383,12 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'hook) -;;; Internal variables +(defcustom gnus-always-read-dribble-file nil + "Uncoditionally read the dribble file." + :group 'gnus-newsrc + :type 'boolean) -(defvar gnus-always-read-dribble-file nil - "Uncoditionally read the dribble file.") +;;; Internal variables (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 886cd49..507a8c3 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2871,25 +2871,24 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-dependencies-add-header (header dependencies force-new) "Enter HEADER into the DEPENDENCIES table if it is not already there. -If FORCE-NEW is not NIL, enter HEADER into the DEPENDENCIES table even +If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even if it was already present. -If `gnus-summary-ignore-duplicates' is NIL then duplicate Message-IDs +If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs will not be entered in the DEPENDENCIES table. Otherwise duplicate Message-IDs will be renamed be renamed to a unique Message-ID before being entered. -Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." - +Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) (id-dep (and id (intern id dependencies))) ref ref-dep ref-header) - ;; Enter this `header' in the `dependencies' table + ;; Enter this `header' in the `dependencies' table. (cond ((not id-dep) (setq header nil)) - ;; The first two cases do the normal part : enter a new `header' - ;; in the `dependencies' table, + ;; The first two cases do the normal part: enter a new `header' + ;; in the `dependencies' table. ((not (boundp id-dep)) (set id-dep (list header))) ((null (car (symbol-value id-dep))) @@ -2897,10 +2896,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." ;; From here the `header' was already present in the ;; `dependencies' table. - (force-new - ;; Overrides an existing entry, - ;; Just set the header part of the entry. + ;; Overrides an existing entry; + ;; just set the header part of the entry. (setcar (symbol-value id-dep) header)) ;; Renames the existing `header' to a unique Message-ID. @@ -2911,11 +2909,11 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (list header)) (mail-header-set-id header id)) - ;; - The last case ignores an existing entry, except it adds - ;; any additional Xrefs (in case the two articles came from - ;; different servers. - ;; Also sets `header' to `nil' meaning that the - ;; `dependencies' table was *not* modified. + ;; The last case ignores an existing entry, except it adds any + ;; additional Xrefs (in case the two articles came from different + ;; servers. + ;; Also sets `header' to `nil' meaning that the `dependencies' + ;; table was *not* modified. (t (mail-header-set-xref (car (symbol-value id-dep)) @@ -2932,9 +2930,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (boundp ref-dep) (setq ref-header (car (symbol-value ref-dep)))) (if (string= id ref) - ;; Yuk ! This is a reference loop. Make the article be a + ;; Yuk! This is a reference loop. Make the article be a ;; root article. (progn + (debug) (mail-header-set-references (car (symbol-value id-dep)) "none") (setq ref nil)) (setq ref (gnus-parent-id (mail-header-references ref-header))))) @@ -2975,19 +2974,21 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (erase-buffer))) (kill-buffer (current-buffer))) ;; Sort over trustworthiness. - (mapc #'(lambda (relation) - (when (gnus-dependencies-add-header - (make-full-mail-header gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) - (or (caddr relation) "") 0 0 "") - gnus-newsgroup-dependencies nil) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number))) - (sort relations 'car-less-than-car)) + (mapcar + (lambda (relation) + (when (gnus-dependencies-add-header + (make-full-mail-header + gnus-reffed-article-number + (cadddr relation) "" (mail-header-date header) + (cadr relation) + (or (caddr relation) "") 0 0 "") + gnus-newsgroup-dependencies nil) + (push gnus-reffed-article-number gnus-newsgroup-limit) + (push gnus-reffed-article-number gnus-newsgroup-sparse) + (push (cons gnus-reffed-article-number gnus-sparse-mark) + gnus-newsgroup-reads) + (decf gnus-reffed-article-number))) + (sort relations 'car-less-than-car)) (gnus-message 7 "Making sparse threads...done"))) (defun gnus-build-old-threads () @@ -3010,11 +3011,78 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) +;; The following macros and functions were written by Felix Lee +;; . + +(defmacro gnus-nov-read-integer () + '(prog1 + (if (= (following-char) ?\t) + 0 + (let ((num (ignore-errors (read buffer)))) + (if (numberp num) num 0))) + (unless (eobp) + (search-forward "\t" eol 'move)))) + +(defmacro gnus-nov-skip-field () + '(search-forward "\t" eol 'move)) + +(defmacro gnus-nov-field () + '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) + +;; This function has to be called with point after the article number +;; on the beginning of the line. +(defsubst gnus-nov-parse-line (number dependencies &optional force-new) + (let ((eol (gnus-point-at-eol)) + (buffer (current-buffer)) + header rawtext) + + ;; overview: [num subject from date id refs chars lines misc] + (unwind-protect + (progn + (narrow-to-region (point) eol) + (unless (eobp) + (forward-char)) + + (setq header + (make-full-mail-header + number ; number + (progn + (setq rawtext (gnus-nov-field) ; subject + decoded (funcall + gnus-unstructured-field-decoder rawtext)) + (if (string= rawtext decoded) + rawtext + (put-text-property 0 (length decoded) 'raw-text rawtext decoded) + decoded)) + (progn + (setq rawtext (gnus-nov-field) ; from + decoded (funcall + gnus-structured-field-decoder rawtext)) + (if (string= rawtext decoded) + rawtext + (put-text-property 0 (length decoded) 'raw-text rawtext decoded) + decoded)) + (gnus-nov-field) ; date + (or (gnus-nov-field) + (nnheader-generate-fake-message-id)) ; id + (gnus-nov-field) ; refs + (gnus-nov-read-integer) ; chars + (gnus-nov-read-integer) ; lines + (unless (= (following-char) ?\n) + (gnus-nov-field))))) ; misc + + (widen)) + + (when gnus-alter-header-function + (funcall gnus-alter-header-function header)) + (gnus-dependencies-add-header header dependencies force-new))) + (defun gnus-build-get-header (id) ;; Look through the buffer of NOV lines and find the header to ;; ID. Enter this line into the dependencies hash table, and return ;; the id of the parent article (if any). - (let (found header) + (let ((deps gnus-newsgroup-dependencies) + found header) (prog1 (save-excursion (set-buffer nntp-server-buffer) @@ -3030,8 +3098,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (when found (beginning-of-line) (and - (setq header (gnus-nov-parse-line (read (current-buffer)) - gnus-newsgroup-dependencies)) + (setq header (gnus-nov-parse-line + (read (current-buffer)) deps)) (gnus-parent-id (mail-header-references header)))))) (when header (let ((number (mail-header-number header))) @@ -3047,6 +3115,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (defun gnus-build-all-threads () "Read all the headers." (let ((gnus-summary-ignore-duplicates t) + (dependencies gnus-newsgroup-dependencies) found header article) (save-excursion (set-buffer nntp-server-buffer) @@ -3054,9 +3123,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (goto-char (point-min)) (while (not (eobp)) (ignore-errors - (setq article (read (current-buffer))) - (setq header (gnus-nov-parse-line article - gnus-newsgroup-dependencies))) + (setq article (read (current-buffer)) + header (gnus-nov-parse-line + article dependencies))) (when header (push header gnus-newsgroup-headers) (if (memq (setq article (mail-header-number header)) @@ -4415,89 +4484,14 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq id (mail-header-id header) ref (gnus-parent-id (mail-header-references header)))) - (setq header - (gnus-dependencies-add-header header dependencies force-new)) - (if header - (push header headers)) + (when (setq header + (gnus-dependencies-add-header + header dependencies force-new)) + (push header headers)) (goto-char (point-max)) (widen)) (nreverse headers))))) -;; The following macros and functions were written by Felix Lee -;; . - -(defmacro gnus-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (ignore-errors (read buffer)))) - (if (numberp num) num 0))) - (unless (eobp) - (search-forward "\t" eol 'move)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -;; (defvar gnus-nov-none-counter 0) - -;; This function has to be called with point after the article number -;; on the beginning of the line. -(defun gnus-nov-parse-line (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header ref id id-dep ref-dep - rawtext decoded) - - ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (progn - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - number ; number - (progn - (setq rawtext (gnus-nov-field) ; subject - decoded (funcall - gnus-unstructured-field-decoder rawtext)) - (if (string-equal rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) - (progn - (setq rawtext (gnus-nov-field) ; from - decoded (funcall - gnus-structured-field-decoder rawtext)) - (if (string-equal rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) - (gnus-nov-field) ; date - (or (gnus-nov-field) - (nnheader-generate-fake-message-id)) ; id - (gnus-nov-field) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (unless (= (following-char) ?\n) - (gnus-nov-field))))) ; misc - - (widen)) - - (when gnus-alter-header-function - (funcall gnus-alter-header-function header)) - - (setq id (mail-header-id header) - ref (gnus-parent-id (mail-header-references header))) - - (gnus-dependencies-add-header header dependencies force-new) - - header)) - ;; Goes through the xover lines and returns a list of vectors (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies @@ -6933,7 +6927,7 @@ and `request-accept' functions." ((eq action 'copy) (save-excursion (set-buffer copy-buf) - (when (gnus-request-article-this-buffer article gnus-newsgroup-name) + (when (gnus-request-original-article article gnus-newsgroup-name) (gnus-request-accept-article to-newsgroup select-method (not articles))))) ;; Crosspost the article. @@ -6954,7 +6948,7 @@ and `request-accept' functions." (save-excursion (set-buffer copy-buf) ;; First put the article in the destination group. - (gnus-request-article-this-buffer article gnus-newsgroup-name) + (gnus-request-original-article article gnus-newsgroup-name) (when (consp (setq art-group (gnus-request-accept-article to-newsgroup select-method (not articles)))) @@ -7047,7 +7041,7 @@ and `request-accept' functions." (when (eq action 'crosspost) (save-excursion (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) + (gnus-request-original-article article gnus-newsgroup-name) (nnheader-replace-header "Xref" new-xref) (gnus-request-replace-article article gnus-newsgroup-name (current-buffer))))) @@ -8949,9 +8943,17 @@ save those articles instead." ;;; @ for mime-partial ;;; -(defun gnus-mime-partial-preview-function () - (gnus-summary-preview-mime-message (gnus-summary-article-number)) - ) +(defun gnus-request-partial-message () + (save-excursion + (let ((number (gnus-summary-article-number)) + (group gnus-newsgroup-name) + (mother gnus-article-buffer)) + (set-buffer (get-buffer-create " *Partial Article*")) + (erase-buffer) + (setq mime-preview-buffer mother) + (gnus-request-original-article number group) + (mime-parse-buffer) + ))) (autoload 'mime-combine-message/partial-pieces-automatically "mime-partial" @@ -8962,12 +8964,9 @@ save those articles instead." (major-mode . gnus-original-article-mode) (method . mime-combine-message/partial-pieces-automatically) (summary-buffer-exp . gnus-summary-buffer) + (request-partial-message-method . gnus-request-partial-message) )) -(set-alist 'mime-view-partial-message-method-alist - 'gnus-original-article-mode - 'gnus-mime-partial-preview-function) - ;;; @ end ;;; diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 249367d..15e036b 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -166,9 +166,10 @@ with some simple extensions. (when result (symbol-name result)))) -(defun gnus-current-topics () - "Return a list of all current topics, lowest in hierarchy first." - (let ((topic (gnus-current-topic)) +(defun gnus-current-topics (&optional topic) + "Return a list of all current topics, lowest in hierarchy first. +If TOPIC, start with that topic." + (let ((topic (or topic (gnus-current-topic))) topics) (while topic (push topic topics) @@ -199,7 +200,8 @@ with some simple extensions. active (- (1+ (cdr active)) (car active)))) clevel (or (gnus-info-level info) - (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)))) + (if (member group gnus-zombie-list) + gnus-level-zombie gnus-level-killed)))) (and unread ; nil means that the group is dead. (<= clevel level) @@ -324,27 +326,32 @@ with some simple extensions. (defun gnus-group-topic-parameters (group) "Compute the group parameters for GROUP taking into account inheritance from topics." - (let ((params-list (list (gnus-group-get-parameter group))) - topics params param out) + (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) (save-excursion (gnus-group-goto-group group) - (setq topics (gnus-current-topics)) - (while topics - (push (gnus-topic-parameters (pop topics)) params-list)) - ;; We probably have lots of nil elements here, so - ;; we remove them. Probably faster than doing this "properly". - (setq params-list (delq nil params-list)) - ;; Now we have all the parameters, so we go through them - ;; and do inheritance in the obvious way. - (while (setq params (pop params-list)) - (while (setq param (pop params)) - (when (atom param) - (setq param (cons param t))) - ;; Override any old versions of this param. - (setq out (delq (assq (car param) out) out)) - (push param out))) - ;; Return the resulting parameter list. - out))) + (nconc params-list + (gnus-topic-hierarchical-parameters (gnus-current-topic)))))) + +(defun gnus-topic-hierarchical-parameters (topic) + "Return a topic list computed for TOPIC." + (let ((topics (gnus-current-topics topic)) + params-list param out params) + (while topics + (push (gnus-topic-parameters (pop topics)) params-list)) + ;; We probably have lots of nil elements here, so + ;; we remove them. Probably faster than doing this "properly". + (setq params-list (delq nil params-list)) + ;; Now we have all the parameters, so we go through them + ;; and do inheritance in the obvious way. + (while (setq params (pop params-list)) + (while (setq param (pop params)) + (when (atom param) + (setq param (cons param t))) + ;; Override any old versions of this param. + (setq out (delq (assq (car param) out) out)) + (push param out))) + ;; Return the resulting parameter list. + out)) ;;; General utility functions @@ -406,7 +413,13 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." If SILENT, don't insert anything. Return the number of unread articles in the topic and its subtopics." (let* ((type (pop topicl)) - (entries (gnus-topic-find-groups (car type) list-level all lowest)) + (entries (gnus-topic-find-groups + (car type) list-level + (or all + (cdr (assq 'visible + (gnus-topic-hierarchical-parameters + (car type))))) + lowest)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) @@ -1254,6 +1267,10 @@ If COPYP, copy the groups instead." ;; Check whether the new name exists. (when (gnus-topic-find-topology new-name) (error "Topic '%s' already exists")) + ;; "nil" is an invalid name, for reasons I'd rather not go + ;; into here. Trust me. + (when (equal new-name "nil") + (error "Invalid name: %s" nil)) ;; Do the renaming. (let ((top (gnus-topic-find-topology old-name)) (entry (assoc old-name gnus-topic-alist)))