From 0a46b363819247b59833cec78e7f738c72ace5fa Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Wed, 5 Mar 1997 01:12:57 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 88 ++++++++++++++++++++++++++++++++++++++++++++++ lisp/earcon.el | 36 +++++++++++++------ lisp/gnus-art.el | 6 ++-- lisp/gnus-cache.el | 14 ++++---- lisp/gnus-demon.el | 9 ++--- lisp/gnus-group.el | 24 ++++++++++--- lisp/gnus-kill.el | 9 +++-- lisp/gnus-score.el | 4 +-- lisp/gnus-soup.el | 2 +- lisp/gnus-start.el | 2 +- lisp/gnus-sum.el | 74 ++++++++++++++++++++------------------ lisp/gnus-util.el | 3 +- lisp/gnus.el | 2 +- lisp/message.el | 66 ++++++++++++++++++++++------------ lisp/nnbabyl.el | 8 +++-- lisp/nndoc.el | 6 ++-- lisp/nnfolder.el | 36 ++++++++----------- lisp/nnheader.el | 1 + lisp/nnkiboze.el | 6 ++-- lisp/nnmail.el | 21 +++++------ lisp/nnml.el | 7 ++-- lisp/nnspool.el | 2 +- lisp/nntp.el | 84 ++++++++++++++++++++++++++++++++++++++++++- lisp/nnweb.el | 2 +- texi/gnus.texi | 6 ++-- 25 files changed, 375 insertions(+), 143 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dec1d1c62..6d77bb08c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,91 @@ +Thu Dec 5 19:29:50 1996 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers-xover): Message the line + number. + + * nnml.el (nnml-request-scan): Change server. + +Sat Nov 30 00:42:39 1996 Steven L Baur + + * earcon.el: Added Customization. + +Thu Dec 5 11:24:15 1996 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-prepare-threads): Don't output + articles outside the limit. + + * gnus-group.el (gnus-group-level): New function. + (gnus-group-list-active): Faster implementation. + (gnus-group-list-all-matching): Accept a `C-u' prefix. + + * message.el (message-news): Make sure newsey things are done. + + * gnus-kill.el (gnus-execute-1): Eval forms properly. + + * gnus-score.el (gnus-score-find-bnews): Treat "+" like ordinary + characters. + + * gnus-sum.el (gnus-summary-make-menu-bar): Update. + + * nndoc.el (nndoc-forward-type-p): Don't give false positives. + + * message.el (message-user-mail-address): Bypass mail-extr. + (message-make-forward-subject): Only fetch the first Subject. + + * gnus-art.el (gnus-button-alist): Reconize news:group urls. + + * gnus-start.el (gnus-group-change-level): Didn't quote strings + entered into dribble. + + * gnus-util.el (gnus-prin1-to-string): Use print-quoted- + + * nnbabyl.el (nnbabyl-request-article): Wouldn't find first + article properly. + (nnbabyl-delete-mail): Ditto. + +Thu Dec 5 06:16:25 1996 Per Abrahamsen + + * nnmail.el (nnmail-split-history): Use + `with-output-to-temp-buffer'. + +Thu Dec 5 08:46:26 1996 Shuhei KOBAYASHI + + * gnus-sum.el (gnus-nov-parse-line): unwind-protect the + narrowing. + +Tue Dec 3 14:06:17 1996 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-find-file-noselect): Disable local + variables. + + * gnus-group.el (gnus-group-fetch-faq): Ditto. + +Mon Dec 2 17:12:26 1996 Ralph Schleicher + + * gnus-demon.el (gnus-demon-time-to-step): Make it work. + +Sun Dec 1 07:35:32 1996 Lars Magne Ingebrigtsen + + * nntp.el (nntp-retrieve-articles): New function. + (nntp-next-result-arrived-p): New function. + +Sat Nov 30 13:50:15 1996 Lars Magne Ingebrigtsen + + * nnfolder.el (nnfolder-retrieve-headers): Parse unix mboxes better. + (nnfolder-request-article): Ditto. + + * message.el (message-rename-buffer): Make sure the renamed buffer + is valid. + +Sat Nov 30 12:06:47 1996 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-enter-article): Warn when trying to + cache negative articles. + +Sat Nov 30 08:53:48 1996 Lars Magne Ingebrigtsen + + * gnus.el: Red Gnus v0.72 is released. + 1996-11-30 Markus Linnala * gnus-sum.el (gnus-summary-refer-parent-article): Work when there diff --git a/lisp/earcon.el b/lisp/earcon.el index 2147eca5c..fa8fed896 100644 --- a/lisp/earcon.el +++ b/lisp/earcon.el @@ -34,16 +34,26 @@ (require 'gnus-art) (eval-when-compile (require 'cl)) -(defvar earcon-auto-play nil - "When True, automatically play sounds as well as buttonize them.") - -(defvar earcon-prefix "**" - "The start of an earcon") - -(defvar earcon-suffix "**" - "The end of an earcon") - -(defvar earcon-regexp-alist +(defgroup earcon nil + "Turn ** sounds ** into noise." + :group 'gnus-visual) + +(defcustom earcon-auto-play nil + "When True, automatically play sounds as well as buttonize them." + :type 'boolean + :group 'earcon) + +(defcustom earcon-prefix "**" + "String denoting the start of an earcon." + :type 'string + :group 'earcon) + +(defcustom earcon-suffix "**" + "String denoting the end of an earcon." + :type 'string + :group 'earcon) + +(defcustom earcon-regexp-alist '(("boring" 1 "Boring.au") ("evil[ \t]+laugh" 1 "Evil_Laugh.au") ("gag\\|puke" 1 "Puke.au") @@ -60,7 +70,11 @@ ("cackle" 1 "witch.au") ("yell\\|roar" 1 "yell2.au") ("whoop-de-doo" 1 "whistle.au")) - "A list of regexps to map earcons to real sounds.") + "A list of regexps to map earcons to real sounds." + :type '(repeat (list regexp + (integer :tag "Match") + (string :tag "Sound"))) + :group 'earcon) (defvar earcon-button-marker-list nil) (make-variable-buffer-local 'earcon-button-marker-list) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index fb0920f61..1ea2d44f6 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1496,10 +1496,10 @@ groups." :type 'regexp) (defcustom gnus-button-alist - `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 + `(("\\(\n\t ]*\\)>?\\)" 1 t + gnus-button-fetch-group 4) + ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) - ("\\(\n\t ]*\\)>?\\)" 1 t - gnus-button-fetch-group 3) ("\\(\n\t ]*\\)>?\\)" 1 t gnus-button-message-id 3) ("\\( \n\t]+\\)>?" 0 t gnus-url-mailto 2) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index ea4e2c6ba..438bfd8ae 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -318,12 +318,14 @@ Returns the list of articles entered." (gnus-set-global-variables) (let ((articles (gnus-summary-work-articles n)) article out) - (while articles - (setq article (pop articles)) - (when (gnus-cache-possibly-enter-article - gnus-newsgroup-name article (gnus-summary-article-header article) - nil nil nil t) - (push article out)) + (while (setq article (pop articles)) + (if (natnump article) + (when (gnus-cache-possibly-enter-article + gnus-newsgroup-name article + (gnus-summary-article-header article) + nil nil nil t) + (push article out)) + (gnus-message 2 "Can't cache article %d" article)) (gnus-summary-remove-process-mark article) (gnus-summary-update-secondary-mark article)) (gnus-summary-next-subject 1) diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index 015f4f05e..4ef6db935 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -159,10 +159,11 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (nseconds (gnus-time-minus (gnus-encode-date tdate) (gnus-encode-date date)))) (round - (/ (if (< nseconds 0) - (+ nseconds (* 60 60 24)) - nseconds) - gnus-demon-timestep))))) + (/ (+ (if (< (car nseconds) 0) + 86400 0) + (* 65536 (car nseconds)) + (nth 1 nseconds)) + gnus-demon-timestep))))) (defun gnus-demon () "The Gnus daemon that takes care of running all Gnus handlers." diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 7ab322654..1a7188265 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1408,6 +1408,12 @@ already." gnus-new-mail-mark ? )) +(defun gnus-group-level (group) + "Return the estimated level of GROUP." + (or (gnus-info-level (gnus-get-info group)) + (and (member group gnus-zombie-list) 8) + 9)) + (defun gnus-group-search-forward (&optional backward all level first-too) "Find the next newsgroup with unread articles. If BACKWARD is non-nil, find the previous newsgroup instead. @@ -2947,10 +2953,17 @@ entail asking the server for the groups." gnus-active-hashtb) list) 'string<)) - (buffer-read-only nil)) + (buffer-read-only nil) + group) (erase-buffer) (while groups - (gnus-group-insert-group-line-info (pop groups))) + (gnus-add-text-properties + (point) (prog1 (1+ (point)) + (insert " *: " + (setq group (pop groups)) "\n")) + (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) + 'gnus-unread t + 'gnus-level (inline (gnus-group-level group))))) (goto-char (point-min)))) (defun gnus-activate-all-groups (level) @@ -3052,8 +3065,9 @@ to use." (gnus-group-real-name group))) (if (not (file-exists-p file)) (gnus-message 1 "No such file: %s" file) - (find-file file) - (setq found t))))) + (let ((enable-local-variables nil)) + (find-file file) + (setq found t)))))) (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." @@ -3176,6 +3190,8 @@ If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") + (when level + (setq level (prefix-numeric-value level))) (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) ;; Suggested by Jack Vinson . diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index 990a37bb2..b0d4a9122 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -621,9 +621,12 @@ COMMAND must be a lisp expression or a string representing a key sequence." (set-buffer gnus-article-buffer) (goto-char (point-min)) (setq did-kill (re-search-forward regexp nil t))) - (if (stringp form) ;Keyboard macro. - (execute-kbd-macro form) - (eval form)))))) + (cond ((stringp form) ;Keyboard macro. + (execute-kbd-macro form)) + ((gnus-functionp form) + (funcall form)) + (t + (eval form))))))) did-kill))) (defun gnus-execute (field regexp form &optional backward unread) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 6b845957a..dd82f1a91 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -2434,8 +2434,8 @@ GROUP using BNews sys file syntax." (insert "\\"))) ;; Kludge to deal with "++". (goto-char (point-min)) - (while (search-forward "++" nil t) - (replace-match "\\+\\+" t t)) + (while (search-forward "+" nil t) + (replace-match "\\+" t t)) ;; Translate "all" to ".*". (goto-char (point-min)) (while (search-forward "all" nil t) diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 1f1262188..95cbb71ff 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -204,7 +204,7 @@ groups with \"emacs\" in the name, you could say something like: $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" (interactive) - ) + nil) ;;; Internal Functions: diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index ac72ba279..315f5274b 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1196,7 +1196,7 @@ the server for new groups." (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)) (gnus-dribble-enter (format - "(gnus-group-set-info '%s)" info))))) + "(gnus-group-set-info '%S)" info))))) (when gnus-group-change-level-function (funcall gnus-group-change-level-function group level oldlevel))))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 9e37bbf7f..e1c3bf442 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1870,6 +1870,10 @@ increase the score of each group you read." ("Modes" ["Pick and read" gnus-pick-mode t] ["Binary" gnus-binary-mode t]) + ("Regeneration" + ["Regenerate" gnus-summary-prepare t] + ["Insert cached articles" gnus-summary-insert-cached-articles t] + ["Toggle threading" gnus-summary-toggle-threads t]) ["Filter articles..." gnus-summary-execute-command t] ["Run command on subjects..." gnus-summary-universal-argument t] ["Toggle line truncation" gnus-summary-toggle-truncation t] @@ -3512,8 +3516,7 @@ or a straight list of headers." gnus-tmp-header nil)) ;; If the article lies outside the current limit, ;; then we do not display it. - ((and (not (memq number gnus-newsgroup-limit)) - (not gnus-tmp-dummy-line)) + ((not (memq number gnus-newsgroup-limit)) (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) @@ -4316,37 +4319,39 @@ The resulting hash table is returned, or nil if no Xrefs were found." header ref id id-dep ref-dep) ;; overview: [num subject from date id refs chars lines misc] - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (vector - number ; number - (gnus-nov-field) ; subject - (gnus-nov-field) ; from - (gnus-nov-field) ; date - (setq id (or (gnus-nov-field) - (nnheader-generate-fake-message-id))) ; id - (progn - (let ((beg (point))) - (search-forward "\t" eol) - (if (search-backward ">" beg t) - (setq ref - (buffer-substring - (1+ (point)) - (search-backward "<" beg t))) - (setq ref nil)) - (goto-char beg)) - (gnus-nov-field)) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil - (gnus-nov-field)) ; misc - )) - - (widen) + (unwind-protect + (progn + (narrow-to-region (point) eol) + (unless (eobp) + (forward-char)) + + (setq header + (vector + number ; number + (gnus-nov-field) ; subject + (gnus-nov-field) ; from + (gnus-nov-field) ; date + (setq id (or (gnus-nov-field) + (nnheader-generate-fake-message-id))) ; id + (progn + (let ((beg (point))) + (search-forward "\t" eol) + (if (search-backward ">" beg t) + (setq ref + (buffer-substring + (1+ (point)) + (search-backward "<" beg t))) + (setq ref nil)) + (goto-char beg)) + (gnus-nov-field)) ; refs + (gnus-nov-read-integer) ; chars + (gnus-nov-read-integer) ; lines + (if (= (following-char) ?\n) + nil + (gnus-nov-field)) ; misc + ))) + + (widen)) ;; We build the thread tree. (when (equal id ref) @@ -4410,7 +4415,8 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (push header headers)) (forward-line 1)) (error - (gnus-error 4 "Strange nov line"))) + (gnus-error 4 "Strange nov line (%d)" + (count-lines (point-min) (point))))) (forward-line 1)) (nreverse headers)))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 0b21ea2e1..e763d135b 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -568,7 +568,8 @@ Bind `print-quoted' to t while printing." (defun gnus-prin1-to-string (form) "The same as `prin1', but but `print-quoted' to t." - (prin1-to-string form)) + (let ((print-quoted t)) + (prin1-to-string form))) (defun gnus-make-directory (directory) "Make DIRECTORY (and all its parents) if it doesn't exist." diff --git a/lisp/gnus.el b/lisp/gnus.el index 9d4bf29e5..b07cd6c59 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -42,7 +42,7 @@ "Score and kill file handling." :group 'gnus ) -(defconst gnus-version-number "0.72" +(defconst gnus-version-number "0.73" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) diff --git a/lisp/message.el b/lisp/message.el index 8320a4ce4..b91b1c070 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -635,6 +635,8 @@ The cdr of ech entry is a function for applying the face to a region.") ;;; Internal variables. (defvar message-buffer-list nil) +(defvar message-this-is-news nil) +(defvar message-this-is-mail nil) ;; Byte-compiler warning (defvar gnus-active-hashtb) @@ -867,19 +869,21 @@ Return the number of headers removed." (defun message-news-p () "Say whether the current buffer contains a news message." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "newsgroups")))) + (or message-this-is-news + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "newsgroups"))))) (defun message-mail-p () "Say whether the current buffer contains a mail message." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (or (message-fetch-field "to") - (message-fetch-field "cc") - (message-fetch-field "bcc"))))) + (or message-this-is-mail + (save-excursion + (save-restriction + (message-narrow-to-headers) + (or (message-fetch-field "to") + (message-fetch-field "cc") + (message-fetch-field "bcc")))))) (defun message-next-header () "Go to the beginning of the next header." @@ -1288,8 +1292,10 @@ name, rather than giving an automatic name." (goto-char (point-min)) (narrow-to-region (point) (search-forward mail-header-separator nil 'end)) - (let* ((mail-to (if (message-news-p) (message-fetch-field "Newsgroups") - (message-fetch-field "To"))) + (let* ((mail-to (or + (if (message-news-p) (message-fetch-field "Newsgroups") + (message-fetch-field "To")) + "")) (mail-trimmed-to (if (string-match "," mail-to) (concat (substring mail-to 0 (match-beginning 0)) ", ...") @@ -2333,7 +2339,9 @@ give as trustworthy answer as possible." (defun message-user-mail-address () "Return the pertinent part of `user-mail-address'." (when user-mail-address - (nth 1 (mail-extract-address-components user-mail-address)))) + (if (string-match " " user-mail-address) + (nth 1 (mail-extract-address-components user-mail-address)) + user-mail-address))) (defun message-make-fqdn () "Return user's fully qualified domain name." @@ -2723,19 +2731,26 @@ Headers already prepared in the buffer are not modified." ;;; ;;;###autoload -(defun message-mail (&optional to subject) +(defun message-mail (&optional to subject + other-headers continue switch-function + yank-action send-actions) "Start editing a mail message to be sent." (interactive) - (message-pop-to-buffer (message-buffer-name "mail" to)) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) + (let ((message-this-is-mail t)) + (message-pop-to-buffer (message-buffer-name "mail" to)) + (message-setup + (nconc + `((To . ,(or to "")) (Subject . ,(or subject ""))) + (when other-headers (list other-headers)))))) ;;;###autoload (defun message-news (&optional newsgroups subject) "Start editing a news article to be sent." (interactive) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) + (let ((message-this-is-news t)) + (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) + (message-setup `((Newsgroups . ,(or newsgroups "")) + (Subject . ,(or subject "")))))) ;;;###autoload (defun message-reply (&optional to-address wide ignore-reply-to) @@ -2850,6 +2865,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." from subject date reply-to mct references message-id follow-to (inhibit-point-motion-hooks t) + (message-this-is-news t) followup-to distribution newsgroups gnus-warning) (save-restriction (narrow-to-region @@ -3036,10 +3052,14 @@ header line with the old Message-ID." (defun message-make-forward-subject () "Return a Subject header suitable for the message in the current buffer." - (concat "[" (or (message-fetch-field - (if (message-news-p) "newsgroups" "from")) - "(nowhere)") - "] " (or (message-fetch-field "Subject") ""))) + (save-excursion + (save-restriction + (current-buffer) + (message-narrow-to-head) + (concat "[" (or (message-fetch-field + (if (message-news-p) "newsgroups" "from")) + "(nowhere)") + "] " (or (message-fetch-field "Subject") ""))))) ;;;###autoload (defun message-forward (&optional news) diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index de077cef0..5d5bc10bb 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -159,7 +159,9 @@ (goto-char (point-min)) (when (search-forward (nnbabyl-article-string article) nil t) (let (start stop summary-line) - (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) + (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) + (goto-char (point-min)) + (end-of-line)) (while (and (not (looking-at ".+:")) (zerop (forward-line 1)))) (setq start (point)) @@ -418,7 +420,9 @@ (widen) (narrow-to-region (save-excursion - (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) + (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) + (goto-char (point-min)) + (end-of-line)) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn diff --git a/lisp/nndoc.el b/lisp/nndoc.el index b9e76e08e..3a3c6c4a9 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -270,7 +270,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', (buffer-disable-undo (current-buffer)) (erase-buffer) (if (stringp nndoc-address) - (insert-file-contents nndoc-address) + (nnheader-insert-file-contents nndoc-address) (insert-buffer-substring nndoc-address))))) ;; Initialize the nndoc structures according to this new document. (when (and nndoc-current-buffer @@ -400,7 +400,9 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', (defun nndoc-forward-type-p () (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) - (not (re-search-forward "^Subject:.*digest" nil t))) + (not (re-search-forward "^Subject:.*digest" nil t)) + (not (re-search-backward "^From:" nil t 2)) + (not (re-search-forward "^From:" nil t 2))) t)) (defun nndoc-clari-briefs-type-p () diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 15bab6f2c..5f814de6f 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -25,18 +25,14 @@ ;;; Commentary: -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;; Various enhancements by byer@mv.us.adobe.com (Scott Byer). - ;;; Code: (require 'nnheader) (require 'message) (require 'nnmail) (require 'nnoo) -(eval-when-compile (require 'cl)) +(require 'cl) +(require 'gnus-util) (nnoo-declare nnfolder) @@ -104,8 +100,7 @@ time saver for large mailboxes.") (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (let ((delim-string (concat "^" message-unix-mail-delimiter)) - article art-string start stop) + (let (article art-string start stop) (nnfolder-possibly-change-group group server) (when nnfolder-current-buffer (set-buffer nnfolder-current-buffer) @@ -122,8 +117,8 @@ time saver for large mailboxes.") ;; backwards will be faster. Especially if we're at the ;; beginning of the buffer :-). -SLB (search-backward art-string nil t)) - (setq start (or (re-search-backward delim-string nil t) - (point))) + (nnmail-search-unix-mail-delim) + (setq start (point)) (search-forward "\n\n" nil t) (setq stop (1- (point))) (set-buffer nntp-server-buffer) @@ -170,11 +165,10 @@ time saver for large mailboxes.") (goto-char (point-min)) (when (search-forward (nnfolder-article-string article) nil t) (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (nnmail-search-unix-mail-delim) (setq start (point)) (forward-line 1) - (unless (and (re-search-forward - (concat "^" message-unix-mail-delimiter) nil t) + (unless (and (nnmail-search-unix-mail-delim) (forward-line -1)) (goto-char (point-max))) (setq stop (point)) @@ -460,12 +454,12 @@ time saver for large mailboxes.") (save-excursion (delete-region (save-excursion - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (nnmail-search-unix-mail-delim) (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 (nnmail-search-unix-mail-delim) (if (and (not (bobp)) leave-delim) (progn (forward-line -2) (point)) (match-beginning 0)) @@ -539,7 +533,7 @@ time saver for large mailboxes.") (when (looking-at (concat ">" message-unix-mail-delimiter)) (delete-char 1)) ;; This might come from somewhere else. - (unless (looking-at delim) + (unless (looking-at message-unix-mail-delimiter) (insert "From nobody " (current-time-string) "\n") (goto-char (point-min))) ;; Quote all "From " lines in the article. @@ -695,15 +689,15 @@ time saver for large mailboxes.") (goto-char (point-max)) (if (not (re-search-backward marker nil t)) (goto-char (point-min)) - (when (not (re-search-backward delim nil t)) + (when (not (nnmail-search-unix-mail-delim)) (goto-char (point-min))))) ;; Keep track of the active number on our own, and insert it back ;; into the active list when we're done. Also, prime the pump to ;; cut down on the number of searches we do. (setq end (point-marker)) - (set-marker end (or (and (re-search-forward delim nil t) - (match-beginning 0)) + (set-marker end (or (and (nnmail-search-unix-mail-delim) + (point)) (point-max))) (while (not (= end (point-max))) (setq start (marker-position end)) @@ -712,8 +706,8 @@ time saver for large mailboxes.") ;; them. (while (looking-at delim) (forward-line 1)) - (set-marker end (or (and (re-search-forward delim nil t) - (match-beginning 0)) + (set-marker end (or (and (nnmail-search-unix-mail-delim) + (point)) (point-max))) (goto-char start) (when (not (search-forward marker end t)) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index c2bb9c45f..e8f44b7d9 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -754,6 +754,7 @@ find-file-hooks, etc. (let ((format-alist nil) (auto-mode-alist (nnheader-auto-mode-alist)) (default-major-mode 'fundamental-mode) + (enable-local-variables nil) (after-insert-file-functions nil)) (apply 'find-file-noselect args))) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 531f2e470..59ca522f9 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -80,7 +80,7 @@ (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (insert-file-contents nov) + (nnheader-insert-file-contents nov) (nnheader-nov-delete-outside-range (car articles) (car (last articles))) 'nov)))))) @@ -117,7 +117,7 @@ (erase-buffer) (if (not (file-exists-p nov-file)) (nnheader-report 'nnkiboze "Can't select group %s" group) - (insert-file-contents nov-file) + (nnheader-insert-file-contents nov-file) (if (zerop (buffer-size)) (nnheader-insert "211 0 0 0 %s\n" group) (goto-char (point-min)) @@ -136,7 +136,7 @@ nnkiboze-remove-read-articles) (nnheader-temp-write (nnkiboze-nov-file-name) (let ((cur (current-buffer))) - (insert-file-contents (nnkiboze-nov-file-name)) + (nnheader-insert-file-contents (nnkiboze-nov-file-name)) (goto-char (point-min)) (while (not (eobp)) (if (not (gnus-article-read-p (read cur))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index c7d1ea788..883095e2c 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1572,18 +1572,15 @@ If ARGS, PROMPT is used as an argument to `format'." (interactive) (unless nnmail-split-history (error "No current split history")) - (pop-to-buffer "*nnmail split history*") - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (let ((history nnmail-split-history) - elem) - (while (setq elem (pop history)) - (insert (mapconcat (lambda (ga) - (concat (car ga) ":" (int-to-string (cdr ga)))) - elem - ", ") - "\n")) - (goto-char (point-min)))) + (with-output-to-temp-buffer "*nnmail split history*" + (let ((history nnmail-split-history) + elem) + (while (setq elem (pop history)) + (princ (mapconcat (lambda (ga) + (concat (car ga) ":" (int-to-string (cdr ga)))) + elem + ", ")) + (princ "\n"))))) (defun nnmail-new-mail-p (group) "Say whether GROUP has new mail." diff --git a/lisp/nnml.el b/lisp/nnml.el index 1c0e1c370..52b5520ea 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -215,6 +215,7 @@ all. This may very well take some time.") (deffoo nnml-request-scan (&optional group server) (setq nnml-article-file-alist nil) + (nnml-possibly-change-directory group server) (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) (deffoo nnml-close-group (group &optional server) @@ -505,7 +506,7 @@ all. This may very well take some time.") nnml-nov-file-name)) number found) (when (file-exists-p nov) - (insert-file-contents nov) + (nnheader-insert-file-contents nov) (while (and (not found) (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. @@ -532,7 +533,7 @@ all. This may very well take some time.") (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (insert-file-contents nov) + (nnheader-insert-file-contents nov) (if (and fetch-old (not (numberp fetch-old))) t ; Don't remove anything. @@ -672,7 +673,7 @@ all. This may very well take some time.") (defun nnml-open-nov (group) (or (cdr (assoc group nnml-nov-buffer-alist)) - (let ((buffer (find-file-noselect + (let ((buffer (nnheader-find-file-noselect (concat (nnmail-group-pathname group nnml-directory) nnml-nov-file-name)))) (save-excursion diff --git a/lisp/nnspool.el b/lisp/nnspool.el index e61484b9f..ebe0e47d3 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -357,7 +357,7 @@ there.") (erase-buffer) (if nnspool-sift-nov-with-sed (nnspool-sift-nov-with-sed articles nov) - (insert-file-contents nov) + (nnheader-insert-file-contents nov) (if (and fetch-old (not (numberp fetch-old))) t ; We want all the headers. diff --git a/lisp/nntp.el b/lisp/nntp.el index 7e9c4004d..b394b1607 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -306,6 +306,87 @@ server there that you can connect to. See also `nntp-open-connection-function'" (copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'active)))) +(deffoo nntp-retrieve-articles (articles &optional group server) + (nntp-possibly-change-group group server) + (save-excursion + (let ((number (length articles)) + (count 0) + (received 0) + (last-point (point-min)) + (buf (nntp-find-connection-buffer nntp-server-buffer)) + (nntp-inhibit-erase t) + (map (apply 'vector articles)) + (point 1) + article alist) + (set-buffer buf) + (erase-buffer) + ;; Send HEAD command. + (while (setq article (pop articles)) + (nntp-send-command + nil + "ARTICLE" (if (numberp article) + (int-to-string article) + ;; `articles' is either a list of article numbers + ;; or a list of article IDs. + article)) + (incf count) + ;; Every 400 requests we have to read the stream in + ;; order to avoid deadlocks. + (when (or (null articles) ;All requests have been sent. + (zerop (% count nntp-maximum-request))) + (nntp-accept-response) + (while (progn + (progn + (set-buffer buf) + (goto-char last-point)) + ;; Count replies. + (while (nntp-next-result-arrived-p) + (aset map received (cons (aref map received) (point))) + (incf received)) + (setq last-point (point)) + (< received count)) + ;; If number of headers is greater than 100, give + ;; informative messages. + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (zerop (% received 20)) + (message "NNTP: Receiving articles... %d%%" + (/ (* received 100) number))) + (nntp-accept-response)))) + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (message "NNTP: Receiving headers...done")) + + ;; Now we have all the responses. We go through the results, + ;; washes it and copies it over to the server buffer. + (set-buffer nntp-server-buffer) + (erase-buffer) + (mapcar + (lambda (entry) + (narrow-to-region + (setq point (goto-char (point-max))) + (progn + (insert-buffer-substring buf last-point (cdr entry)) + (point-max))) + (nntp-decode-text) + (widen) + (cons (car entry) point)) + map)))) + +(defun nntp-next-result-arrived-p () + (let ((point (point))) + (cond + ((looking-at "2") + (if (re-search-forward "\n.\r?\n" nil t) + t + (goto-char point) + nil)) + ((looking-at "[34]") + (forward-line 1) + t) + (t + nil)))) + (defun nntp-try-list-active (group) (nntp-list-active-group group) (save-excursion @@ -898,7 +979,8 @@ It will prompt for a password." ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply - (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range) + (nntp-send-command-nodelete + "\r?\n\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)) (let ((commands nntp-xover-commands)) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 2a2173d8b..a2443af59 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -203,7 +203,7 @@ "Read the overview of GROUP and build the map." (when (file-exists-p (nnweb-overview-file group)) (nnheader-temp-write nil - (insert-file-contents (nnweb-overview-file group)) + (nnheader-insert-file-contents (nnweb-overview-file group)) (goto-char (point-min)) (setq nnweb-hashtb (gnus-make-hashtable (count-lines (point-min) (point-max)))) diff --git a/texi/gnus.texi b/texi/gnus.texi index 775e99b5a..b82654701 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Red Gnus 0.72 Manual +@settitle Red Gnus 0.73 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -287,7 +287,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Red Gnus 0.72 Manual +@title Red Gnus 0.73 Manual @author by Lars Magne Ingebrigtsen @page @@ -323,7 +323,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Red Gnus 0.72 +This manual corresponds to Red Gnus 0.73 @end ifinfo -- 2.25.1