+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
(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)
(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.
"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.
(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
;;; 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)
(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")
;; 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)
(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))
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))
(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)
(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)
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)
(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)))
(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)
(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)))
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)
(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
((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))
(< (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)
(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."
(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))
(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.
"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.
(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
(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
(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)
;; [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)")
(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)
-;; 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>
"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
(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))))
"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)))))
(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)
(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)
(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)
(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))
"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
(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))
;; 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."
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))
;; 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
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
(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."
(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."
(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
(> (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
(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)
(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))))
(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)
(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,
;; 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))
(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)
;; 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)
(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)
(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
(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))
(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.
(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.
(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)
;; 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)
(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
(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)))
(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."
(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)
(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.
(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))
(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))))
minactive maxactive group))))))))
(defun nnfolder-request-scan (&optional group server)
+ (nnfolder-possibly-change-group group server)
(nnmail-get-new-mail
'nnfolder
(lambda ()
(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)
(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)))
(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)))
(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.")
+
+
\f
(defconst nnml-version "nnml 1.0"
(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)
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)))
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)
(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)
(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)
(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
(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)
(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)
(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)))
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
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 ()
(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))))
(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."
(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))
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 ()
* 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.
projects / gnus / commitdiff