From 284704d7407076633373a3f6643e54598d39fdf2 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 09:10:28 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 73 ++++++++++++++++++++++++ lisp/gnus-msg.el | 21 ++++--- lisp/gnus-vis.el | 10 ++-- lisp/gnus-vm.el | 3 +- lisp/gnus-xmas.el | 10 ++-- lisp/gnus.el | 81 +++++++++++++++++--------- lisp/message.el | 67 +++++++++++++++++++--- lisp/nnbabyl.el | 24 ++++++++ lisp/nndb.el | 5 +- lisp/nndoc.el | 6 +- lisp/nnfolder.el | 41 +++++++------ lisp/nnheader.el | 142 +++++++++++++++++++++++++++++++++++++++++----- lisp/nnmail.el | 7 +-- lisp/nnmbox.el | 16 +++--- lisp/nnmh.el | 1 - lisp/nnml.el | 18 ++++-- lisp/nnsoup.el | 2 +- lisp/nnspool.el | 36 +++++++++++- lisp/nnvirtual.el | 23 +++----- texi/gnus.texi | 8 --- 20 files changed, 454 insertions(+), 140 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5100602d5..c8f1f47bf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,78 @@ +Wed Apr 24 04:04:54 1996 Lars Magne Ingebrigtsen + + * message.el (message-syntax-checks): Doc fix. + +Wed Apr 24 05:08:10 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-process-prefix): Make sure `mark-active' is + bound. + +Wed Apr 24 05:06:42 1996 Lars Magne Ingebrigtsen + + * gnus-xmas.el (gnus-xmas-define): Would make compilation + difficult. + +Wed Apr 24 02:20:08 1996 Lars Magne Ingebrigtsen + + * message.el (message-unsent-separator): New variable. + + * gnus.el (gnus-summary-edit-article-done): Nix out original + article. + +Wed Apr 24 01:31:17 1996 Lars Magne Ingebrigtsen + + * gnus-vis.el (gnus-summary-make-menu-bar): Used + `region-exists-p'. + +Wed Apr 24 00:11:28 1996 Lars Magne Ingebrigtsen + + * message.el (message-unix-mail-delimiter): New variable. + + * nnbabyl.el (nnbabyl-check-mbox): New command. + + * nnspool.el (nnspool-insert-nov-head): New function. + (nnspool-retrieve-headers-with-nov): Use it to protect against + unsynched NOV files. + + * nnheader.el (nnheader-insert-nov): New function. + (nnheader-parse-head): New function. + (nnheader-insert-article-line): New function. + +Tue Apr 23 22:55:57 1996 Lars Magne Ingebrigtsen + + * message.el (message-cancel-news): Disable syntax checks. + (message-do-fcc): Didn't quote separator. + + * gnus.el (gnus-update-summary-mark-positions): Use local format + spec when computing. + + * gnus-msg.el (gnus-summary-cancel-article): Remove article from + cache after cancelling. + (gnus-summary-supersede-article): Ditto. + +Tue Apr 23 12:05:21 1996 Per Abrahamsen + + * gnus.el (gnus-group-history): New variable. + (gnus-completing-read): Handle null default arg. + (gnus-group-jump-to-group): Use them. + (gnus-group-unsubscribe-group): Ditto. + (gnus-read-move-group-name): Ditto. + + * gnus-msg.el (gnus-group-post-news): Use `gnus-group-history' and + `gnus-completing-read'. + +Tue Apr 23 22:39:37 1996 Lars Magne Ingebrigtsen + + * nnml.el (nnml-active-number): Protect against corrupt active + files. + + * nnvirtual.el (nnvirtual-open-server): Don't allow recursive + groups. + Tue Apr 23 00:13:22 1996 Lars Magne Ingebrigtsen + * gnus.el: September Gnus v0.78 is released. + * gnus.el (gnus-get-newsgroup-headers): Run `gnus-parse-headers-hook'. (gnus-mime-decode-quoted-printable): Make interactive. diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 8da163e7e..bd2e76f66 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -180,8 +180,9 @@ buffer." (not gnus-expert-user)) (setq gnus-newsgroup-name (setq group - (completing-read "Group: " gnus-active-hashtb nil nil - (cons (or group "") 0))))) + (gnus-completing-read group "Group:" + gnus-active-hashtb nil nil nil + 'gnus-group-history)))) (gnus-post-news 'post group)))) (defun gnus-summary-post-news () @@ -243,7 +244,8 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (when (gnus-summary-select-article t nil nil article) (when (gnus-eval-in-buffer-window gnus-original-article-buffer (message-cancel-news)) - (gnus-summary-mark-as-read article gnus-canceled-mark)) + (gnus-summary-mark-as-read article gnus-canceled-mark) + (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) (gnus-summary-remove-process-mark article)))) @@ -253,10 +255,15 @@ This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) (gnus-set-global-variables) - (gnus-setup-message 'reply-yank - (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (message-supersede))) + (let ((article (gnus-summary-article-number))) + (gnus-setup-message 'reply-yank + (gnus-summary-select-article t) + (set-buffer gnus-original-article-buffer) + (message-supersede) + (push + `((lambda () + (gnus-cache-possibly-remove-article ,article nil nil nil t))) + message-send-actions)))) diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el index b75d579fe..0910bd8c0 100644 --- a/lisp/gnus-vis.el +++ b/lisp/gnus-vis.el @@ -388,14 +388,13 @@ ticked: The number of ticked articles in the group. (memq (gnus-group-group-name) gnus-group-marked))] ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] ["Mark regexp..." gnus-group-mark-regexp t] - ["Mark region" gnus-group-mark-region (region-exists-p)] + ["Mark region" gnus-group-mark-region t] ["Mark buffer" gnus-group-mark-buffer t] ["Execute command" gnus-group-universal-argument (or gnus-group-marked (gnus-group-group-name))]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] - ["Kill all newsgroups in region" gnus-group-kill-region - (region-exists-p)] + ["Kill all newsgroups in region" gnus-group-kill-region t] ["Kill all zombie groups" gnus-group-kill-all-zombies gnus-zombie-list] ["Kill all groups on level..." gnus-group-kill-level t]) @@ -495,8 +494,7 @@ ticked: The number of ticked articles in the group. ["Catchup" gnus-summary-catchup t] ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] - ["Catchup region" gnus-summary-mark-region-as-read - (region-exists-p)] + ["Catchup region" gnus-summary-mark-region-as-read t] ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) ("Various" ["Tick" gnus-summary-tick-article-forward t] @@ -525,7 +523,7 @@ ticked: The number of ticked articles in the group. ["Remove all marks" gnus-summary-unmark-all-processable t] ["Mark above" gnus-uu-mark-over t] ["Mark series" gnus-uu-mark-series t] - ["Mark region" gnus-uu-mark-region (region-exists-p)] + ["Mark region" gnus-uu-mark-region t] ["Mark by regexp..." gnus-uu-mark-by-regexp t] ["Mark all" gnus-uu-mark-all t] ["Mark buffer" gnus-uu-mark-buffer t] diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index d00e2d8ab..242181d59 100644 --- a/lisp/gnus-vm.el +++ b/lisp/gnus-vm.el @@ -31,6 +31,7 @@ ;;; Code: (require 'sendmail) +(require 'message) (require 'gnus) (require 'gnus-msg) @@ -112,7 +113,7 @@ save those articles instead." (defun gnus-mail-forward-using-vm (&optional buffer) "Forward the current message to another user using vm." (let* ((gnus-buffer (or buffer (current-buffer))) - (subject (gnus-forward-make-subject gnus-buffer))) + (subject (message-make-forward-subject))) (or (featurep 'win-vm) (if gnus-use-full-window (pop-to-buffer gnus-article-buffer) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index c51957ebf..de5e09a5f 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -380,10 +380,12 @@ pounce directly on the real variables themselves.") (x-get-resource ".backgroundMode" "BackgroundMode" 'string) (error nil))) (params (frame-parameters)) - (color (or (assq 'background-color params) - (color-instance-name - (specifier-instance - (face-background 'default)))))) + (color (condition-case () + (or (assq 'background-color params) + (color-instance-name + (specifier-instance + (face-background 'default)))) + (error nil)))) (cond (bg-resource (intern (downcase bg-resource))) ((and color (< (apply '+ (gnus-x-color-values color)) diff --git a/lisp/gnus.el b/lisp/gnus.el index 922621af4..733f9beb4 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1533,6 +1533,9 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.") ;; Internal variables +;; Dummy variable. +(defvar gnus-use-generic-from nil) + (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) @@ -1541,6 +1544,9 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.") (defvar gnus-method-history nil) ;; Variable holding the user answers to all method prompts. +(defvar gnus-group-history nil) +;; Variable holding the user answers to all group prompts. + (defvar gnus-server-alist nil "List of available servers.") @@ -1707,7 +1713,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.78" +(defconst gnus-version "September Gnus v0.79" "Version number for this version of Gnus.") (defvar gnus-info-nodes @@ -2537,25 +2543,31 @@ Thank you for your help in stamping out bugs. (defun gnus-update-summary-mark-positions () "Compute where the summary marks are to go." (save-excursion + (when (and gnus-summary-buffer + (get-buffer gnus-summary-buffer) + (buffer-name (get-buffer gnus-summary-buffer))) + (set-buffer gnus-summary-buffer)) (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) (thread nil) (gnus-visual nil) + (spec gnus-summary-line-format-spec) pos) (gnus-set-work-buffer) - (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) - (goto-char (point-min)) - (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) 2))))) - (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) (- (point) 2))) - pos) - (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) - pos) - (setq gnus-summary-mark-positions pos)))) + (let ((gnus-summary-line-format-spec spec)) + (gnus-summary-insert-line + [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) + (goto-char (point-min)) + (setq pos (list (cons 'unread (and (search-forward "\200" nil t) + (- (point) 2))))) + (goto-char (point-min)) + (push (cons 'replied (and (search-forward "\201" nil t) (- (point) 2))) + pos) + (goto-char (point-min)) + (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) + pos) + (setq gnus-summary-mark-positions pos))))) (defun gnus-update-group-mark-positions () (save-excursion @@ -3627,7 +3639,9 @@ simple-first is t, first argument is already simplified." (defun gnus-completing-read (default prompt &rest args) ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (concat prompt " (default " default ") ")) + (let* ((prompt (if default + (concat prompt " (default " default ") ") + (concat prompt " "))) (answer (apply 'completing-read prompt args))) (if (or (null answer) (zerop (length answer))) default @@ -5174,6 +5188,7 @@ Take into consideration N (the prefix) and the list of marked groups." (nreverse groups))) ((and (boundp 'transient-mark-mode) transient-mark-mode + (boundp 'mark-active) mark-active) ;; Work on the region between point and mark. (let ((max (max (point) (mark))) @@ -5283,7 +5298,9 @@ Returns whether the fetching was successful or not." (interactive (list (completing-read "Group: " gnus-active-hashtb nil - (memq gnus-select-method gnus-have-read-active-file)))) + (memq gnus-select-method gnus-have-read-active-file) + nil + 'gnus-group-history))) (when (equal group "") (error "Empty group name")) @@ -6090,7 +6107,9 @@ group line." (interactive (list (completing-read "Group: " gnus-active-hashtb nil - (memq gnus-select-method gnus-have-read-active-file)))) + (memq gnus-select-method gnus-have-read-active-file) + nil + 'gnus-group-history))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond ((string-match "^[ \t]$" group) @@ -11597,6 +11616,12 @@ groups." (when gnus-use-cache (gnus-cache-update-article (cdr gnus-article-current) (car gnus-article-current)))) + (save-excursion + (when (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq gnus-original-article nil))) + (setq gnus-article-current nil + gnus-current-article nil) (run-hooks 'gnus-article-display-hook) (and (gnus-visual-p 'summary-highlight 'highlight) (run-hooks 'gnus-visual-mark-article-hook))))) @@ -12863,7 +12888,7 @@ save those articles instead." "Read a group name." (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) (prom - (format "Where do you want to %s %s? " + (format "Where do you want to %s %s?" prompt (if (> (length articles) 1) (format "these %d articles" (length articles)) @@ -12871,19 +12896,19 @@ save those articles instead." (to-newsgroup (cond ((null split-name) - (completing-read - (concat prom - (if default - (format "(default %s) " default) - "")) - gnus-active-hashtb nil nil prefix)) + (gnus-completing-read default prom + gnus-active-hashtb nil nil prefix + 'gnus-group-history)) ((= 1 (length split-name)) - (completing-read prom gnus-active-hashtb - nil nil (cons (car split-name) 0))) + (gnus-completing-read (car split-name) prom gnus-active-hashtb + nil nil nil + 'gnus-group-history)) (t - (completing-read - prom (mapcar (lambda (el) (list el)) (nreverse split-name))))))) - + (gnus-completing-read nil prom + (mapcar (lambda (el) (list el)) + (nreverse split-name)) + nil nil nil + 'gnus-group-history))))) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) diff --git a/lisp/message.el b/lisp/message.el index bc0d0004c..4e69ee1dd 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -70,7 +70,7 @@ Otherwise, most addresses look like `angles', but they look like (defvar message-syntax-checks nil "Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add - `(signature . disable)' to this list. + `(signature . disabled)' to this list. Don't touch this variable unless you really know what you're doing. @@ -372,6 +372,55 @@ The cdr of ech entry is a function for applying the face to a region.") ;;; Internal variables. +;;; Regexp matching the delimiter of messages in UNIX mail format +;;; (UNIX From lines), minus the initial ^. +(defvar message-unix-mail-delimiter + (let ((time-zone-regexp + (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" + "\\|[-+]?[0-9][0-9][0-9][0-9]" + "\\|" + "\\) *"))) + (concat + "From " + + ;; Username, perhaps with a quoted section that can contain spaces. + "\\(" + "[^ \n]*" + "\\(\\|\".*\"[^ \n]*\\)" + "\\|<[^<>\n]+>" + "\\) ?" + + ;; The time the message was sent. + "\\([^ \n]*\\) *" ; day of the week + "\\([^ ]*\\) *" ; month + "\\([0-9]*\\) *" ; day of month + "\\([0-9:]*\\) *" ; time of day + + ;; Perhaps a time zone, specified by an abbreviation, or by a + ;; numeric offset. + time-zone-regexp + + ;; The year. + " [0-9][0-9]\\([0-9]*\\) *" + + ;; On some systems the time zone can appear after the year, too. + time-zone-regexp + + ;; Old uucp cruft. + "\\(remote from .*\\)?" + + "\n"))) + +(defvar message-unsent-separator + (concat "^ *---+ +Unsent message follows +---+ *$\\|" + "^ *---+ +Returned message +---+ *$\\|" + "^Start of returned message$\\|" + "^ *---+ +Original message +---+ *$\\|" + "^ *--+ +begin message +--+ *$\\|" + "^ *---+ +Original message follows +---+ *$\\|" + "^|? *---+ +Message text follows: +---+ *|?$") + "A regexp that matches the separator before the text of a failed message.") + (defvar message-header-format-alist `((Newsgroups) (To . message-fill-header) @@ -1392,9 +1441,11 @@ the user from the mailer." (defun message-check-element (type) "Returns non-nil if this type is not to be checked." - (let ((able (assq type message-syntax-checks))) - (and (consp able) - (eq (cdr able) 'disabled)))) + (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) + nil + (let ((able (assq type message-syntax-checks))) + (and (consp able) + (eq (cdr able) 'disabled))))) (defun message-checksum () "Return a \"checksum\" for the current buffer." @@ -1421,7 +1472,7 @@ the user from the mailer." (push file list) (message-remove-header "fcc" nil t))) (goto-char (point-min)) - (re-search-forward (concat "^" mail-header-separator "$")) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (replace-match "" t t) ;; Process FCC operations. (while list @@ -1945,7 +1996,7 @@ Headers already prepared in the buffer are not modified." ;; Allow mail alias things. (if (fboundp 'mail-abbrevs-setup) (mail-abbrevs-setup) - (mail-aliases-setup)) + (funcall (intern "mail-aliases-setup"))) (set-buffer-modified-p nil) (run-hooks 'message-setup-hook) (message-position-point) @@ -2207,7 +2258,7 @@ Headers already prepared in the buffer are not modified." mail-header-separator "\n" "This is a cancel message from " from ".\n") (message "Canceling your article...") - (let (message-syntax-checks) + (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) (funcall message-send-news-function)) (message "Canceling your article...done") (kill-buffer buf)))) @@ -2363,7 +2414,7 @@ you." (or (and boundary (re-search-forward boundary nil t) (forward-line 2)) - (and (re-search-forward mail-unsent-separator nil t) + (and (re-search-forward message-unsent-separator nil t) (forward-line 1)) (and (search-forward "\n\n" nil t) (re-search-forward "^Return-Path:.*\n" nil t))) diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 24c459c0e..31481c37d 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -596,6 +596,30 @@ (while (search-forward "\^_" nil t) (replace-match "?" t t))) +(defun nnbabyl-check-mbox () + "Go through the nnbabyl mbox and make sure that no article numbers are reused." + (interactive) + (let ((idents (make-vector 1000 0)) + id) + (save-excursion + (when (or (not nnbabyl-mbox-buffer) + (not (buffer-name nnbabyl-mbox-buffer))) + (nnbabyl-read-mbox)) + (set-buffer nnbabyl-mbox-buffer) + (goto-char (point-min)) + (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) + (if (intern-soft (setq id (match-string 1)) idents) + (progn + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point))) + (nnheader-message 7 "Moving %s..." id) + (nnbabyl-save-mail)) + (intern id idents))) + (when (buffer-modified-p (current-buffer)) + (save-buffer)) + (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) + (message "")))) + (provide 'nnbabyl) ;;; nnbabyl.el ends here diff --git a/lisp/nndb.el b/lisp/nndb.el index 3dd8de658..763dbd17c 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -131,7 +131,7 @@ "Expires ARTICLES from GROUP on SERVER. If FORCE, delete regardless of exiration date, otherwise use normal expiry mechanism." - (let (msg) + (let (msg art) (nntp-possibly-change-server group server) ;;- (while articles (setq art (pop articles)) @@ -159,7 +159,8 @@ expiry mechanism." "Move ARTICLE (a number) from GROUP on SERVER. Evals ACCEPT-FORM in current buffer, where the article is. Optional LAST is ignored." - (let ((artbuf (get-buffer-create " *nndb move*"))) + (let ((artbuf (get-buffer-create " *nndb move*")) + result) (and (nndb-request-article article group server artbuf) (save-excursion diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 126eed685..d380d9b43 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -27,7 +27,7 @@ ;;; Code: (require 'nnheader) -(require 'rmail) +(require 'message) (require 'nnmail) (require 'nnoo) (eval-when-compile (require 'cl)) @@ -54,7 +54,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', (body-end-function . nndoc-rnews-body-end)) (mbox (article-begin . - ,(let ((delim (concat "^" rmail-unix-mail-delimiter))) + ,(let ((delim (concat "^" message-unix-mail-delimiter))) (if (string-match "\n\\'" delim) (substring delim 0 (match-beginning 0)) delim))) @@ -308,7 +308,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', "Guess what document type is in the current buffer." (goto-char (point-min)) (cond - ((looking-at rmail-unix-mail-delimiter) + ((looking-at message-unix-mail-delimiter) 'mbox) ((looking-at "\^A\^A\^A\^A$") 'mmdf) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index da44d3156..c0ec8ccce 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -33,7 +33,7 @@ ;;; Code: (require 'nnheader) -(require 'rmail) +(require 'message) (require 'nnmail) (require 'nnoo) (eval-when-compile (require 'cl)) @@ -94,7 +94,7 @@ it.") (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (let ((delim-string (concat "^" rmail-unix-mail-delimiter)) + (let ((delim-string (concat "^" message-unix-mail-delimiter)) article art-string start stop) (nnfolder-possibly-change-group group server) (set-buffer nnfolder-current-buffer) @@ -162,11 +162,11 @@ it.") (goto-char (point-min)) (if (search-forward (nnfolder-article-string article) nil t) (let (start stop) - (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) (or (and (re-search-forward - (concat "^" rmail-unix-mail-delimiter) nil t) + (concat "^" message-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) (setq stop (point)) @@ -438,23 +438,20 @@ it.") (concat "\nMessage-ID: " article))) (defun nnfolder-delete-mail (&optional force leave-delim) - ;; Beginning of the article. + "Delete the message that point is in." (save-excursion - (save-restriction - (narrow-to-region - (save-excursion - (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) - nil t) - (if (and (not (bobp)) leave-delim) - (progn (forward-line -2) (point)) - (match-beginning 0))) - (point-max)))) - (delete-region (point-min) (point-max))))) + (delete-region + (save-excursion + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (if leave-delim (progn (forward-line 1) (point)) + (match-beginning 0))) + (progn + (forward-line 1) + (if (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) + (if (and (not (bobp)) leave-delim) + (progn (forward-line -2) (point)) + (match-beginning 0)) + (point-max)))))) (defun nnfolder-possibly-change-group (group &optional server) (when (and server @@ -522,7 +519,7 @@ it.") (if group (list (list group "")) nnmail-split-methods)) (group-art-list (nreverse (nnmail-article-group 'nnfolder-active-number))) - (delim (concat "^" rmail-unix-mail-delimiter)) + (delim (concat "^" message-unix-mail-delimiter)) save-list group-art) (goto-char (point-min)) ;; This might come from somewhere else. @@ -628,7 +625,7 @@ it.") (set-buffer (setq nnfolder-current-buffer (nnheader-find-file-noselect file nil 'raw))) (buffer-disable-undo (current-buffer)) - (let* ((delim (concat "^" rmail-unix-mail-delimiter)) + (let* ((delim (concat "^" message-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") (active (cadr (assoc nnfolder-current-group diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 2339683ac..fac3458c5 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -39,7 +39,6 @@ (require 'mail-utils) (require 'sendmail) -(require 'rmail) (eval-when-compile (require 'cl)) (defvar nnheader-max-head-length 4096 @@ -132,6 +131,117 @@ on your system, you could say something like: "Create a new mail header structure initialized with INIT." (make-vector 9 init)) +;; Parsing headers and NOV lines. + +(defsubst nnheader-header-value () + (buffer-substring (match-end 0) (gnus-point-at-eol))) + +(defvar nnheader-newsgroup-none-id 1) + +(defun nnheader-parse-head () + (let ((case-fold-search t) + end ref in-reply-to lines p cur) + (goto-char (point-min)) + ;; Search to the beginning of the next header. Error messages + ;; do not begin with 2 or 3. + (when (re-search-forward "^[23][0-9]+ " nil t) + ;; This implementation of this function, with nine + ;; search-forwards instead of the one re-search-forward and + ;; a case (which basically was the old function) is actually + ;; about twice as fast, even though it looks messier. You + ;; can't have everything, I guess. Speed and elegance + ;; doesn't always go hand in hand. + (vector + ;; Number. + (prog1 + (read cur) + (end-of-line) + (setq p (point)) + (narrow-to-region (point) + (or (and (search-forward "\n.\n" nil t) + (- (point) 2)) + (point)))) + ;; Subject. + (progn + (goto-char p) + (if (search-forward "\nsubject: " nil t) + (nnheader-header-value) "(none)")) + ;; From. + (progn + (goto-char p) + (if (search-forward "\nfrom: " nil t) + (nnheader-header-value) "(nobody)")) + ;; Date. + (progn + (goto-char p) + (if (search-forward "\ndate: " nil t) + (nnheader-header-value) "")) + ;; Message-ID. + (progn + (goto-char p) + (if (search-forward "\nmessage-id: " nil t) + (nnheader-header-value) + ;; If there was no message-id, we just fake one to make + ;; subsequent routines simpler. + (concat "none+" + (int-to-string + (incf nnheader-newsgroup-none-id))))) + ;; References. + (progn + (goto-char p) + (if (search-forward "\nreferences: " nil t) + (nnheader-header-value) + ;; Get the references from the in-reply-to header if there + ;; were no references and the in-reply-to header looks + ;; promising. + (if (and (search-forward "\nin-reply-to: " nil t) + (setq in-reply-to (nnheader-header-value)) + (string-match "<[^>]+>" in-reply-to)) + (substring in-reply-to (match-beginning 0) + (match-end 0)) + ""))) + ;; Chars. + 0 + ;; Lines. + (progn + (goto-char p) + (if (search-forward "\nlines: " nil t) + (if (numberp (setq lines (read cur))) + lines 0) + 0)) + ;; Xref. + (progn + (goto-char p) + (and (search-forward "\nxref: " nil t) + (nnheader-header-value))))))) + +(defun nnheader-insert-nov (header) + (princ (mail-header-number header) (current-buffer)) + (insert + "\t" + (or (mail-header-subject header) "") "\t" + (or (mail-header-from header) "") "\t" + (or (mail-header-date header) "") "\t" + (or (mail-header-id header) "") "\t" + (or (mail-header-references header) "") "\t") + (princ (or (mail-header-chars header) 0) (current-buffer)) + (insert "\t") + (princ (or (mail-header-lines header) 0) (current-buffer)) + (insert "\t") + (when (mail-header-xref header) + (insert "Xref: " (mail-header-xref header) "\t")) + (insert "\n")) + +(defun nnheader-insert-article-line (article) + (goto-char (point-min)) + (insert "220 ") + (princ article (current-buffer)) + (insert " Article retrieved.\n") + (search-forward "\n\n" nil 'move) + (delete-region (point) (point-max)) + (forward-char -1) + (insert ".")) + ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) @@ -172,19 +282,21 @@ on your system, you could say something like: (defun nnheader-insert-head (file) "Insert the head of the article." - (if (eq nnheader-max-head-length t) - ;; Just read the entire file. - (insert-file-contents-literally file) - ;; Read 1K blocks until we find a separator. - (let ((beg 0) - format-alist - (chop 1024)) - (while (and (eq chop (nth 1 (insert-file-contents - file nil beg (incf beg chop)))) - (prog1 (not (search-forward "\n\n" nil t)) - (goto-char (point-max))) - (or (null nnheader-max-head-length) - (< beg nnheader-max-head-length))))))) + (when (file-exists-p file) + (if (eq nnheader-max-head-length t) + ;; Just read the entire file. + (insert-file-contents-literally file) + ;; Read 1K blocks until we find a separator. + (let ((beg 0) + format-alist + (chop 1024)) + (while (and (eq chop (nth 1 (insert-file-contents + file nil beg (incf beg chop)))) + (prog1 (not (search-forward "\n\n" nil t)) + (goto-char (point-max))) + (or (null nnheader-max-head-length) + (< beg nnheader-max-head-length)))))) + t)) (defun nnheader-article-p () "Say whether the current buffer looks like an article." @@ -358,7 +470,7 @@ without formatting." (insert-file-contents-literally file) (goto-char (point-min)) (prog1 - (looking-at rmail-unix-mail-delimiter) + (looking-at message-unix-mail-delimiter) (kill-buffer (current-buffer)))))) (defun nnheader-replace-chars-in-string (string from to) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index f3c0104c7..b99ac4071 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -26,7 +26,6 @@ ;;; Code: (require 'nnheader) -(require 'rmail) (require 'timezone) (require 'sendmail) (require 'message) @@ -530,13 +529,13 @@ nn*-request-list should have been called before calling this function." (defun nnmail-search-unix-mail-delim () "Put point at the beginning of the next message." (let ((case-fold-search t) - (delim (concat "^" rmail-unix-mail-delimiter)) + (delim (concat "^" message-unix-mail-delimiter)) found) (while (not found) (if (re-search-forward delim nil t) (when (or (looking-at "[^\n :]+ *:") (looking-at delim) - (looking-at (concat ">" rmail-unix-mail-delimiter))) + (looking-at (concat ">" message-unix-mail-delimiter))) (forward-line -1) (setq found 'yes)) (setq found 'no))) @@ -544,7 +543,7 @@ nn*-request-list should have been called before calling this function." (defun nnmail-process-unix-mail-format (func) (let ((case-fold-search t) - (delim (concat "^" rmail-unix-mail-delimiter)) + (delim (concat "^" message-unix-mail-delimiter)) start message-id content-length end skip head-end) (goto-char (point-min)) (if (not (and (re-search-forward delim nil t) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 770bc60c9..37237eab7 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -30,7 +30,7 @@ ;;; Code: (require 'nnheader) -(require 'rmail) +(require 'message) (require 'nnmail) (require 'nnoo) (eval-when-compile (require 'cl)) @@ -89,7 +89,7 @@ (setq start (save-excursion (re-search-backward - (concat "^" rmail-unix-mail-delimiter) nil t) + (concat "^" message-unix-mail-delimiter) nil t) (point))) (search-forward "\n\n" nil t) (setq stop (1- (point))) @@ -149,11 +149,11 @@ (goto-char (point-min)) (if (search-forward (nnmbox-article-string article) nil t) (let (start stop) - (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) (or (and (re-search-forward - (concat "^" rmail-unix-mail-delimiter) nil t) + (concat "^" message-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) (setq stop (point)) @@ -378,12 +378,12 @@ (save-restriction (narrow-to-region (save-excursion - (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn (forward-line 1) - (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) + (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) (if (and (not (bobp)) leave-delim) (progn (forward-line -2) (point)) @@ -432,7 +432,7 @@ (let* ((nnmail-split-methods (if group (list (list group "")) nnmail-split-methods)) (group-art (nreverse (nnmail-article-group 'nnmbox-active-number))) - (delim (concat "^" rmail-unix-mail-delimiter))) + (delim (concat "^" message-unix-mail-delimiter))) (goto-char (point-min)) ;; This might come from somewhere else. (unless (looking-at delim) @@ -485,7 +485,7 @@ (= (buffer-size) (nth 7 (file-attributes nnmbox-mbox-file))))) () (save-excursion - (let ((delim (concat "^" rmail-unix-mail-delimiter)) + (let ((delim (concat "^" message-unix-mail-delimiter)) (alist nnmbox-group-alist) start end number) (set-buffer (setq nnmbox-mbox-buffer diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 019b9fddb..8a8f78d46 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -31,7 +31,6 @@ ;;; Code: (require 'nnheader) -(require 'rmail) (require 'nnmail) (require 'gnus) (require 'nnoo) diff --git a/lisp/nnml.el b/lisp/nnml.el index 3ff630d16..c064db225 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -581,10 +581,20 @@ all. This may very well take some time.") (let ((active (cadr (assoc group nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. - (or active - (progn - (setq active (cons 1 0)) - (setq nnml-group-alist (cons (list group active) nnml-group-alist)))) + (unless active + ;; Perhaps the active file was corrupt? See whether + ;; there are any articles in this group. + (unless nnml-article-file-alist + (setq nnml-article-file-alist + (sort + (nnheader-article-to-file-alist nnml-current-directory) + (lambda (a1 a2) (< (car a1) (car a2)))))) + (setq active + (if nnml-article-file-alist + (cons (caar nnml-article-file-alist) + (car (last nnml-article-file-alist))) + (cons 1 0))) + (setq nnml-group-alist (cons (list group active) nnml-group-alist))) (setcdr active (1+ (cdr active))) (while (file-exists-p (concat (nnmail-group-pathname group nnml-directory) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index 24f3570f7..a5b25d2cc 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -541,7 +541,7 @@ The SOUP packet file name will be inserted at the %s.") ((= format ?n) "^#! *rnews +[0-9]+ *$") ((= format ?m) - (concat "^" rmail-unix-mail-delimiter)) + (concat "^" message-unix-mail-delimiter)) ((= format ?M) "^\^A\^A\^A\^A\n") (t diff --git a/lisp/nnspool.el b/lisp/nnspool.el index d51fe1357..637fdf2da 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -342,7 +342,9 @@ there.") (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil (let ((nov (nnheader-group-pathname - nnspool-current-group nnspool-nov-directory ".overview"))) + nnspool-current-group nnspool-nov-directory ".overview")) + (arts articles) + last) (if (not (file-exists-p nov)) () (save-excursion @@ -366,7 +368,37 @@ there.") (forward-line 1)) (delete-region (point) (point-max)) ;; If the buffer is empty, this wasn't very successful. - (not (zerop (buffer-size)))))))))) + (unless (zerop (buffer-size)) + ;; We check what the last article number was. The NOV file + ;; may be out of sync with the articles in the group. + (forward-line -1) + (setq last (read (current-buffer))) + (if (= last (car articles)) + ;; Yup, it's all there. + t + ;; Perhaps not. We try to find the missing articles. + (while (and arts + (<= last (car arts))) + (pop arts)) + ;; The articles in `arts' are missing from the buffer. + (while arts + (nnspool-insert-nov-head (pop arts))) + t))))))))) + +(defun nnspool-insert-nov-head (article) + "Read the head of ARTICLE, convert to NOV headers, and insert." + (save-excursion + (let ((cur (current-buffer)) + buf) + (setq buf (nnheader-set-temp-buffer " *nnspool head*")) + (when (nnheader-insert-head + (nnspool-article-pathname nnspool-current-group article)) + (nnheader-insert-article-line article) + (let ((headers (nnheader-parse-head))) + (set-buffer cur) + (goto-char (point-max)) + (nnheader-insert-nov headers))) + (kill-buffer buf)))) (defun nnspool-find-nov-line (article) (let ((max (point-max)) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index acd4088f5..855ad613b 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -197,7 +197,10 @@ virtual group.") ;; Add this group to the list of component groups. (setq nnvirtual-component-groups (cons group - (delete group nnvirtual-component-groups)))))) + (delete group nnvirtual-component-groups))))) + (setq nnvirtual-component-groups + (delete (nnvirtual-current-group) + nnvirtual-component-groups))) (if (not nnvirtual-component-groups) (nnheader-report 'nnvirtual "No component groups: %s" server) t))) @@ -318,17 +321,7 @@ virtual group.") header) (erase-buffer) (while (setq header (pop headers)) - (insert (int-to-string (mail-header-number header)) "\t" - (or (mail-header-subject header) "") "\t" - (or (mail-header-from header) "") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) "") "\t" - (or (mail-header-references header) "") "\t" - (int-to-string (or (mail-header-chars header) 0)) "\t" - (int-to-string (or (mail-header-lines header) 0)) "\t" - (if (mail-header-xref header) - (concat "Xref: " (mail-header-xref header) "\t") - "") "\n"))))) +)))) (defun nnvirtual-possibly-change-server (server) (or (not server) @@ -403,12 +396,10 @@ virtual group.") g n (and (memq n unreads) t) (inline (nnvirtual-marks n marks)))) (gnus-uncompress-range active)))) - (setq nnvirtual-component-groups - (delete (nnvirtual-current-group) - nnvirtual-component-groups)))) + nnvirtual-component-groups)) (lambda (m1 m2) (< (car m1) (car m2))))) - (i 0)) + (i 0)) (setq nnvirtual-mapping map) ;; Set the virtual article numbers. (while (setq m (pop map)) diff --git a/texi/gnus.texi b/texi/gnus.texi index f271927f7..ca5588246 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -7347,14 +7347,6 @@ A function called to save outgoing articles. This function will be called with the same of the file to store the article in. The default function is @code{rmail-output} which saves in the Unix mailbox format. -@item gnus-mail-self-blind -@vindex gnus-mail-self-blind -Non-@code{nil} means insert a BCC header in all outgoing articles -pointing to yourself. This will result you receiving a copy of the -article mailed to yourself. The BCC header is inserted when the post -buffer is initialized, so you can remove or alter the BCC header to -override the default. - @item gnus-outgoing-message-group @vindex gnus-outgoing-message-group All outgoing messages will be put in this group. If you want to store -- 2.25.1