Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit e35be8c32073b175a6ac5dd1a08daef1c1f7974c 1 parent 74a8dbb
@larsmagne larsmagne authored
View
103 lisp/ChangeLog
@@ -1,5 +1,108 @@
+Fri Mar 22 00:38:28 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el (gnus-summary-update-article): Would make things bug out.
+ (gnus-summary-insert-subject): Remove articles that have changed
+ number.
+ (gnus-summary-exit): Nix out variables.
+ (gnus-summary-exit-no-update): Ditto.
+ (gnus-article-setup-buffer): Create original buffer on entry.
+
+Thu Mar 21 22:28:12 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus-nocem.el (gnus-nocem-enter-article): Would enter things
+ into the wrong hashtb.
+
+ * nnml.el (nnml-inhibit-expiry): New variable.
+ (nnml-request-expire-articles): Use it.
+
+ * gnus.el (gnus-summary-update-article): Would bug out.
+
+ * nnml.el (nnml-possibly-change-directory): Also change server.
+
+ * gnus-nocem.el (gnus-nocem-scan-groups): Don't create a gazillion
+ garbage buffers.
+
+ * nnfolder.el (nnfolder-save-mail): Create new groups
+ automatically.
+ (nnfolder-request-scan): Change server first.
+
+ * nnheader.el (nnheader-insert-head): Don't insert file contents
+ literally.
+
+Thu Mar 21 18:17:21 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-score.el (gnus-score-body): Score in proper order.
+
+Wed Mar 20 20:06:08 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-select-newsgroup): Better message.
+
+ * gnus-uu.el (gnus-uu-save-article): Include multiple headers of
+ the same type.
+
+Tue Mar 19 16:26:13 1996 Roderick Schertler <roderick@gate.net>
+
+ * gnus-msg.el (gnus-mail-reply): Would bug out given multiple
+ follow-to elements for the same header.
+
+Tue Mar 19 01:15:06 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-cut-thread): Deal with old-fetched & sparse
+ threads at once.
+ (gnus-cut-threads): Make sure there are no nil threads.
+ (gnus-simplify-buffer-fuzzy): Tweaked implementation.
+ (gnus-gather-threads-by-subject): Check
+ gnus-summary-gather-exclude-subject after simplifying.
+
+ * gnus-topic.el (gnus-topic-insert-topic-line): Store the number
+ of unread articles.
+ (gnus-group-topic-unread): New function.
+ (gnus-topic-update-topic-line): Faster implementation.
+
+ * gnus.el (gnus-update-format-specifications): Would push too many
+ emacs-versions onto specs.
+
+ * gnus-msg.el (gnus-default-post-news-buffer,
+ gnus-default-mail-buffer): New variables.
+ (gnus-mail-setup): Set gnus-mail-buffer here.
+ (gnus-news-followup): Set gnus-post-news-buffer here.
+
+ * custom.el (custom-xmas-set-text-properties): New definition.
+
+ * gnus-soup.el (gnus-soup-insert-idx): Throw the Xref header
+ away.
+ (gnus-soup-add-article): Ditto.
+ (gnus-soup-ignored-headers): New variable.
+
+Mon Mar 18 15:01:40 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-msg.el (gnus-forward-insert-buffer): Wouldn't handle
+ continuation headers.
+
+ * nnml.el (nnml-retrieve-headers-with-nov): Wouldn't strip excess
+ lines.
+
+ * gnus-uu.el (gnus-uu-digest-mail-forward): Would reverse order.
+
+ * nnsoup.el (nnsoup-make-active): Would bug out.
+
+ * gnus-score.el (gnus-score-followup-thread): Make sure we are in
+ the summary buffer.
+
+ * gnus.el (gnus-buffer-live-p): New function.
+
+ * gnus-topic.el (gnus-topic-change-level): Would bug out on dead
+ groups.
+
+ * gnus.el (gnus-summary-respool-article): Prompt better.
+ (gnus-add-marked-articles): Would create recursive lists.
+ (gnus-summary-move-article): Activate all groups that have been
+ moved to.
+
Sun Mar 17 13:17:26 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+ * gnus.el: September Gnus v0.54 is released.
+
* gnus.el (gnus-article-hide-pgp): Would hide one char too many.
* gnus-msg.el (gnus-inews-distribution): Fall back on the
View
32 lisp/custom.el
@@ -57,7 +57,7 @@
(defun buffer-substring-no-properties (beg end)
"Return the text from BEG to END, without text properties, as a string."
(let ((string (buffer-substring beg end)))
- (set-text-properties 0 (length string) nil string)
+ (custom-set-text-properties 0 (length string) nil string)
string)))
(or (fboundp 'add-to-list)
@@ -153,16 +153,22 @@ STRING should be given if the last search was by `string-match' on STRING."
(and (fboundp 'set-face-underline-p)
(funcall 'set-face-underline-p 'underline t))))
-(or (fboundp 'set-text-properties)
- ;; Missing in XEmacs 19.12.
- (defun set-text-properties (start end props &optional buffer)
- (if (or (null buffer) (bufferp buffer))
- (if props
- (while props
- (put-text-property
- start end (car props) (nth 1 props) buffer)
- (setq props (nthcdr 2 props)))
- (remove-text-properties start end ())))))
+(defun custom-xmas-set-text-properties (start end props &optional buffer)
+ "You should NEVER use this function. It is ideologically blasphemous.
+It is provided only to ease porting of broken FSF Emacs programs."
+ (if (stringp buffer)
+ nil
+ (map-extents (lambda (extent ignored)
+ (remove-text-properties
+ start end
+ (list (extent-property extent 'text-prop) nil)
+ buffer))
+ buffer start end nil nil 'text-prop)
+ (add-text-properties start end props buffer)))
+
+(if (string-match "XEmacs" emacs-version)
+ (fset 'custom-set-text-properties 'gnus-xmas-set-text-properties)
+ (fset 'custom-set-text-properties 'set-text-properties))
(or (fboundp 'event-closest-point)
;; Missing in Emacs 19.29.
@@ -1817,7 +1823,7 @@ If the optional argument SAVE is non-nil, use that for saving changes."
"Describe how to execute COMMAND."
(let ((from (point)))
(insert "`" (key-description (where-is-internal command nil t)) "'")
- (set-text-properties from (point)
+ (custom-set-text-properties from (point)
(list 'face custom-button-face
mouse-face custom-mouse-face
'custom-jump t ;Make TAB jump over it.
@@ -2143,7 +2149,7 @@ If the optional argument is non-nil, show text iff the argument is positive."
(insert-char (custom-padding custom)
(- (custom-width custom) (- (point) from)))
(custom-field-move field from (point))
- (set-text-properties
+ (custom-set-text-properties
from (point)
(list 'custom-field field
'custom-tag field
View
54 lisp/gnus-msg.el
@@ -337,7 +337,9 @@ headers.")
;;; Internal variables.
(defvar gnus-post-news-buffer "*Post Gnus*")
+(defvar gnus-default-post-news-buffer gnus-post-news-buffer)
(defvar gnus-mail-buffer "*Mail Gnus*")
+(defvar gnus-default-mail-buffer gnus-mail-buffer)
(defvar gnus-article-copy nil)
(defvar gnus-reply-subject nil)
(defvar gnus-newsgroup-followup nil)
@@ -430,7 +432,7 @@ buffer."
(gnus-set-global-variables)
(gnus-post-news 'post gnus-newsgroup-name))
-(defun gnus-summary-followup (yank &optional yank-articles)
+(defun gnus-summary-followup (yank &optional yank-articles force-news)
"Compose a followup to an article.
If prefix argument YANK is non-nil, original article is yanked automatically."
(interactive "P")
@@ -454,12 +456,13 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
- (or yank-articles (not (not yank)))))))
+ (or yank-articles (not (not yank)))
+ nil force-news))))
-(defun gnus-summary-followup-with-original (n)
+(defun gnus-summary-followup-with-original (n &optional force-news)
"Compose a followup to an article and include the original article."
(interactive "P")
- (gnus-summary-followup t (gnus-summary-work-articles n)))
+ (gnus-summary-followup t (gnus-summary-work-articles n) force-news))
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(defun gnus-summary-followup-and-reply (yank &optional yank-articles)
@@ -544,7 +547,8 @@ header line with the old Message-ID."
(gnus-set-text-properties (point-min) (point-max)
nil gnus-article-copy)))))
-(defun gnus-post-news (post &optional group header article-buffer yank subject)
+(defun gnus-post-news (post &optional group header article-buffer yank subject
+ force-news)
"Begin editing a new USENET news article to be posted.
Type \\[describe-mode] in the buffer to get a list of commands."
(interactive (list t))
@@ -560,6 +564,7 @@ Type \\[describe-mode] in the buffer to get a list of commands."
group (gnus-group-real-name group)))
(if (or (and to-group
(gnus-news-group-p to-group))
+ force-news
(and (gnus-news-group-p
(or pgroup gnus-newsgroup-name)
(if header (mail-header-number header) gnus-current-article))
@@ -1866,7 +1871,7 @@ mailer."
(when (and gnus-interactive-post
(not gnus-expert-user))
(setq subject (read-string "Subject: ")))
- (pop-to-buffer gnus-mail-buffer)
+ (pop-to-buffer gnus-default-mail-buffer)
(erase-buffer)
(gnus-mail-setup 'new to subject)
(gnus-inews-insert-gcc)
@@ -1875,7 +1880,7 @@ mailer."
(defun gnus-new-empty-mail ()
"Create a new, virtually empty mail mode buffer."
- (pop-to-buffer gnus-mail-buffer)
+ (pop-to-buffer gnus-default-mail-buffer)
(gnus-mail-setup 'new "" ""))
(defun gnus-mail-reply (&optional yank to-address followup)
@@ -1887,7 +1892,7 @@ mailer."
from subject date reply-to message-of to cc
references message-id sender follow-to sendto elt new-cc new-to
mct mctdo gnus-warning)
- (set-buffer (get-buffer-create gnus-mail-buffer))
+ (set-buffer (get-buffer-create gnus-default-mail-buffer))
(mail-mode)
(if (and (buffer-modified-p)
(> (buffer-size) 0)
@@ -2023,12 +2028,16 @@ mailer."
(while follow-to
(goto-char (point-min))
(if (not (re-search-forward
- (concat "^" (caar follow-to) ": *") nil t))
+ (concat "^" (caar follow-to) ":") nil t))
(progn
(goto-char beg)
(insert (caar follow-to) ": " (cdar follow-to) "\n"))
- (unless (eolp)
- (insert ", "))
+ (if (eolp)
+ (insert " ")
+ (skip-chars-forward " ")
+ (unless (eolp)
+ (end-of-line)
+ (insert ", ")))
(insert (cdar follow-to)))
(setq follow-to (cdr follow-to)))
(widen)))
@@ -2119,9 +2128,10 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(not inhibit-prompt)
(not gnus-expert-user))
(setq subject (read-string "Subject: ")))
- (pop-to-buffer gnus-post-news-buffer)
+ (pop-to-buffer gnus-default-post-news-buffer)
(erase-buffer)
(news-reply-mode)
+
;; Let posting styles be configured.
(gnus-configure-posting-styles)
(news-setup nil subject nil (and group (gnus-group-real-name group)) nil)
@@ -2145,6 +2155,7 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(gnus-inews-set-point)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
+ (setq gnus-post-news-buffer (current-buffer))
(gnus-inews-modify-mail-mode-map)
(local-set-key "\C-c\C-c" 'gnus-inews-news)))
@@ -2162,8 +2173,9 @@ If INHIBIT-PROMPT, never prompt for a Subject."
from subject date message-of
references message-id follow-to sendto elt
followup-to distribution newsgroups gnus-warning)
- (set-buffer (get-buffer-create gnus-post-news-buffer))
+ (set-buffer (get-buffer-create gnus-default-post-news-buffer))
(news-reply-mode)
+ (setq gnus-post-news-buffer (current-buffer))
;; Associate this buffer with the draft group.
(gnus-enter-buffer-into-draft)
(if (and (buffer-modified-p)
@@ -2476,15 +2488,22 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(1- (point))
(point)))
(goto-char (point-min))
- (let ((case-fold-search t))
- (delete-non-matching-lines gnus-forward-included-headers))))))
-
+ (let ((case-fold-search t)
+ delete)
+ (while (re-search-forward "^[^ \t]*:" nil t)
+ (beginning-of-line)
+ (when delete (delete-region delete (point)))
+ (if (looking-at gnus-forward-included-headers)
+ (setq delete nil)
+ (setq delete (point)))
+ (forward-line 1)))))))
+
(defun gnus-mail-forward (&optional buffer)
"Forward the current message to another user using mail."
(let* ((forward-buffer (or buffer (current-buffer)))
(winconf (current-window-configuration))
(subject (gnus-forward-make-subject forward-buffer)))
- (set-buffer (get-buffer-create gnus-mail-buffer))
+ (set-buffer (get-buffer-create gnus-default-mail-buffer))
(if (and (buffer-modified-p)
(> (buffer-size) 0)
(not (gnus-y-or-n-p
@@ -2773,6 +2792,7 @@ Headers will be generated before sending."
((eq type 'new)
gnus-mail-other-window-method))))
to subject in-reply-to cc replybuffer actions)
+ (setq gnus-mail-buffer (current-buffer))
;; Associate this mail buffer with the draft group.
(gnus-enter-buffer-into-draft))
View
84 lisp/gnus-nocem.el
@@ -89,25 +89,30 @@
(< (cdr active) (cdr gactive))))
;; Ok, there are new articles in this group, se we fetch the
;; headers.
- (let ((gnus-newsgroup-dependencies (make-vector 10 nil))
- headers)
- (setq headers
- (if (eq 'nov
- (gnus-retrieve-headers
- (setq articles
- (gnus-uncompress-range
- (cons
- (if active (1+ (cdr active)) (car gactive))
- (cdr gactive))))
- group))
- (gnus-get-newsgroup-headers-xover articles)
- (gnus-get-newsgroup-headers)))
- (while headers
- ;; We take a closer look on all articles that have
- ;; "@@NCM" in the subject.
- (when (string-match "@@NCM" (mail-header-subject (car headers)))
- (gnus-nocem-check-article group (car headers)))
- (setq headers (cdr headers)))))
+ (save-excursion
+ (let ((gnus-newsgroup-dependencies (make-vector 10 nil))
+ (buffer (nnheader-set-temp-buffer " *Gnus NoCeM*"))
+ headers)
+ (setq headers
+ (if (eq 'nov
+ (gnus-retrieve-headers
+ (setq articles
+ (gnus-uncompress-range
+ (cons
+ (if active (1+ (cdr active))
+ (car gactive))
+ (cdr gactive))))
+ group))
+ (gnus-get-newsgroup-headers-xover articles)
+ (gnus-get-newsgroup-headers)))
+ (while headers
+ ;; We take a closer look on all articles that have
+ ;; "@@NCM" in the subject.
+ (when (string-match "@@NCM"
+ (mail-header-subject (car headers)))
+ (gnus-nocem-check-article group (car headers)))
+ (setq headers (cdr headers)))
+ (kill-buffer (current-buffer)))))
(setq gnus-nocem-active
(cons (list group gactive)
(delq (assoc group gnus-nocem-active)
@@ -118,26 +123,25 @@
(defun gnus-nocem-check-article (group header)
"Check whether the current article is an NCM article and that we want it."
- (nnheader-temp-write nil
- ;; Get the article.
- (gnus-message 7 "Checking article %d in %s for NoCeM..."
- (mail-header-number header) group)
- (let ((date (mail-header-date header))
- issuer b e)
- (when (or (not date)
- (nnmail-time-less
- (nnmail-time-since (nnmail-date-to-time date))
- (nnmail-days-to-time gnus-nocem-expiry-wait)))
- (gnus-request-article-this-buffer (mail-header-number header) group)
- ;; The article has to have proper NoCeM headers.
- (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
- (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
- ;; We get the name of the issuer.
- (narrow-to-region b e)
- (setq issuer (mail-fetch-field "issuer"))
- (and (member issuer gnus-nocem-issuers) ; We like her...
- (gnus-nocem-verify-issuer issuer) ; She is who she says she is..
- (gnus-nocem-enter-article))))))) ; We gobble the message.
+ ;; Get the article.
+ (gnus-message 7 "Checking article %d in %s for NoCeM..."
+ (mail-header-number header) group)
+ (let ((date (mail-header-date header))
+ issuer b e)
+ (when (or (not date)
+ (nnmail-time-less
+ (nnmail-time-since (nnmail-date-to-time date))
+ (nnmail-days-to-time gnus-nocem-expiry-wait)))
+ (gnus-request-article-this-buffer (mail-header-number header) group)
+ ;; The article has to have proper NoCeM headers.
+ (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
+ (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
+ ;; We get the name of the issuer.
+ (narrow-to-region b e)
+ (setq issuer (mail-fetch-field "issuer"))
+ (and (member issuer gnus-nocem-issuers) ; We like her...
+ (gnus-nocem-verify-issuer issuer) ; She is who she says she is..
+ (gnus-nocem-enter-article)))))) ; We gobble the message.
(defun gnus-nocem-verify-issuer (person)
"Verify using PGP that the canceler is who she says she is."
@@ -155,7 +159,7 @@
(narrow-to-region b (1+ (match-beginning 0)))
(goto-char (point-min))
(while (search-forward "\t" nil t)
- (when (boundp (let ((obarray gnus-newsrc-hashtb)) (read buf)))
+ (when (boundp (let ((obarray gnus-active-hashtb)) (read buf)))
(beginning-of-line)
(while (= (following-char) ?\t)
(forward-line -1))
View
52 lisp/gnus-score.el
@@ -124,7 +124,7 @@ will be expired along with non-matching score entries.")
(defvar gnus-score-exact-adapt-limit 10
"*Number that says how long a match has to be before using substring matching.
When doing adaptive scoring, one normally uses fuzzy or substring
-matching. However, if the header one matches is short, the possibility
+matching. However, if the header one matches is short, the possibility
for false positives is great, so if the length of the match is less
than this variable, exact matching will be used.
@@ -677,27 +677,31 @@ SCORE is the score to add."
"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) nil t))))))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (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) nil t)))))))
(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)))))))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (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.
@@ -1287,19 +1291,25 @@ SCORE is the score to add."
(defun gnus-score-body (scores header now expire &optional trace)
(save-excursion
(set-buffer nntp-server-buffer)
+ (setq gnus-scores-articles
+ (sort gnus-scores-articles
+ (lambda (a1 a2)
+ (< (mail-header-number (car a1))
+ (mail-header-number (car a2))))))
(save-restriction
(let* ((buffer-read-only nil)
(articles gnus-scores-articles)
- (last (if (caar gnus-scores-articles)
- (mail-header-number (caar gnus-scores-articles))
- 0))
(all-scores scores)
(request-func (cond ((string= "head" (downcase header))
'gnus-request-head)
((string= "body" (downcase header))
'gnus-request-body)
(t 'gnus-request-article)))
- entries alist ofunc article)
+ entries alist ofunc article last)
+ (while (cdr articles)
+ (setq articles (cdr articles)))
+ (setq last (mail-header-number (car articles)))
+ (setq articles gnus-scores-articles)
;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
(or (gnus-check-backend-function
View
11 lisp/gnus-soup.el
@@ -57,6 +57,9 @@ The SOUP packet file name will be inserted at the %s.")
(defvar gnus-soup-packet-regexp "Soupin"
"*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.")
+(defvar gnus-soup-ignored-headers "^Xref:"
+ "*Regexp to match headers to be removed when brewing SOUP packets.")
+
;;; Internal Variables:
(defvar gnus-soup-encoding-type ?n
@@ -140,6 +143,9 @@ move those articles instead."
(set-buffer tmp-buf)
(when (gnus-request-article-this-buffer
(car articles) gnus-newsgroup-name)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (nnheader-remove-header gnus-soup-ignored-headers t))
(gnus-soup-store gnus-soup-directory prefix headers
gnus-soup-encoding-type
gnus-soup-index-type)
@@ -283,7 +289,7 @@ If NOT-ALL, don't pack ticked articles."
;; [number subject from date id references chars lines xref]
(goto-char (point-max))
(insert
- (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n"
+ (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
offset
(or (mail-header-subject header) "(none)")
(or (mail-header-from header) "(nobody)")
@@ -295,8 +301,7 @@ If NOT-ALL, don't pack ticked articles."
(current-time) "-")))
(or (mail-header-references header) "")
(or (mail-header-chars header) 0)
- (or (mail-header-lines header) "0")
- (or (mail-header-xref header) ""))))
+ (or (mail-header-lines header) "0"))))
(defun gnus-soup-save-areas ()
(gnus-soup-write-areas)
View
87 lisp/gnus-topic.el
@@ -1,4 +1,4 @@
-;; gnus-topic.el --- a folding minor mode for Gnus group buffers
+;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
@@ -85,6 +85,10 @@ with some simple extensions.
"The level of the topic on the current line."
(get-text-property (gnus-point-at-bol) 'gnus-topic-level))
+(defun gnus-group-topic-unread ()
+ "The number of unread articles in topic on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-unread))
+
(defun gnus-topic-init-alist ()
"Initialize the topic structures."
(setq gnus-topic-topology
@@ -296,6 +300,7 @@ articles in the topic and its subtopics."
(gnus-topic-remove-excess-properties))
(list 'gnus-topic (intern name)
'gnus-topic-level level
+ 'gnus-unread unread
'gnus-active active-topic
'gnus-topic-visible visiblep))))
@@ -423,10 +428,11 @@ articles in the topic and its subtopics."
"Update all parent topics to the current group."
(when (and (eq major-mode 'gnus-group-mode)
gnus-topic-mode)
- (let ((group (gnus-group-group-name)))
- (when (and group (gnus-get-info group))
- (gnus-topic-goto-topic (gnus-group-parent-topic))
- (gnus-topic-update-topic-line)
+ (let ((group (gnus-group-group-name))
+ (buffer-read-only nil))
+ (when (and group (gnus-get-info group)
+ (gnus-topic-goto-topic (gnus-group-parent-topic)))
+ (gnus-topic-update-topic-line (gnus-group-topic-name))
(gnus-group-goto-group group)
(gnus-group-position-point)))))
@@ -450,33 +456,33 @@ articles in the topic and its subtopics."
(gnus-topic-goto-topic topic)
(forward-line 1)))))
-(defun gnus-topic-update-topic-line (&optional topic level)
- (unless topic
- (setq topic gnus-topic-topology)
- (setq level 0))
- (let* ((type (pop topic))
- (buffer-read-only nil)
+(defun gnus-topic-update-topic-line (topic-name &optional reads)
+ (let* ((type (cadr (gnus-topic-find-topology topic-name)))
(entries (gnus-topic-find-groups
(car type) (car gnus-group-list-mode)
(cdr gnus-group-list-mode)))
- (visiblep (eq (nth 1 type) 'visible))
+ (parent (gnus-topic-parent-topic topic-name))
(all-entries entries)
(unread 0)
- entry)
- ;; Tally any sub-topics.
- (while topic
- (incf unread (gnus-topic-update-topic-line (pop topic) (1+ level))))
- ;; Tally all the groups that belong in this topic.
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry))))
- ;; Insert the topic line.
+ old-unread entry)
(when (gnus-topic-goto-topic (car type))
+ ;; Tally all the groups that belong in this topic.
+ (if reads
+ (setq unread (- (gnus-group-topic-unread) reads))
+ (while (setq entry (pop entries))
+ (when (numberp (car entry))
+ (incf unread (car entry)))))
+ (setq old-unread (gnus-group-topic-unread))
+ ;; Insert the topic line.
(gnus-topic-insert-topic-line
- (car type) visiblep
+ (car type) (gnus-topic-visible-p)
(not (eq (nth 2 type) 'hidden))
- level all-entries unread)
+ (gnus-group-topic-level) all-entries unread)
(gnus-delete-line))
+ (when parent
+ (forward-line -1)
+ (gnus-topic-update-topic-line
+ parent (- old-unread (gnus-group-topic-unread))))
unread))
(defun gnus-topic-grok-active (&optional force read-active)
@@ -773,24 +779,29 @@ group."
(gnus-topic-goto-topic (gnus-group-parent-topic))
(gnus-group-topic-level)) 0)) ? ))
(yanked (list group))
- alist)
+ alist talist end)
;; Then we enter the yanked groups into the topics they belong
;; to.
- (setq alist (assoc (save-excursion
- (forward-line -1)
- (gnus-group-parent-topic))
- gnus-topic-alist))
- (when (stringp yanked)
- (setq yanked (list yanked)))
- (if (not prev)
- (nconc alist yanked)
- (if (not (cdr alist))
- (setcdr alist (nconc yanked (cdr alist)))
- (while (cdr alist)
- (when (equal (cadr alist) prev)
+ (when (setq alist (assoc (save-excursion
+ (forward-line -1)
+ (or
+ (gnus-group-parent-topic)
+ (caar gnus-topic-topology)))
+ gnus-topic-alist))
+ (setq talist alist)
+ (when (stringp yanked)
+ (setq yanked (list yanked)))
+ (if (not prev)
+ (nconc alist yanked)
+ (if (not (cdr alist))
(setcdr alist (nconc yanked (cdr alist)))
- (setq alist nil))
- (setq alist (cdr alist))))))
+ (while (and (not end) (cdr alist))
+ (when (equal (cadr alist) prev)
+ (setcdr alist (nconc yanked (cdr alist)))
+ (setq end t))
+ (setq alist (cdr alist)))
+ (unless end
+ (nconc talist yanked))))))
(gnus-topic-update-topic))))
(defun gnus-topic-goto-next-group (group props)
View
20 lisp/gnus-uu.el
@@ -441,10 +441,8 @@ The headers will be included in the sequence they are matched.")
(let ((gnus-uu-save-in-digest t)
(file (make-temp-name (concat gnus-uu-tmp-dir "forward")))
buf subject from)
- (setq gnus-newsgroup-processable
- (gnus-summary-work-articles n))
(setq gnus-uu-digest-from-subject nil)
- (gnus-uu-decode-save nil file)
+ (gnus-uu-decode-save n file)
(gnus-uu-add-file file)
(setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*")))
(gnus-add-current-to-buffer-list)
@@ -789,14 +787,14 @@ The headers will be included in the sequence they are matched.")
(setq headline (car headers))
(setq headers (cdr headers))
(goto-char (point-min))
- (if (re-search-forward headline nil t)
- (setq sorthead
- (concat sorthead
- (buffer-substring
- (match-beginning 0)
- (or (and (re-search-forward "^[^ \t]" nil t)
- (1- (point)))
- (progn (forward-line 1) (point)))))))))
+ (while (re-search-forward headline nil t)
+ (setq sorthead
+ (concat sorthead
+ (buffer-substring
+ (match-beginning 0)
+ (or (and (re-search-forward "^[^ \t]" nil t)
+ (1- (point)))
+ (progn (forward-line 1) (point)))))))))
(widen)))
(insert sorthead) (goto-char (point-max))
(insert body) (goto-char (point-max))
View
244 lisp/gnus.el
@@ -1715,7 +1715,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.54"
+(defconst gnus-version "September Gnus v0.55"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
@@ -2515,7 +2515,8 @@ Thank you for your help in stamping out bugs.
(push (list type new-format val) gnus-format-specs))
(set (intern (format "gnus-%s-line-format-spec" type)) val))))
- (push (cons 'version emacs-version) gnus-format-specs)
+ (unless (assq 'version gnus-format-specs)
+ (push (cons 'version emacs-version) gnus-format-specs))
(gnus-update-group-mark-positions)
(gnus-update-summary-mark-positions))
@@ -3031,45 +3032,48 @@ If RE-ONLY is non-nil, strip leading `Re:'s only."
;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
(defun gnus-simplify-buffer-fuzzy ()
(goto-char (point-min))
- (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t)
+ (while (search-forward "\t" nil t)
+ (replace-match " " t t))
+ (goto-char (point-min))
+ (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
(goto-char (match-beginning 0))
(while (or
- (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
- (looking-at "^[[].*:[ \t].*[]]$"))
+ (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (looking-at "^[[].*: .*[]]$"))
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
+ (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
+ (while (re-search-forward "^[[].*: .*[]]$" nil t)
(goto-char (match-end 0))
(delete-char -1)
(delete-region
(progn (goto-char (match-beginning 0)))
(re-search-forward ":"))))
(goto-char (point-min))
- (while (re-search-forward "[ \t\n]*[[{(][^()\n]*[]})][ \t]*$" nil t)
+ (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "[ \t]+" nil t)
+ (while (re-search-forward " +" nil t)
(replace-match " " t t))
(goto-char (point-min))
- (while (re-search-forward "[ \t]+$" nil t)
+ (while (re-search-forward " $" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "^[ \t]+" nil t)
+ (while (re-search-forward "^ +" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (if gnus-simplify-subject-fuzzy-regexp
- (if (listp gnus-simplify-subject-fuzzy-regexp)
- (let ((list gnus-simplify-subject-fuzzy-regexp))
- (while list
- (goto-char (point-min))
- (while (re-search-forward (car list) nil t)
- (replace-match "" t t))
- (setq list (cdr list))))
- (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
- (replace-match "" t t)))))
+ (when gnus-simplify-subject-fuzzy-regexp
+ (if (listp gnus-simplify-subject-fuzzy-regexp)
+ (let ((list gnus-simplify-subject-fuzzy-regexp))
+ (while list
+ (goto-char (point-min))
+ (while (re-search-forward (car list) nil t)
+ (replace-match "" t t))
+ (setq list (cdr list))))
+ (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
+ (replace-match "" t t)))))
(defun gnus-simplify-subject-fuzzy (subject)
"Siplify a subject string fuzzily."
@@ -3717,6 +3721,12 @@ simple-first is t, first argument is already simplified."
ids))
(nreverse ids)))
+(defun gnus-buffer-live-p (buffer)
+ "Say whether BUFFER is alive or not."
+ (and buffer
+ (get-buffer buffer)
+ (buffer-name (get-buffer buffer))))
+
(defun gnus-ephemeral-group-p (group)
"Say whether GROUP is ephemeral or not."
(gnus-group-get-parameter group 'quit-config))
@@ -5844,6 +5854,21 @@ If REVERSE, sort in reverse order."
;; Group catching up.
+(defun gnus-group-clear-data (n)
+ "Clear all marks and read ranges from the current group."
+ (interactive "P")
+ (let ((groups (gnus-group-process-prefix n))
+ group info)
+ (while (setq group (pop groups))
+ (setq info (gnus-get-info group))
+ (gnus-info-set-read info nil)
+ (when (gnus-info-marks info)
+ (gnus-info-set-marks info nil))
+ (gnus-get-unread-articles-in-group info (gnus-active group) t)
+ (when (gnus-group-goto-group group)
+ (gnus-group-remove-mark group)
+ (gnus-group-update-group-line)))))
+
(defun gnus-group-catchup-current (&optional n all)
"Mark all articles not marked as unread in current newsgroup as read.
If prefix argument N is numeric, the ARG next newsgroups will be
@@ -7628,26 +7653,27 @@ If NO-DISPLAY, don't generate a summary buffer."
subject hthread whole-subject)
(while threads
(setq whole-subject (mail-header-subject (caar threads)))
+ (setq subject
+ (cond
+ ;; Truncate the subject.
+ ((numberp gnus-summary-gather-subject-limit)
+ (setq subject (gnus-simplify-subject-re whole-subject))
+ (if (> (length subject) gnus-summary-gather-subject-limit)
+ (substring subject 0 gnus-summary-gather-subject-limit)
+ subject))
+ ;; Fuzzily simplify it.
+ ((eq 'fuzzy gnus-summary-gather-subject-limit)
+ (gnus-simplify-subject-fuzzy whole-subject))
+ ;; Just remove the leading "Re:".
+ (t
+ (gnus-simplify-subject-re whole-subject))))
+
(if (and gnus-summary-gather-exclude-subject
(string-match gnus-summary-gather-exclude-subject
- whole-subject))
- () ; We don't want to do anything with this article.
+ subject))
+ () ; We don't want to do anything with this article.
;; We simplify the subject before looking it up in the
;; hash table.
- (setq subject
- (cond
- ;; Truncate the subject.
- ((numberp gnus-summary-gather-subject-limit)
- (setq subject (gnus-simplify-subject-re whole-subject))
- (if (> (length subject) gnus-summary-gather-subject-limit)
- (substring subject 0 gnus-summary-gather-subject-limit)
- subject))
- ;; Fuzzily simplify it.
- ((eq 'fuzzy gnus-summary-gather-subject-limit)
- (gnus-simplify-subject-fuzzy whole-subject))
- ;; Just remove the leading "Re:".
- (t
- (gnus-simplify-subject-re whole-subject))))
(if (setq hthread (gnus-gethash subject hashtb))
(progn
@@ -7850,14 +7876,20 @@ If NO-DISPLAY, don't generate a summary buffer."
(parent
(gnus-id-to-thread (or (gnus-parent-id
(mail-header-references header))
- "tull"))))
+ "tull")))
+ (buffer-read-only nil)
+ (old (car thread))
+ (number (mail-header-number header))
+ pos)
(when thread
(setcar thread nil)
(when parent
(delq thread parent))
- (when (gnus-summary-insert-subject id header)
- ;; Set the (possibly) new article number in the data structure.
- (gnus-data-set-number data (gnus-id-to-article id))))))
+ (if (gnus-summary-insert-subject id header)
+ ;; Set the (possibly) new article number in the data structure.
+ (gnus-data-set-number data (gnus-id-to-article id))
+ (setcar thread old)
+ nil))))
(defun gnus-rebuild-thread (id)
"Rebuild the thread containing ID."
@@ -8000,8 +8032,7 @@ If NO-DISPLAY, don't generate a summary buffer."
(gnus-data-remove number))
(setq thread (cdr thread))
(while thread
- (gnus-remove-thread-1 (car thread))
- (setq thread (cdr thread)))))
+ (gnus-remove-thread-1 (pop thread)))))
(defun gnus-sort-threads (threads)
"Sort THREADS."
@@ -8486,7 +8517,7 @@ If READ-ALL is non-nil, all articles in the group are selected."
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
;; Retrieve the headers and read them in.
- (gnus-message 5 "Fetching headers...")
+ (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
(setq gnus-newsgroup-headers
(if (eq 'nov
(setq gnus-headers-retrieved-by
@@ -8501,7 +8532,7 @@ If READ-ALL is non-nil, all articles in the group are selected."
(> (length articles) 1))))))
(gnus-get-newsgroup-headers-xover articles)
(gnus-get-newsgroup-headers)))
- (gnus-message 5 "Fetching headers...done")
+ (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
;; Kludge to avoid having cached articles nixed out in virtual groups.
(when cached
@@ -8729,7 +8760,7 @@ If READ-ALL is non-nil, all articles in the group are selected."
(delq (assq type (car marked)) (car marked)))
(setcdr m (gnus-compress-sequence articles t)))
(setcdr m (gnus-compress-sequence
- (sort (nconc (gnus-uncompress-range m)
+ (sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
(defun gnus-set-mode-line (where)
@@ -8797,8 +8828,10 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(setq start 0)
(while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
(setq start (match-end 0))
- (setq group (concat prefix (substring xrefs (match-beginning 1)
- (match-end 1))))
+ (setq group (if prefix
+ (concat prefix (substring xrefs (match-beginning 1)
+ (match-end 1)))
+ (substring xrefs (match-beginning 1) (match-end 1))))
(setq number
(string-to-int (substring xrefs (match-beginning 2)
(match-end 2))))
@@ -9201,13 +9234,21 @@ This is meant to be called in `gnus-article-internal-prepare-hook'."
(progn (end-of-line) (point))))
(mail-header-set-xref headers xref))))))))
-(defun gnus-summary-insert-subject (id &optional header)
+(defun gnus-summary-insert-subject (id &optional old-header)
"Find article ID and insert the summary line for that article."
- (let ((header (gnus-read-header id header))
- (number (and (numberp id) id)))
+ (let ((header (gnus-read-header id))
+ (number (and (numberp id) id))
+ pos)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
+ (when old-header
+ (when (setq pos (text-property-any
+ (point-min) (point-max) 'gnus-number
+ (mail-header-number old-header)))
+ (goto-char pos)
+ (gnus-delete-line)
+ (gnus-data-remove (mail-header-number old-header))))
(gnus-rebuild-thread (mail-header-id header))
(gnus-summary-goto-subject (setq number (mail-header-number header))))
(when (and (numberp number)
@@ -9223,7 +9264,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'."
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
;; Report back a success?
- (and header number)))
+ (and header (mail-header-number header))))
(defun gnus-summary-work-articles (n)
"Return a list of articles to be worked upon. The prefix argument,
@@ -9626,7 +9667,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer))
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
(when gnus-use-cache
(gnus-cache-possibly-remove-articles)
(gnus-cache-save-buffers))
@@ -9642,12 +9684,15 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(run-hooks 'gnus-summary-exit-hook)
+ (unless gnus-single-article-buffer
+ (setq gnus-article-current nil))
(if temporary
nil ;Nothing to do.
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer))
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
(set-buffer buf)
(if (not gnus-kill-summary-on-exit)
(gnus-deaden-summary)
@@ -9695,7 +9740,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer))
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
(if (not gnus-kill-summary-on-exit)
(gnus-deaden-summary)
(gnus-close-group group)
@@ -9704,6 +9750,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
(gnus-summary-clear-local-variables)
(when (get-buffer gnus-summary-buffer)
(kill-buffer gnus-summary-buffer)))
+ (unless gnus-single-article-buffer
+ (setq gnus-article-current nil))
(when gnus-use-trees
(gnus-tree-close group))
(when (get-buffer gnus-article-buffer)
@@ -10023,7 +10071,8 @@ be displayed."
(not (equal (car gnus-article-current)
gnus-newsgroup-name))))
(and (not gnus-single-article-buffer)
- (null gnus-current-article))
+ (or (null gnus-current-article)
+ (not (eq gnus-current-article article))))
force)
;; The requested article is different from the current article.
(prog1
@@ -10554,12 +10603,16 @@ If ALL, mark even excluded ticked and dormants as read."
(defsubst gnus-cut-thread (thread)
"Go forwards in the thread until we find an article that we want to display."
- (if (eq gnus-fetch-old-headers 'some)
- (while (and thread
- (memq (mail-header-number (car thread))
- gnus-newsgroup-ancient)
- (<= (length (cdr thread)) 1))
- (setq thread (cadr thread)))
+ (when (eq gnus-fetch-old-headers 'some)
+ ;; Deal with old-fetched headers.
+ (while (and thread
+ (memq (mail-header-number (car thread))
+ gnus-newsgroup-ancient)
+ (<= (length (cdr thread)) 1))
+ (setq thread (cadr thread))))
+ ;; Deal with sparse threads.
+ (when (or (eq gnus-build-sparse-threads 'some)
+ (eq gnus-build-sparse-threads 'more))
(while (and thread
(memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
(= (length (cdr thread)) 1))
@@ -10575,7 +10628,8 @@ If ALL, mark even excluded ticked and dormants as read."
(while th
(setcar th (gnus-cut-thread (car th)))
(setq th (cdr th)))))
- threads)
+ ;; Remove nixed out threads.
+ (delq nil threads))
(defun gnus-summary-initial-limit (&optional show-if-empty)
"Figure out what the initial limit is supposed to be on group entry.
@@ -11107,7 +11161,7 @@ and `request-accept' functions."
(crosspost "crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
- art-group to-method new-xref article)
+ art-group to-method new-xref article to-groups)
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
@@ -11185,10 +11239,14 @@ and `request-accept' functions."
(if select-method (list select-method "")
(gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
- (info (nth 2 entry)))
+ (info (nth 2 entry))
+ (to-group (gnus-info-group info)))
;; Update the group that has been moved to.
(when (and info
(memq action '(move copy)))
+ (unless (member to-group to-groups)
+ (push to-group to-groups))
+
(unless (memq article gnus-newsgroup-unreads)
(gnus-info-set-read
info (gnus-add-to-range (gnus-info-read info)
@@ -11201,7 +11259,7 @@ and `request-accept' functions."
;; See whether the article is to be put in the cache.
(when gnus-use-cache
(gnus-cache-possibly-enter-article
- (gnus-info-group info) to-article
+ to-group to-article
(let ((header (copy-sequence
(gnus-summary-article-header article))))
(mail-header-set-number header to-article)
@@ -11214,9 +11272,17 @@ and `request-accept' functions."
(when (memq article (symbol-value
(intern (format "gnus-newsgroup-%s"
(caar marks)))))
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy mark to other group.
(gnus-add-marked-articles
- (gnus-info-group info) (cdar marks)
- (list to-article) info))
+ to-group (cdar marks) (list to-article) info))
(setq marks (cdr marks)))))
;; Update the Xref header in this article to point to
@@ -11236,6 +11302,10 @@ and `request-accept' functions."
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark)))
(gnus-summary-remove-process-mark article))
+ ;; Re-activate all groups that have been moved to.
+ (while to-groups
+ (gnus-activate-group (pop to-groups)))
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
@@ -11272,17 +11342,17 @@ latter case, they will be copied into the relevant groups."
(let ((respool-methods (gnus-methods-using 'respool))
(methname
(symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
- (or respool-method
- (setq respool-method
- (completing-read
- "What method do you want to use when respooling? "
- respool-methods nil t methname)))
- (or (string= respool-method "")
- (if (assoc (symbol-name
- (car (gnus-find-method-for-group gnus-newsgroup-name)))
- respool-methods)
- (gnus-summary-move-article n nil (intern respool-method))
- (gnus-summary-copy-article n nil (intern respool-method))))))
+ (unless respool-method
+ (setq respool-method
+ (completing-read
+ "What method do you want to use when respooling? "
+ respool-methods nil t (cons methname 0))))
+ (unless (string= respool-method "")
+ (if (assoc (symbol-name
+ (car (gnus-find-method-for-group gnus-newsgroup-name)))
+ respool-methods)
+ (gnus-summary-move-article n nil (intern respool-method))
+ (gnus-summary-copy-article n nil (intern respool-method))))))
(defun gnus-summary-import-article (file)
"Import a random file into a mail newsgroup."
@@ -13125,6 +13195,12 @@ The following commands are available:
(setq gnus-original-article-buffer original)
(gnus-set-global-variables))
(make-local-variable 'gnus-summary-buffer))
+ ;; Init original article buffer.
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (buffer-disable-undo (current-buffer))
+ (setq major-mode 'gnus-original-article-mode)
+ (make-local-variable 'gnus-original-article))
(if (get-buffer name)
(save-excursion
(set-buffer name)
@@ -13225,9 +13301,11 @@ The following commands are available:
(cond
;; We first check `gnus-original-article-buffer'.
- ((and (equal (car gnus-original-article) group)
- (eq (cdr gnus-original-article) article)
- (get-buffer gnus-original-article-buffer))
+ ((and (get-buffer gnus-original-article-buffer)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (and (equal (car gnus-original-article) group)
+ (eq (cdr gnus-original-article) article))))
(insert-buffer-substring gnus-original-article-buffer)
'article)
;; Check the backlog.
@@ -13261,7 +13339,6 @@ The following commands are available:
(equal (buffer-name (current-buffer))
(buffer-name (get-buffer gnus-article-buffer))))
(save-excursion
- (setq gnus-original-article (cons group article))
(if (get-buffer gnus-original-article-buffer)
(set-buffer (get-buffer gnus-original-article-buffer))
(set-buffer (get-buffer-create gnus-original-article-buffer))
@@ -13269,6 +13346,7 @@ The following commands are available:
(setq major-mode 'gnus-original-article-mode)
(setq buffer-read-only t)
(gnus-add-current-to-buffer-list))
+ (setq gnus-original-article (cons group article))
(let (buffer-read-only)
(erase-buffer)
(insert-buffer-substring gnus-article-buffer))))
View
13 lisp/nnfolder.el
@@ -240,6 +240,7 @@ it.")
minactive maxactive group))))))))
(defun nnfolder-request-scan (&optional group server)
+ (nnfolder-possibly-change-group group server)
(nnmail-get-new-mail
'nnfolder
(lambda ()
@@ -282,9 +283,10 @@ it.")
(defun nnfolder-request-create-group (group &optional server)
(nnmail-activate 'nnfolder)
- (unless (assoc group nnfolder-group-alist)
- (push (list group (cons 1 0)) nnfolder-group-alist)
- (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
+ (when group
+ (unless (assoc group nnfolder-group-alist)
+ (push (list group (cons 1 0)) nnfolder-group-alist)
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
t)
(defun nnfolder-request-list (&optional server)
@@ -569,9 +571,12 @@ it.")
(while (search-backward (concat "\n" nnfolder-article-marker) nil t)
(delete-region (1+ (point)) (progn (forward-line 2) (point))))
- ;; Insert the new newsgroup marker.
(nnfolder-possibly-change-group (car group-art))
+ ;; Insert the new newsgroup marker.
(nnfolder-insert-newsgroup-line group-art)
+ (unless nnfolder-current-buffer
+ (nnfolder-request-create-group (car group-art))
+ (nnfolder-possibly-change-group (car group-art)))
(let ((beg (point-min))
(end (point-max))
(obuf (current-buffer)))
View
3  lisp/nnheader.el
@@ -221,8 +221,9 @@ on your system, you could say something like:
(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-literally
+ (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)))
View
78 lisp/nnml.el
@@ -60,6 +60,10 @@ all. This may very well take some time.")
(defvar nnml-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
+(defvar nnml-inhibit-expiry nil
+ "If non-nil, inhibit expiry.")
+
+
(defconst nnml-version "nnml 1.0"
@@ -95,6 +99,7 @@ all. This may very well take some time.")
(nnml-article-file-alist nil)
(nnml-prepare-save-mail-hook nil)
(nnml-current-group nil)
+ (nnml-inhibit-expiry ,nnml-inhibit-expiry)
(nnml-status-string "")
(nnml-nov-buffer-alist nil)
(nnml-group-alist nil)
@@ -114,7 +119,7 @@ all. This may very well take some time.")
beg article)
(if (stringp (car sequence))
'headers
- (nnml-possibly-change-directory newsgroup)
+ (nnml-possibly-change-directory newsgroup server)
(unless nnml-article-file-alist
(setq nnml-article-file-alist
(nnheader-article-to-file-alist nnml-current-directory)))
@@ -186,7 +191,7 @@ all. This may very well take some time.")
nnml-status-string)
(defun nnml-request-article (id &optional newsgroup server buffer)
- (nnml-possibly-change-directory newsgroup)
+ (nnml-possibly-change-directory newsgroup server)
(let* ((nntp-server-buffer (or buffer nntp-server-buffer))
file path gpath group-num)
(if (stringp id)
@@ -220,7 +225,7 @@ all. This may very well take some time.")
(defun nnml-request-group (group &optional server dont-check)
(cond
- ((not (nnml-possibly-change-directory group))
+ ((not (nnml-possibly-change-directory group server))
(nnheader-report 'nnml "Invalid group (no such directory)"))
(dont-check
(nnheader-report 'nnml "Group %s selected" group)
@@ -240,11 +245,13 @@ all. This may very well take some time.")
(nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
(defun nnml-close-group (group &optional server)
+ (setq nnml-article-file-alist nil)
t)
(defun nnml-request-close ()
- (setq nnml-current-server nil)
- (setq nnml-server-alist nil)
+ (setq nnml-current-server nil
+ nnml-article-file-alist nil
+ nnml-server-alist nil)
t)
(defun nnml-request-create-group (group &optional server)
@@ -254,7 +261,7 @@ all. This may very well take some time.")
(setq nnml-group-alist (cons (list group (setq active (cons 1 0)))
nnml-group-alist))
(nnml-possibly-create-directory group)
- (nnml-possibly-change-directory group)
+ (nnml-possibly-change-directory group server)
(let ((articles
(nnheader-directory-articles nnml-current-directory )))
(and articles
@@ -277,7 +284,7 @@ all. This may very well take some time.")
(nnmail-find-file nnml-newsgroups-file)))
(defun nnml-request-expire-articles (articles newsgroup &optional server force)
- (nnml-possibly-change-directory newsgroup)
+ (nnml-possibly-change-directory newsgroup server)
(let* ((active-articles
(nnheader-directory-articles nnml-current-directory))
(is-old t)
@@ -295,7 +302,8 @@ all. This may very well take some time.")
(when (setq mod-time (nth 5 (file-attributes article)))
(if (and (nnml-deletable-article-p newsgroup number)
(setq is-old
- (nnmail-expired-article-p newsgroup mod-time force)))
+ (nnmail-expired-article-p newsgroup mod-time force
+ nnml-inhibit-expiry)))
(progn
(nnheader-message 5 "Deleting article %s in %s..."
article newsgroup)
@@ -320,7 +328,7 @@ all. This may very well take some time.")
(article group server accept-form &optional last)
(let ((buf (get-buffer-create " *nnml move*"))
result)
- (nnml-possibly-change-directory group)
+ (nnml-possibly-change-directory group server)
(unless nnml-article-file-alist
(setq nnml-article-file-alist
(nnheader-article-to-file-alist nnml-current-directory)))
@@ -405,7 +413,7 @@ all. This may very well take some time.")
t)))))
(defun nnml-request-delete-group (group &optional force server)
- (nnml-possibly-change-directory group)
+ (nnml-possibly-change-directory group server)
(when force
;; Delete all articles in GROUP.
(let ((articles
@@ -433,7 +441,7 @@ all. This may very well take some time.")
t)
(defun nnml-request-rename-group (group new-name &optional server)
- (nnml-possibly-change-directory group)
+ (nnml-possibly-change-directory group server)
;; Rename directory.
(and (file-writable-p nnml-current-directory)
(condition-case ()
@@ -522,32 +530,34 @@ all. This may very well take some time.")
(last (progn (while (cdr articles) (setq articles (cdr articles)))
(car articles)))
(nov (concat nnml-current-directory nnml-nov-file-name)))
- (if (file-exists-p nov)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-file-contents nov)
- (if (and fetch-old
- (not (numberp fetch-old)))
- t ; Don't remove anything.
- (if fetch-old
- (setq first (max 1 (- first fetch-old))))
- (goto-char (point-min))
- (while (and (not (eobp)) (< first (read (current-buffer))))
- (forward-line 1))
- (beginning-of-line)
- (if (not (eobp)) (delete-region 1 (point)))
- (while (and (not (eobp)) (>= last (read (current-buffer))))
- (forward-line 1))
- (beginning-of-line)
- (if (not (eobp)) (delete-region (point) (point-max)))
- t))))))
+ (when (file-exists-p nov)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-file-contents nov)
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (if fetch-old
+ (setq first (max 1 (- first fetch-old))))
+ (goto-char (point-min))
+ (while (and (not (eobp)) (> first (read (current-buffer))))
+ (forward-line 1))
+ (beginning-of-line)
+ (if (not (eobp)) (delete-region 1 (point)))
+ (while (and (not (eobp)) (>= last (read (current-buffer))))
+ (forward-line 1))
+ (beginning-of-line)
+ (if (not (eobp)) (delete-region (point) (point-max)))
+ t))))))
-(defun nnml-possibly-change-directory (group &optional force)
+(defun nnml-possibly-change-directory (group &optional server)
+ (when (and server
+ (not (nnml-server-opened server)))
+ (nnml-open-server server))
(when group
(let ((pathname (nnmail-group-pathname group nnml-directory)))
- (when (or force
- (not (equal pathname nnml-current-directory)))
+ (when (not (equal pathname nnml-current-directory))
(setq nnml-current-directory pathname
nnml-current-group group
nnml-article-file-alist nil))))
View
15 lisp/nnsoup.el
@@ -405,7 +405,9 @@ The SOUP packet file name will be inserted at the %s.")
(nnheader-temp-write nnsoup-active-file
(let ((standard-output (current-buffer)))
(prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
- (prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))))))
+ (insert "\n")
+ (prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
+ (insert "\n")))))
(defun nnsoup-next-prefix ()
"Return the next free prefix."
@@ -728,9 +730,9 @@ The SOUP packet file name will be inserted at the %s.")
(erase-buffer)
(insert-file-contents (car files))
(goto-char (point-min))
- (end-of-line)
- (re-search-backward "[ \t]\\([^ ]+\\):[0-9]")
- (setq group (buffer-substring (match-beginning 1) (match-end 1)))
+ (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
+ (setq group "unknown")
+ (setq group (match-string 2)))
(setq lines (count-lines (point-min) (point-max)))
(setq ident (progn (string-match
"/\\([0-9]+\\)\\." (car files))
@@ -744,16 +746,13 @@ The SOUP packet file name will be inserted at the %s.")
active)
(nconc elem
(list
- (list (cons (setq min (1+ (cdaadr elem)))
+ (list (cons (1+ (setq min (cdadr elem)))
(+ min lines))
(vector ident group "ncm" "" lines))))
(setcdr (cadr elem) (+ min lines)))
(setq files (cdr files)))
(message "")
(setq nnsoup-group-alist active)
- (while active
- (setcdr (car active) (nreverse (cdar active)))
- (setq active (cdr active)))
(nnsoup-write-active-file t)))
(defun nnsoup-delete-unreferenced-message-files ()
View
37 texi/ChangeLog
@@ -35,6 +35,43 @@ Wed Feb 28 04:54:41 1996 Lars Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Slow Terminal Connection): Addition.
+Sat Mar 9 07:00:48 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Fancy Mail Splitting): Addition.
+
+Sat Mar 9 00:32:23 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.texi (Summary Buffer Lines): Change.
+
+Fri Mar 8 20:17:51 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Summary Score Commands): Change.
+
+Wed Mar 6 21:18:04 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Topic Commands): Addition.
+ (Kill Files): Addition.
+ (Summary Maneuvering): Change.
+ (Summary Maneuvering): Addition.
+ (Saving Articles): Addition.
+
+Mon Mar 4 23:16:56 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Compilation ): Change.
+
+Sun Mar 3 21:56:46 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (NNTP): Addition.
+ (Post): Addition.
+
+Fri Mar 1 20:52:50 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Customizing Threading): Change.
+
+Wed Feb 28 04:54:41 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Slow Terminal Connection): Addition.
+
Sat Feb 24 01:11:40 1996 Mark Borges <mdb@cdc.noaa.gov>
* gnus.texi: Typo fixes.
Please sign in to comment.
Something went wrong with that request. Please try again.