From c66544cbcf56f439e6fc8c07079c829e7e16d1e0 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 06:38:23 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 39 ++++++++ lisp/dgnushack.el | 7 +- lisp/gnus-cache.el | 81 ++++++++-------- lisp/gnus-picon.el | 24 ++--- lisp/gnus-score.el | 26 +++++ lisp/gnus-uu.el | 4 +- lisp/gnus-vis.el | 11 ++- lisp/gnus.el | 230 ++++++++++++++++++++++++++------------------- lisp/nndoc.el | 20 ++-- lisp/nnml.el | 5 +- lisp/nnspool.el | 155 ++++++++++++++++-------------- texi/ChangeLog | 18 ++++ texi/gnus.texi | 57 ++++++++++- 13 files changed, 431 insertions(+), 246 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7f91d05c9..232a1aed4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,8 +1,47 @@ +Sun Dec 17 16:06:11 1995 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-guess-digest-type): Didn't grok MIME digests. + + * gnus.el (gnus-all-windows-visible-p): Would bug out on buffers + that didn't exist. + (gnus-all-windows-visible-p): Allow strings in buffer-config. + (gnus-configure-frame): Ditto. + (gnus-remove-text-with-property): Didn't remove all text. + + * gnus-uu.el (gnus-uu-grab-articles): Would delete files after + decoding them. + +Sun Dec 17 00:12:34 1995 Lars Ingebrigtsen + + * gnus-score.el (gnus-score-followup-article): New command. + (gnus-score-followup-thread): New command. + + * gnus.el (gnus-compile): New implementation; save in + .newsrc.eld. + (gnus-summary-rethread-thread): New command and keystroke. + +Sat Dec 16 22:22:58 1995 Lars Ingebrigtsen + + * nnspool.el (nnspool-find-article-by-message-id): Decompose the + output; renamed. + (nnspool-request-article): Use the function. + (nnspool-retrieve-headers): Ditto. + + * gnus.el (gnus-group-catchup): Do the auto-expirable thaang. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Don't enter + empty articles into the cache. + + * nnspool.el (nnspool-find-nov-line): Would often not find the + right line. + Sat Dec 16 14:26:27 1995 Lars Magne Ingebrigtsen * gnus.el (gnus-summary-exit): Would nix out the group name of parents to nndoc groups. + * gnus.el: 0.23 is released. + Fri Dec 15 20:55:26 1995 Lars Ingebrigtsen * gnus.el (gnus-buffer-configuration): New default value. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 33c2a731a..d285b6f54 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -44,9 +44,12 @@ (setq byte-compile-warnings '(free-vars unresolved callargs redefine obsolete)))) (and (or (and (not (string= file "gnus-xmas.el")) - (not (string= file "x-easymenu.el"))) + (not (string= file "x-easymenu.el")) + (not (string= file "gnus-picon.el"))) xemacs) - (byte-compile-file file))))) + (condition-case () + (byte-compile-file file) + (error nil)))))) (defun dgnushack-recompile () (require 'gnus) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 6e52f4f55..fe30f4622 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -128,45 +128,44 @@ variable to \"^nnml\".") (gnus-summary-select-article)) (save-excursion (set-buffer gnus-original-article-buffer) - (save-restriction - (widen) - (write-region (point-min) (point-max) file nil 'quiet)) - (gnus-cache-change-buffer group) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-max)) - (forward-line -1) - (while (condition-case () - (and (not (bobp)) - (> (read (current-buffer)) number)) - (error - ;; The line was malformed, so we just remove it!! - (gnus-delete-line) - t)) - (forward-line -1)) - (if (bobp) - (if (not (eobp)) - (progn - (beginning-of-line) - (if (< (read (current-buffer)) number) - (forward-line 1))) - (beginning-of-line)) - (forward-line 1)) - (beginning-of-line) - ;; [number subject from date id references chars lines xref] - (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" - (mail-header-number headers) - (mail-header-subject headers) - (mail-header-from headers) - (mail-header-date headers) - (mail-header-id headers) - (or (mail-header-references headers) "") - (or (mail-header-chars headers) "") - (or (mail-header-lines headers) "") - (or (mail-header-xref headers) "")))) - ;; Update the active info. - (gnus-cache-update-active group number) - (push number gnus-newsgroup-cached) - t))))) + (when (> (buffer-size) 0) + (write-region (point-min) (point-max) file nil 'quiet) + (gnus-cache-change-buffer group) + (set-buffer (cdr gnus-cache-buffer)) + (goto-char (point-max)) + (forward-line -1) + (while (condition-case () + (and (not (bobp)) + (> (read (current-buffer)) number)) + (error + ;; The line was malformed, so we just remove it!! + (gnus-delete-line) + t)) + (forward-line -1)) + (if (bobp) + (if (not (eobp)) + (progn + (beginning-of-line) + (if (< (read (current-buffer)) number) + (forward-line 1))) + (beginning-of-line)) + (forward-line 1)) + (beginning-of-line) + ;; [number subject from date id references chars lines xref] + (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" + (mail-header-number headers) + (mail-header-subject headers) + (mail-header-from headers) + (mail-header-date headers) + (mail-header-id headers) + (or (mail-header-references headers) "") + (or (mail-header-chars headers) "") + (or (mail-header-lines headers) "") + (or (mail-header-xref headers) ""))) + ;; Update the active info. + (gnus-cache-update-active group number) + (push number gnus-newsgroup-cached)) + t)))))) (defun gnus-cache-enter-remove-article (article) "Mark ARTICLE for later possible removal." @@ -503,9 +502,9 @@ If LOW, update the lower bound instead." (string-match (concat "^" (file-name-as-directory (expand-file-name gnus-cache-directory))) - directory) + (file-name-as-directory directory)) (gnus-replace-chars-in-string - (substring directory (match-end 0)) + (substring (file-name-as-directory directory) (match-end 0)) ?/ ?.))) nums alphs) (when top diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 9e0d4a381..36437edb1 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -53,19 +53,19 @@ (beginning-of-buffer) (open-line 1) (let* ((iconpoint (point)) (from (mail-fetch-field "from")) - (username - (progn - (string-match "\\([-_a-zA-Z0-9]+\\)@" from) - (match-string 1 from))) - (hostpath - (gnus-picons-reverse-domain-path - (replace-in-string - (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*" "\\1") - "\\." "/")))) + (username + (progn + (string-match "\\([-_a-zA-Z0-9]+\\)@" from) + (match-string 1 from))) + (hostpath + (gnus-picons-reverse-domain-path + (replace-in-string + (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*" "\\1") + "\\." "/")))) (if (equal username from) - (setq username (replace-in-string from - ".*<\\([_a-zA-Z0-9-.]+\\)>.*" - "\\1"))) + (setq username (replace-in-string from + ".*<\\([_a-zA-Z0-9-.]+\\)>.*" + "\\1"))) (insert username) (gnus-picons-insert-face-if-exists (concat gnus-picons-database "/" gnus-picons-news-directory) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 0c1d3d65d..c77f30d0f 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -597,6 +597,32 @@ SCORE is the score to add." (gnus-score-set 'expunge (list score)) (gnus-score-set 'touched '(t))) +(defun gnus-score-followup-article (&optional score) + "Add SCORE to all followups to the article in the current buffer." + (interactive "P") + (setq score (gnus-score-default score)) + (save-excursion + (save-restriction + (goto-char (point-min)) + (let ((id (mail-fetch-field "message-id"))) + (when id + (gnus-summary-score-entry + "references" (concat id "[ \t]*$") 'r + score (current-time-string))))))) + +(defun gnus-score-followup-thread (&optional score) + "Add SCORE to all later articles in the thread the current buffer is part of." + (interactive "P") + (setq score (gnus-score-default score)) + (save-excursion + (save-restriction + (goto-char (point-min)) + (let ((id (mail-fetch-field "message-id"))) + (when id + (gnus-summary-score-entry + "references" id 's + score (current-time-string))))))) + (defun gnus-score-set (symbol value &optional alist) ;; Set SYMBOL to VALUE in ALIST. (let* ((alist diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index e8c06de9e..6664d675a 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1164,8 +1164,8 @@ The headers will be included in the sequence they are matched.") ;; If this is the last article to be decoded, and ;; we still haven't reached the end, then we delete ;; the partially decoded file. - (and (or (eq state 'last) (eq state 'first-and-last) - (not (memq 'end process-state))) + (and (or (eq state 'last) (eq state 'first-and-last)) + (not (memq 'end process-state)) result-file (file-exists-p result-file) (delete-file result-file)) diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el index e8dd00226..00aac6096 100644 --- a/lisp/gnus-vis.el +++ b/lisp/gnus-vis.el @@ -1486,22 +1486,23 @@ specified by `gnus-button-alist'." (defvar gnus-prev-page-map nil) (unless gnus-prev-page-map (setq gnus-prev-page-map (make-sparse-keymap)) - (define-key gnus-prev-page-map "\n" 'gnus-article-prev-page)) + (define-key gnus-prev-page-map gnus-mouse-2 'gnus-article-prev-page) + (define-key gnus-prev-page-map "\r" 'gnus-article-prev-page)) (defun gnus-insert-prev-page-button () (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) (gnus-eval-format gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map)))) (defvar gnus-next-page-map nil) (unless gnus-next-page-map - (setq gnus-next-page-map (make-sparse-keymap)) - (define-key gnus-next-page-map "\n" 'gnus-article-next-page)) + (setq gnus-next-page-map (make-keymap)) + (suppress-keymap gnus-prev-page-map) + (define-key gnus-next-page-map gnus-mouse-2 'gnus-article-next-page) + (define-key gnus-next-page-map "\r" 'gnus-article-next-page)) (defun gnus-insert-next-page-button () (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-next) (gnus-eval-format gnus-next-page-line-format nil `(gnus-next t local-map ,gnus-next-page-map)))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 8f8d3b3e3..30938d866 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -775,14 +775,18 @@ beginning of a line.") (summary 1.0 point) (if gnus-carpal (summary-carpal 4)))) (article - (vertical 1.0 - (if gnus-use-picon - '(horizontal 0.25 - (summary 1.0 point) - (picon 10)) - '(summary 0.25 point)) - (if gnus-carpal (summary-carpal 4)) - (article 1.0))) + (if gnus-use-picon + '(frame 1.0 + (vertical 1.0 + (summary 0.25 point) + (if gnus-carpal (summary-carpal 4)) + (article 1.0)) + (vertical 1.0 + (picon 1.0))) + '(vertical 1.0 + (summary 0.25 point) + (if gnus-carpal (summary-carpal 4)) + (article 1.0)))) (server (vertical 1.0 (server 1.0 point) @@ -1571,7 +1575,7 @@ variable (string, integer, character, etc).") "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") -(defconst gnus-version "September Gnus v0.23" +(defconst gnus-version "September Gnus v0.24" "Version number for this version of Gnus.") (defvar gnus-info-nodes @@ -1604,7 +1608,8 @@ variable (string, integer, character, etc).") gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist) + gnus-topic-topology gnus-topic-alist + gnus-format-specs) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-options nil @@ -1924,7 +1929,7 @@ Thank you for your help in stamping out bugs. gnus-summary-reply gnus-summary-reply-with-original gnus-summary-mail-forward gnus-summary-mail-other-window gnus-bug) - ("gnus-picon" gnus-article-display-picon) + ("gnus-picon" gnus-article-display-picons) ("gnus-vm" gnus-vm-mail-setup) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm gnus-yank-article)))) @@ -2195,10 +2200,12 @@ Thank you for your help in stamping out bugs. (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) -(defvar gnus-old-specs - '((group . "%M%S%p%5y: %(%g%)\n") - (summary-dummy . "* : : %S\n") - (summary . "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"))) +(defvar gnus-format-specs + `((version . ,emacs-version) + (group ,gnus-group-line-format ,gnus-group-line-format-spec) + (summary-dummy ,gnus-summary-dummy-line-format + ,gnus-summary-dummy-line-format-spec) + (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec))) (defvar gnus-article-mode-line-format-spec nil) (defvar gnus-summary-mode-line-format-spec nil) @@ -2288,32 +2295,44 @@ Thank you for your help in stamping out bugs. (defun gnus-update-format-specifications (&optional force) + "Update all (necessary) format specifications." + ;; Make the indentation array. (gnus-make-thread-indent-array) - (when force - (setq gnus-old-specs nil)) + (when (or force + (and (assq 'version gnus-format-specs) + (not (equal emacs-version + (cdr (assq 'version gnus-format-specs)))))) + (setq gnus-format-specs nil)) - (let ((formats '(summary summary-dummy group + (let ((types '(summary summary-dummy group summary-mode group-mode article-mode)) - old-format new-format) - (while formats + old-format new-format entry type val) + (while types + (setq type (pop types)) (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" (car formats))))) - (or (and (setq old-format (cdr (assq (car formats) gnus-old-specs))) - (equal old-format new-format)) - (set (intern (format "gnus-%s-line-format-spec" (car formats))) - (if (not (stringp new-format)) new-format - (gnus-parse-format + (intern (format "gnus-%s-line-format" type)))) + (setq entry (cdr (assq type gnus-format-specs))) + (if (and entry + (equal (car entry) new-format)) + (set (intern (format "gnus-%s-line-format-spec" type)) + (car (cdr entry))) + (setq val + (if (not (stringp new-format)) + ;; This is a function call or something. new-format - (symbol-value - (intern (format "gnus-%s-line-format-alist" - (if (eq (car formats) 'article-mode) - 'summary-mode (car formats))))) - (not (string-match "mode$" (symbol-name (car formats)))))))) - (setq gnus-old-specs (cons (cons (car formats) new-format) - (delq (assq (car formats) gnus-old-specs) - gnus-old-specs))) - (setq formats (cdr formats)))) + ;; This is a "real" format. + (gnus-parse-format + new-format + (symbol-value + (intern (format "gnus-%s-line-format-alist" + (if (eq type 'article-mode) + 'summary-mode type)))) + (not (string-match "mode$" (symbol-name type)))))) + (set (intern (format "gnus-%s-line-format-spec" type)) val) + (if entry + (setcar (cdr entry) val) + (push (list type new-format val) gnus-format-specs))))) (gnus-update-group-mark-positions) (gnus-update-summary-mark-positions) @@ -2555,7 +2574,7 @@ If INSERT, insert the result." (save-excursion (goto-char (point-min)) (while (not (eobp)) - (when (get-text-property (point) prop) + (while (get-text-property (point) prop) (delete-char 1)) (goto-char (next-single-property-change (point) prop nil (point-max)))))) @@ -3036,15 +3055,19 @@ If optional argument RE-ONLY is non-nil, strip `Re:' only." ((null split)) ;; This is a buffer to be selected. ((not (or (eq type 'horizontal) (eq type 'vertical))) - (let ((buffer (cdr (assq type gnus-window-to-buffer)))) + (let ((buffer (cond ((stringp type) type) + (t (cdr (assq type gnus-window-to-buffer))))) + buf) (unless buffer (error "Illegal buffer type: %s" type)) - (switch-to-buffer (get-buffer (if (symbolp buffer) - (symbol-value buffer) - buffer))) + (unless (setq buf (get-buffer (if (symbolp buffer) + (symbol-value buffer) buffer))) + (setq buf (get-buffer-create (if (symbolp buffer) + (symbol-value buffer) buffer)))) + (switch-to-buffer buf) ;; We return the window if it has the `point' spec. (and (memq 'point split) window))) - ;; This is a normal split + ;; This is a normal split. (t (when (> (length subs) 0) ;; First we have to compute the sizes of all new windows. @@ -3141,14 +3164,14 @@ If optional argument RE-ONLY is non-nil, strip `Re:' only." ((null split) t) ((not (or (eq type 'horizontal) (eq type 'vertical))) - (let ((buffer (cdr (assq type gnus-window-to-buffer))) - win) + (let ((buffer (cond ((stringp type) type) + (t (cdr (assq type gnus-window-to-buffer))))) + win buf) (unless buffer (error "Illegal buffer type: %s" type)) - (setq win - (get-buffer-window (get-buffer (if (symbolp buffer) - (symbol-value buffer) - buffer)))) + (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer) + buffer))) + (setq win (get-buffer-window buf))) (when win (if (memq 'point split) win @@ -3995,50 +4018,27 @@ prompt the user for the name of an NNTP server to use." (setq history (cdr history))))) (defun gnus-compile () - "Byte-compile the Gnus startup file. -This will also compile the user-defined format specs." + "Byte-compile the user-defined format specs." (interactive) - (let ((file (concat (make-temp-name "/tmp/gnuss") ".el"))) + (let ((entries gnus-format-specs) + entry gnus-tmp-func) (save-excursion - (gnus-message 7 "Compiling user file...") - (nnheader-set-temp-buffer " *compile gnus*") - (and (file-exists-p gnus-init-file) - (insert-file gnus-init-file)) - (goto-char (point-max)) + (gnus-message 7 "Compiling format specs...") - (let ((formats '(summary summary-dummy group - summary-mode group-mode article-mode)) - format fs) - - (while formats - (setq format (symbol-name (car formats)) - formats (cdr formats) - fs (cons (symbol-value - (intern (format "gnus-%s-line-format" format))) - fs)) - (insert "(defun gnus-" format "-line-format-spec ()\n") - (insert - (prin1-to-string - (symbol-value - (intern (format "gnus-%s-line-format-spec" format))))) - (insert ")\n") - (insert "(setq gnus-" format - "-line-format-spec (list 'gnus-byte-code 'gnus-" - format "-line-format-spec))\n")) - - (insert "(setq gnus-old-specs '" (prin1-to-string fs) ")\n") - - (write-region (point-min) (point-max) file nil 'silent) - (byte-compile-file file) - (rename-file - (concat file "c") - (concat gnus-init-file - (if (string-match "\\.el$" gnus-init-file) "c" ".elc")) - t) - (when (file-exists-p file) - (delete-file file)) - (kill-buffer (current-buffer))) - (gnus-message 7 "Compiling user file...done")))) + (while entries + (setq entry (pop entries)) + (if (eq (car entry) 'version) + (setq gnus-format-specs (delq entry gnus-format-specs)) + (when (and (listp (caddr entry)) + (not (eq 'byte-code (caaddr entry)))) + (fset 'gnus-tmp-func + `(lambda () ,(caddr entry))) + (byte-compile 'gnus-tmp-func) + (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) + + (push (cons 'version emacs-version) gnus-format-specs) + + (gnus-message 7 "Compiling user specs...done")))) (defun gnus-indent-rigidly (start end arg) "Indent rigidly using only spaces and no tabs." @@ -5520,11 +5520,20 @@ If ALL is non-nil, all articles are marked as read. The return value is the number of articles that were marked as read, or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (num (car entry)) - (marked (nth 3 (nth 2 entry)))) + (num (car entry))) + ;; Do the updating only if the newsgroup isn't killed. (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up; non-active group") - ;; Do the updating only if the newsgroup isn't killed. + ;; Do auto-expirable marks if that's required. + (when (gnus-group-auto-expirable-p group) + (gnus-add-marked-articles + group 'expire (gnus-list-of-unread-articles group)) + (when all + (let ((marks (nth 3 (nth 2 entry)))) + (gnus-add-marked-articles + group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) + (gnus-add-marked-articles + group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) (when entry (gnus-update-read-articles group nil) ;; Also nix out the lists of marks and dormants. @@ -6672,6 +6681,7 @@ buffer. (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread) (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread) (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads) + (define-key gnus-summary-thread-map "T" 'gnus-summary-rethread-current) (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread) (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads) (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread) @@ -11638,6 +11648,19 @@ with that article." ;; Return the list of articles. (nreverse articles)))) +(defun gnus-summary-rethread-current () + "Rethread the thread the current article is part of." + (interactive) + (gnus-set-global-variables) + (let* ((gnus-show-threads t) + (article (gnus-summary-article-number)) + (id (mail-header-id (gnus-summary-article-header))) + (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) + (unless id + (error "No article on the current line")) + (gnus-rebuild-thread id) + (gnus-summary-goto-subject article))) + (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. If ARG is positive number, turn showing conversation threads on." @@ -13214,23 +13237,32 @@ If given a numerical ARG, move forward ARG pages." (set-buffer gnus-article-buffer) (goto-char (point-min)) (widen) + (when (gnus-visual-p 'page-marker) + (let ((buffer-read-only nil)) + (gnus-remove-text-with-property 'gnus-prev) + (gnus-remove-text-with-property 'gnus-next))) (when (cond ((< arg 0) (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) ((> arg 0) (re-search-forward page-delimiter nil 'move arg))) (goto-char (match-end 0))) - (when (and (gnus-visual-p 'page-marker) - (not (bolp))) - (gnus-insert-prev-page-button)) (narrow-to-region (point) (if (re-search-forward page-delimiter nil 'move) - (prog1 (match-beginning 0) - (when (and (gnus-visual-p 'page-marker) - (not (bolp))) - (gnus-insert-next-page-button))) - (point))))) + (match-beginning 0) + (point))) + (when (and (gnus-visual-p 'page-marker) + (not (= (point-min) 1))) + (save-excursion + (goto-char (point-min)) + (gnus-insert-prev-page-button))) + (when (and (gnus-visual-p 'page-marker) + (not (= (1- (point-max)) (buffer-size)))) + (save-excursion + (goto-char (point-max)) + (gnus-insert-next-page-button))))) + ;; Article mode commands diff --git a/lisp/nndoc.el b/lisp/nndoc.el index c1ac47dd5..5a408f1e8 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -29,7 +29,7 @@ (require 'rmail) (require 'nnmail) -(defvar nndoc-article-type 'mbox +(defvar nndoc-article-type 'guess "*Type of the file. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', `mime-digest', `standard-digest', `slack-digest', or @@ -66,6 +66,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', (prepare-body . nndoc-prepare-digest-body)) (mime-digest (article-begin . "") + (head-end . "^ ?$") (body-end . "") (file-end . "")) (standard-digest @@ -253,6 +254,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', (cond ;; The current buffer is this group's buffer. ((and nndoc-current-buffer + (buffer-name nndoc-current-buffer) (eq nndoc-current-buffer (setq buf (cdr (assoc group nndoc-group-alist)))))) ;; We change buffers by taking an old from the group alist. @@ -270,6 +272,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', (get-buffer-create (concat " *nndoc " group "*")))) nndoc-group-alist)) + (setq nndoc-dissection-alist nil) (save-excursion (set-buffer nndoc-current-buffer) (buffer-disable-undo (current-buffer)) @@ -277,7 +280,8 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', (if (stringp nndoc-address) (insert-file-contents nndoc-address) (insert-buffer-substring nndoc-address))))) - (when nndoc-current-buffer + (when (and nndoc-current-buffer + (not nndoc-dissection-alist)) (save-excursion (set-buffer nndoc-current-buffer) (nndoc-set-delims) @@ -293,7 +297,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', ;; MIME digest. ((and (re-search-forward - (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]" + (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") nil t) (match-beginning 1)) @@ -302,9 +306,12 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', (setq entry (assq 'mime-digest nndoc-type-alist)) (setcdr entry (list + (cons 'head-end "^ ?$") + (cons 'body-begin "^ \n") (cons 'article-begin b-delimiter) - (cons 'body-end - (concat "\n--" boundary-id "\\(--\\)?[\n \t]+")) + (cons 'body-end-function 'nndoc-digest-body-end) +; (cons 'body-end +; (concat "\n--" boundary-id "\\(--\\)?[\n \t]+")) (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) 'mime-digest) ((and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) @@ -395,8 +402,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', (setq body-end (point)) (push (list (incf i) head-begin head-end body-begin body-end (count-lines body-begin body-end)) - nndoc-dissection-alist) - )))) + nndoc-dissection-alist))))) (defun nndoc-prepare-digest-body () "Unquote quoted non-separators in digests." diff --git a/lisp/nnml.el b/lisp/nnml.el index d4168d1fc..52916ee8c 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -33,8 +33,6 @@ (require 'nnmail) (eval-when-compile (require 'cl)) -(require 'cl) - (defvar nnml-directory "~/Mail/" "Mail spool directory.") @@ -721,7 +719,8 @@ all. This may very well take some time.") (let ((group (nnmail-replace-chars-in-string (substring dir (length nnml-directory)) ?/ ?.))) - (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist)) + (setq nnml-group-alist + (delq (assoc group nnml-group-alist) nnml-group-alist)) (push (list group (cons (car files) (let ((f files)) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 3cdeb3e2a..2fbeee8f0 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -114,48 +114,52 @@ there.") ;;; Interface functions. -(defun nnspool-retrieve-headers (sequence &optional newsgroup server fetch-old) - "Retrieve the headers for the articles in SEQUENCE. -Newsgroup must be selected before calling this function." +(defun nnspool-retrieve-headers (articles &optional group server fetch-old) + "Retrieve the headers of ARTICLES." (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (let* ((number (length sequence)) - (count 0) - (do-message (and (numberp nnspool-large-newsgroup) - (> number nnspool-large-newsgroup))) - file beg article) - (if (not (nnspool-possibly-change-directory newsgroup)) - () - (if (and (numberp (car sequence)) - (nnspool-retrieve-headers-with-nov sequence fetch-old)) + (when (nnspool-possibly-change-directory group) + (let* ((number (length articles)) + (count 0) + (do-message (and (numberp nnspool-large-newsgroup) + (> number nnspool-large-newsgroup))) + file beg article ag) + (if (and (numberp (car articles)) + (nnspool-retrieve-headers-with-nov articles fetch-old)) + ;; We successfully retrieved the NOV headers. 'nov - (while sequence - (setq article (car sequence)) + ;; No NOV headers here, so we do it the hard way. + (while articles + (setq article (pop articles)) (if (stringp article) - (progn - (setq file (nnspool-find-article-by-message-id article)) - (setq article 0)) - (setq file (concat nnspool-current-directory - (int-to-string article)))) - (and file (file-exists-p file) - (progn - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (nnheader-insert-head file) - (goto-char beg) - (search-forward "\n\n" nil t) - (forward-char -1) - (insert ".\n") - (delete-region (point) (point-max)))) - (setq sequence (cdr sequence)) + ;; This is a Message-ID. + (setq ag (nnspool-find-id article) + file (and ag (nnspool-article-pathname + (car ag) (cdr ag))) + article (cdr ag)) + ;; This is an article in the current group. + (setq file (nnspool-article-pathname + nnspool-current-group article))) + ;; Insert the head of the article. + (when (and file + (file-exists-p file)) + (insert (format "221 %d Article retrieved.\n" article)) + (setq beg (point)) + (nnheader-insert-head file) + (goto-char beg) + (search-forward "\n\n" nil t) + (forward-char -1) + (insert ".\n") + (delete-region (point) (point-max))) (and do-message - (zerop (% (setq count (1+ count)) 20)) - (message "NNSPOOL: Receiving headers... %d%%" + (zerop (% (incf count) 20)) + (message "nnspool: Receiving headers... %d%%" (/ (* count 100) number)))) - (and do-message (message "NNSPOOL: Receiving headers...done")) + (and do-message + (message "nnspool: Receiving headers...done")) ;; Fold continuation lines. (goto-char (point-min)) @@ -193,26 +197,28 @@ Newsgroup must be selected before calling this function." "Return server status response as string." nnspool-status-string) -(defun nnspool-request-article (id &optional newsgroup server buffer) +(defun nnspool-request-article (id &optional group server buffer) "Select article by message ID (or number)." - (nnspool-possibly-change-directory newsgroup) - (let* ((group (if (stringp id) - (nnspool-find-article-by-message-id id) - nnspool-current-group)) - (file (and group (nnspool-article-pathname group id))) - (nntp-server-buffer (or buffer nntp-server-buffer))) + (nnspool-possibly-change-directory group) + (let ((nntp-server-buffer (or buffer nntp-server-buffer)) + file ag) + (if (stringp id) + ;; This is a Message-ID. + (when (setq ag (nnspool-find-id id)) + (setq file (nnspool-article-pathname (car ag) (cdr ag)))) + (setq file (nnspool-article-pathname nnspool-current-group id))) (and file (file-exists-p file) (not (file-directory-p file)) (save-excursion (nnspool-find-file file)) - ;; We return the article number. + ;; We return the article number and group name. (if (numberp id) - (cons newsgroup id) - (cons group id))))) + (cons nnspool-current-group id) + ag)))) -(defun nnspool-request-body (id &optional newsgroup server) +(defun nnspool-request-body (id &optional group server) "Select article body by message ID (or number)." - (nnspool-possibly-change-directory newsgroup) + (nnspool-possibly-change-directory group) (if (nnspool-request-article id) (save-excursion (set-buffer nntp-server-buffer) @@ -221,9 +227,9 @@ Newsgroup must be selected before calling this function." (delete-region (point-min) (point))) t))) -(defun nnspool-request-head (id &optional newsgroup server) +(defun nnspool-request-head (id &optional group server) "Select article head by message ID (or number)." - (nnspool-possibly-change-directory newsgroup) + (nnspool-possibly-change-directory group) (if (nnspool-request-article id) (save-excursion (set-buffer nntp-server-buffer) @@ -403,24 +409,27 @@ Newsgroup must be selected before calling this function." (cur (current-buffer)) (prev (point-min)) num found) - (if (or (eobp) - (>= (setq num (read cur)) article)) - (beginning-of-line) - (while (not found) - (goto-char (/ (+ max min) 2)) - (forward-line 1) - (if (or (= (point) prev) - (eobp)) - (setq found t) - (setq prev (point)) - (cond ((> (setq num (read cur)) article) - (setq max (point))) - ((< num article) - (setq min (point))) - (t - (setq found t)))) - (beginning-of-line))) - (or (not num) (= num article)))) + (while (not found) + (goto-char (/ (+ max min) 2)) + (beginning-of-line) + (if (or (= (point) prev) + (eobp)) + (setq found t) + (setq prev (point)) + (cond ((> (setq num (read cur)) article) + (setq max (point))) + ((< num article) + (setq min (point))) + (t + (setq found t))))) + (when (not (eq num article)) + (setq found (point)) + (forward-line 1) + (or (eobp) + (= (setq num (read cur)) article) + (goto-char found))) + (beginning-of-line) + (eq num article))) (defun nnspool-sift-nov-with-sed (articles file) @@ -434,7 +443,7 @@ Newsgroup must be selected before calling this function." ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). ;; Find out what group an article identified by a Message-ID is in. -(defun nnspool-find-article-by-message-id (id) +(defun nnspool-find-id (id) (save-excursion (set-buffer (get-buffer-create " *nnspool work*")) (buffer-disable-undo (current-buffer)) @@ -442,8 +451,8 @@ Newsgroup must be selected before calling this function." (call-process "grep" nil t nil id nnspool-history-file) (goto-char (point-min)) (prog1 - (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ \t\n]*\\)") - (buffer-substring (match-beginning 1) (match-end 1))) + (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") + (cons (match-string 1) (string-to-int (match-string 2)))) (kill-buffer (current-buffer))))) (defun nnspool-find-file (file) @@ -454,15 +463,15 @@ Newsgroup must be selected before calling this function." (progn (insert-file-contents file) t) (file-error nil))) -(defun nnspool-possibly-change-directory (newsgroup) - (if newsgroup - (let ((pathname (nnspool-article-pathname newsgroup))) +(defun nnspool-possibly-change-directory (group) + (if group + (let ((pathname (nnspool-article-pathname group))) (if (file-directory-p pathname) (progn (setq nnspool-current-directory pathname) - (setq nnspool-current-group newsgroup)) + (setq nnspool-current-group group)) (setq nnspool-status-string - (format "No such newsgroup: %s" newsgroup)) + (format "No such newsgroup: %s" group)) nil)) t)) diff --git a/texi/ChangeLog b/texi/ChangeLog index f64806bd7..e98d2d1a3 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,21 @@ +Sun Dec 17 17:38:20 1995 Lars Magne Ingebrigtsen + + * gnus.texi (Windows Configuration): Addition. + +Sun Dec 17 00:50:00 1995 Lars Ingebrigtsen + + * gnus.texi (Thread Commands): Addition. + (Post): Addition. + (Followups To Yourself): New. + +Sat Dec 16 23:33:49 1995 Lars Ingebrigtsen + + * gnus.texi (Group Parameters): Addition. + +Sat Dec 16 16:54:42 1995 Lars Magne Ingebrigtsen + + * gnus.texi (Ranges): Change. + Fri Dec 15 13:53:02 1995 Lars Ingebrigtsen * gnus.texi (Windows Configuration): Addition, change. diff --git a/texi/gnus.texi b/texi/gnus.texi index 81f117b80..6fec2c8f5 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -3176,6 +3176,15 @@ Elements that look like @samp{(score-file . "file")} will make @samp{file} into the current score file for the group in question. This means that all score commands you issue will end up in that file. +@item admin-address +When unsubscribing to a mailing list you should never send the +unsubscription notice to the mailing list itself. Instead, you'd send +messages to the administrative address. This parameter allows you to +put the admin address somewhere convenient. + +@item comment +This parameter allows you to enter a random comment on the group. + @item @var{(variable form)} You can use the group parameters to set variables local to the group you are entering. Say you want to turn threading off in @@ -4738,7 +4747,9 @@ checking/generation. @item gnus-inews-article-hook @vindex gnus-inews-article-hook This hook is called right before the article is posted. By default it -handles FCC processing (i.e., saving the article to a file.) +handles FCC processing (i.e., saving the article to a file.) You can +also have this hook add a score to all followups to the article you've +written (@pxref{Followups To Yourself}). @item gnus-inews-article-header-hook @vindex gnus-inews-article-header-hook @@ -5788,6 +5799,14 @@ Expose all hidden threads (@code{gnus-summary-show-all-threads}). @kindex T H (Summary) @findex gnus-summary-hide-all-threads Hide all threads (@code{gnus-summary-hide-all-threads}). + +@item T R +@kindex T R (Summary) +@findex gnus-summary-rethread-current +Re-thread the thread the current article is part of +(@code{gnus-summary-rethread-current}). This works even when the +summary buffer is otherwise unthreaded. + @end table The following commands are thread movement commands. They all @@ -7852,6 +7871,7 @@ silently to help keep the sizes of the score files down. * Score File Format:: What a score file may contain. * Score File Editing:: You can edit score files by hand as well. * Adaptive Scoring:: Big Sister Gnus *knows* what you read. +* Followups To Yourself:: Having Gnus notice when people answer you. * Scoring Tips:: How to score effectively. * Reverse Scoring:: That problem child of old is not problem. * Global Score Files:: Earth-spanning, ear-splitting score files. @@ -8479,6 +8499,34 @@ the length of the match is less than this variable is @code{nil}, exact matching will always be used to avoid this problem. + +@node Followups To Yourself +@section Followups To Yourself + +Gnus offers two commands for picking out the @code{Message-ID} header in +the current buffer. Gnus will then add a score rule that scores using +this @code{Message-ID} on the @code{References} header of other +articles. This will, in effect, increase the score of all articles that +respond to the article in the current buffer. Quite useful if you want +to easily note when people answer what you've said. + +@table @code +@item gnus-score-followup-article +@findex gnus-score-followup-article +This will add a score to articles that directly follow up your own +article. + +@item gnus-score-followup-thread +@findex gnus-score-followup-thread +This will add a score to all articles that appear in a thread "below" +your own article. +@end table + +@vindex gnus-inews-article-hook +These two functions are both primarily meant to be used in hooks like +@code{gnus-inews-article-hook}. + + @node Scoring Tips @section Scoring Tips @cindex scoring tips @@ -8970,6 +9018,9 @@ you want to change the @code{article} setting, you could say: (article 1.0)))) @end lisp +You'd typically stick these @code{gnus-add-configuration} calls in your +@file{.gnus} file or in some startup hook -- they should be run after +Gnus has been loaded. @node Buttons @@ -10056,6 +10107,7 @@ one looong line, then that's ok. The meaning of the various atoms are explained elsewhere in this manual. + @node Headers @subsection Headers @@ -10081,6 +10133,7 @@ they all have predicatable names beginning with @code{mail-header-} and The @code{xref} slot is really a @code{misc} slot. Any extra info will be put in there. + @node Ranges @subsection Ranges @@ -10116,7 +10169,7 @@ This means that comparing two ranges to find out whether they are equal is slightly tricky: @example -((1 . 6) 7 8 (10 . 12)) +((1 . 5) 7 8 (10 . 12)) @end example and -- 2.25.1