+Sat Mar 16 14:46:29 1996 Brad Miller <bmiller@cs.umn.edu>
+
+ * gnus-gl.el: New version.
+
+Sat Mar 16 13:28:57 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+
+ * gnus-score.el (gnus-score-body): Would break on nil
+ `gnus-scores-articles'?
+
+ * gnus.el: All the backend interface functions should take virtual
+ server names.
+
+ * gnus-msg.el (gnus-post-method): Find the real method.
+
+ * gnus.el (gnus-summary-go-to-next-thread): New definition.
+ (gnus-summary-next-thread): Use it.
+ (gnus-prefix-to-server): New function.
+
+ * gnus-vis.el (gnus-signature-toggle): Use new substs.
+ (gnus-article-highlight-signature): Would make check point wrong.
+
+ * gnus.el (gnus-hide-text): New subst.
+ (gnus-hide-text-type): New function.
+ (gnus-unhide-text): New subst.
+ (gnus-article-show-all-headers, gnus-article-hide-headers,
+ gnus-article-hide-pgp, gnus-article-hide-header,
+ gnus-article-hide-boring-headers): Use them.
+
+Fri Mar 15 07:39:10 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nntp.el (nntp-send-xover-command): Would bug out on
+ single-article groups.
+
+ * gnus.el (gnus-group-prepare-flat): Deal with unactivated groups.
+ * gnus-topic.el (gnus-topic-find-groups): Ditto.
+
+Thu Mar 14 05:24:42 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nnspool.el (nnspool-retrieve-headers): Use default-directory to
+ avoid creating so many garbage strings.
+
+ * nnmail.el (nnmail-split-incoming): Make sure the buffer isn't
+ empty before starting treatment.
+ (nnmail-get-new-mail): Open/close cache here.
+
+ * gnus-msg.el (gnus-news-followup): Use markers for positions.
+
+ * gnus.el (gnus-setup-news): Read NoCeM.
+
+Wed Mar 13 03:26:44 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-functionp): Made into a subst.
+ (gnus-all-windows-visible-p): Non-recursive implementation.
+
+ * nnsoup.el (nnsoup-request-list): Don't use `format'.
+
+ * gnus.el (gnus-update-format-specifications): Would recompute all
+ specs every time.
+ (gnus-gnus-to-newsrc-format): Don't call `gnus-server-equal' for
+ each group.
+
+ * nnspool.el (nnspool-retrieve-headers): Don't call so many
+ functions.
+
+ * gnus-cache.el (gnus-cache-retrieve-headers): Would do too much
+ work.
+
+ * gnus-topic.el (gnus-topic-goto-topic): Faster.
+
+ * gnus.el: Don't downcase Message-IDs before threading.
+
Tue Mar 12 01:42:11 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+ * gnus.el: September Gnus v0.52 is released.
+
* gnus.el (gnus-article-strip-leading-blank-lines): New command.
* gnus-score.el (gnus-score-score-files-1): Message.
(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
"Retrieve the headers for ARTICLES in GROUP."
- (let* ((cached
- (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))
- (uncached-articles (gnus-sorted-intersection
- (gnus-sorted-complement articles cached)
- articles))
- (cache-file (gnus-cache-file-name group ".overview"))
- type)
- ;; We first retrieve all the headers that we don't have in
- ;; the cache.
- (let ((gnus-use-cache nil))
- (setq type (and articles
- (gnus-retrieve-headers
- uncached-articles group fetch-old))))
- (gnus-cache-save-buffers)
- ;; Then we insert the cached headers.
- (save-excursion
- (cond
- ((not (file-exists-p cache-file))
- ;; There are no cached headers.
- type)
- ((null type)
- ;; There were no uncached headers (or retrieval was
- ;; unsuccessful), so we use the cached headers exclusively.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-file-contents cache-file)
- 'nov)
- ((eq type 'nov)
- ;; We have both cached and uncached NOV headers, so we
- ;; braid them.
- (gnus-cache-braid-nov group cached)
- type)
- (t
- ;; We braid HEADs.
- (gnus-cache-braid-heads group (gnus-sorted-intersection
- cached articles))
- type)))))
+ (let ((cached
+ (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
+ (if (not cached)
+ ;; No cached articles here, so we just retrieve them
+ ;; the normal way.
+ (let ((gnus-use-cache nil))
+ (gnus-retrieve-headers articles group fetch-old))
+ (let ((uncached-articles (gnus-sorted-intersection
+ (gnus-sorted-complement articles cached)
+ articles))
+ (cache-file (gnus-cache-file-name group ".overview"))
+ type)
+ ;; We first retrieve all the headers that we don't have in
+ ;; the cache.
+ (let ((gnus-use-cache nil))
+ (setq type (and articles
+ (gnus-retrieve-headers
+ uncached-articles group fetch-old))))
+ (gnus-cache-save-buffers)
+ ;; Then we insert the cached headers.
+ (save-excursion
+ (cond
+ ((not (file-exists-p cache-file))
+ ;; There are no cached headers.
+ type)
+ ((null type)
+ ;; There were no uncached headers (or retrieval was
+ ;; unsuccessful), so we use the cached headers exclusively.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-file-contents cache-file)
+ 'nov)
+ ((eq type 'nov)
+ ;; We have both cached and uncached NOV headers, so we
+ ;; braid them.
+ (gnus-cache-braid-nov group cached)
+ type)
+ (t
+ ;; We braid HEADs.
+ (gnus-cache-braid-heads group (gnus-sorted-intersection
+ cached articles))
+ type)))))))
(defun gnus-cache-enter-article (&optional n)
"Enter the next N articles into the cache.
(erase-buffer)
(insert-file-contents (gnus-cache-file-name group (car cached)))
(goto-char (point-min))
- (insert "220 " (int-to-string (car cached)) " Article retrieved.\n")
+ (insert "220 ")
+ (princ (car cached) (current-buffer))
+ (insert " Article retrieved.\n")
(search-forward "\n\n" nil 'move)
(delete-region (point) (point-max))
(forward-char -1)
"%U%R%z%l%I%(%[%4L: %-20,20n%]%) %s\n"
"*The line format spec in summary GroupLens mode buffers.")
+(defvar gnus-summary-grouplens-lab-line-format
+ "%U%R%z%uL%I%(%[%4L: %-20,20n%]%) %s\n"
+ "*The line format spec in summary GroupLens mode buffers.")
+
(defvar grouplens-pseudonym ""
"User's pseudonym. This pseudonym is obtained during the registration
process")
(let* ((rate-string (make-string 12 ? ))
(mid (aref header (nth 1 (assoc "message-id" gnus-header-index))))
(hashent (gethash mid grouplens-current-hashtable))
- (pred (nth 0 hashent))
+ (pred (or (nth 0 hashent) 0))
(low (nth 1 hashent))
(high (nth 2 hashent)))
- (gnus-message 5 (concat "mid = " mid))
;; Init rate-string
(aset rate-string 0 ?|)
(aset rate-string 11 ?|)
;; BUG REPORTING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst gnus-gl-version "gnus-gl.el 2.9")
+(defconst gnus-gl-version "gnus-gl.el 2.10")
(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
(defun gnus-gl-submit-bug-report ()
"Submit via mail a bug report on gnus-gl"
'(lambda()
(bbb-build-mid-scores-alist gnus-newsgroup-name))))
(make-local-variable 'gnus-summary-line-format)
- (setq gnus-summary-line-format gnus-summary-grouplens-line-format)
+ (if gnus-grouplens-override-scoring
+
+ (setq gnus-summary-line-format gnus-summary-grouplens-lab-line-format))
(make-local-variable 'gnus-summary-line-format-spec)
;; Set up the menu.
(provide 'gnus-gl)
;;; end gnus-gl.el
-
(save-excursion
(gnus-copy-article-buffer)
(mail-yank-original nil)
- (setq end (point)))
+ (setq end (set-marker (make-marker) (point))))
(or mail-yank-hooks mail-citation-hook
(run-hooks 'news-reply-header-hook))
(goto-char end)
+ (set-marker end nil)
(setq yank (cdr yank))))
(goto-char last))
(gnus-configure-windows 'followup-yank 'force))
(insert "------------------ Environment follows ------------------\n\n"))
(while olist
(if (boundp (car olist))
- (insert
- (condition-case ()
- (pp-to-string
- `(setq ,(car olist)
- ,(if (or (consp (setq sym (symbol-value (car olist))))
- (and (symbolp sym)
- (not (or (eq sym nil)
- (eq sym t)))))
- (list 'quote (symbol-value (car olist)))
- (symbol-value (car olist)))))
- (error
- (format "(setq %s 'whatever)\n" (car olist)))))
+ (condition-case ()
+ (pp `(setq ,(car olist)
+ ,(if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
+ (list 'quote (symbol-value (car olist)))
+ (symbol-value (car olist))))
+ (current-buffer))
+ (error
+ (format "(setq %s 'whatever)\n" (car olist))))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
;; If the group doesn't exist, we assume
;; it's an archive group...
gnus-message-archive-method)
- (t (gnus-find-method-for-group group)))))
+ (t (gnus-group-method group)))))
(unless (gnus-request-group group t method)
(gnus-request-create-group group method))
(gnus-check-server method)
(when (and gnus-nocem-alist
gnus-nocem-touched-alist)
(nnheader-temp-write (gnus-nocem-cache-file)
- (insert (prin1-to-string
- `(setq gnus-nocem-alist ',gnus-nocem-alist))))
+ (prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist) (current-buffer)))
(setq gnus-nocem-touched-alist nil)))
(defun gnus-nocem-save-active ()
"Save the NoCeM active file."
(nnheader-temp-write (gnus-nocem-active-file)
- (insert (prin1-to-string
- `(setq gnus-nocem-active ',gnus-nocem-active)))))
+ (prin1 `(setq gnus-nocem-active ',gnus-nocem-active) (current-buffer))))
(defun gnus-nocem-alist-to-hashtb ()
"Create a hashtable from the Message-IDs we have."
(save-restriction
(let* ((buffer-read-only nil)
(articles gnus-scores-articles)
- (last (mail-header-number (caar 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)
(defun gnus-score-edit-insert-date ()
"Insert date in numerical format."
(interactive)
- (insert (int-to-string (gnus-day-number (current-time-string)))))
+ (princ (gnus-day-number (current-time-string)) (current-buffer)))
(defun gnus-score-pretty-print ()
"Format the current score file."
-;;; 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>
(defun gnus-group-topic-name ()
"The name of the topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic))
+ (let ((group (get-text-property (gnus-point-at-bol) 'gnus-topic)))
+ (and group (symbol-name group))))
(defun gnus-group-topic-level ()
"The level of the topic on the current line."
(<= clevel level)
(>= clevel lowest) ; Is inside the level we want.
(or all
- (and gnus-group-list-inactive-groups
- (eq unread t))
- (> unread 0)
+ (if (eq unread t)
+ gnus-group-list-inactive-groups
+ (> unread 0))
(and gnus-list-groups-with-ticked-articles
(cdr (assq 'tick (gnus-info-marks info))))
; Has right readedness.
(defun gnus-group-topic-p ()
"Return non-nil if the current line is a topic."
- (get-text-property (gnus-point-at-bol) 'gnus-topic))
+ (gnus-group-topic-name))
(defun gnus-topic-visible-p ()
"Return non-nil if the current topic is visible."
(prog1 (1+ (point))
(eval gnus-topic-line-format-spec)
(gnus-topic-remove-excess-properties))
- (list 'gnus-topic name
+ (list 'gnus-topic (intern name)
'gnus-topic-level level
'gnus-active active-topic
'gnus-topic-visible visiblep))))
out))
(defun gnus-topic-goto-topic (topic)
- (let ((orig (point)))
- (goto-char (point-min))
- (while (and (not (equal topic (gnus-group-topic-name)))
- (zerop (forward-line 1))))
- (or (gnus-group-topic-name)
- (progn
- (goto-char orig)
- nil))))
+ (when topic
+ (gnus-goto-char (text-property-any (point-min) (point-max)
+ 'gnus-topic (intern topic)))))
(defun gnus-topic-update-topic ()
"Update all parent topics to the current group."
(defun gnus-topic-goto-next-group (group props)
"Go to group or the next group after group."
(if (null group)
- (gnus-topic-goto-topic (cadr (memq 'gnus-topic props)))
+ (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))
(if (gnus-group-goto-group group)
t
;; The group is no longer visible.
(widen)
(re-search-backward gnus-signature-separator nil t)
(let ((start (match-beginning 0))
- (end (set-marker (make-marker) (match-end 0))))
- (gnus-article-add-button start end 'gnus-signature-toggle
+ (end (set-marker (make-marker) (1+ (match-end 0)))))
+ (gnus-article-add-button start (1- end) 'gnus-signature-toggle
end)))))))
(defun gnus-article-add-buttons (&optional force)
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t))
(if (get-text-property end 'invisible)
- (remove-text-properties end (point-max) gnus-hidden-properties)
- (add-text-properties end (point-max) gnus-hidden-properties)))))
+ (gnus-unhide-text end (point-max))
+ (gnus-hide-text end (point-max) gnus-hidden-properties)))))
(defun gnus-button-entry ()
;; Return the first entry in `gnus-button-alist' matching this place.
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.52"
+(defconst gnus-version "September Gnus v0.53"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(substring subject (match-end 0))
subject))
+(defsubst gnus-functionp (form)
+ "Return non-nil if FORM is funcallable."
+ (or (and (symbolp form) (fboundp form))
+ (and (listp form) (eq (car form) 'lambda))))
+
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
(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)
+
(gnus-update-group-mark-positions)
(gnus-update-summary-mark-positions))
(gnus-configure-frame split (get-buffer-window (current-buffer))))))
(defun gnus-all-windows-visible-p (split)
- (when (vectorp split)
- (setq split (append split nil)))
- (when (or (consp (car split))
- (vectorp (car split)))
- (push 1.0 split)
- (push 'vertical split))
- ;; The SPLIT might be something that is to be evaled to
- ;; return a new SPLIT.
- (while (and (not (assq (car split) gnus-window-to-buffer))
- (gnus-functionp (car split)))
- (setq split (eval split)))
- (let* ((type (elt split 0)))
- (cond
- ((null split)
- t)
- ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame)))
- (let ((buffer (cond ((stringp type) type)
- (t (cdr (assq type gnus-window-to-buffer)))))
- win buf)
+ "Say whether all buffers in SPLIT are currently visible.
+In particular, the value returned will be the window that
+should have point."
+ (let ((stack (list split))
+ (all-visible t)
+ type buffer win buf)
+ (while (and (setq split (pop stack))
+ all-visible)
+ ;; Be backwards compatible.
+ (when (vectorp split)
+ (setq split (append split nil)))
+ (when (or (consp (car split))
+ (vectorp (car split)))
+ (push 1.0 split)
+ (push 'vertical split))
+ ;; The SPLIT might be something that is to be evaled to
+ ;; return a new SPLIT.
+ (while (and (not (assq (car split) gnus-window-to-buffer))
+ (gnus-functionp (car split)))
+ (setq split (eval split)))
+
+ (setq type (elt split 0))
+ (cond
+ ;; Nothing here.
+ ((null split) t)
+ ;; A buffer.
+ ((not (memq type '(horizontal vertical frame)))
+ (setq buffer (cond ((stringp type) type)
+ (t (cdr (assq type gnus-window-to-buffer)))))
(unless buffer
(error "Illegal buffer type: %s" type))
- (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
+ (when (setq buf (get-buffer (if (symbolp buffer)
+ (symbol-value buffer)
buffer)))
(setq win (get-buffer-window buf t)))
- (when win
- (if (memq 'point split)
- win
- t))))
- (t
- (when (eq type 'frame)
- (setq gnus-frame-split-p t))
- (let ((n (mapcar 'gnus-all-windows-visible-p
- (cddr split)))
- (win t))
- (while n
- (cond ((windowp (car n))
- (setq win (car n)))
- ((null (car n))
- (setq win nil)))
- (setq n (cdr n)))
- win)))))
+ (if win
+ (when (memq 'point split)
+ (setq all-visible win))
+ (setq all-visible nil)))
+ (t
+ (when (eq type 'frame)
+ (setq gnus-frame-split-p t))
+ (setq stack (append (cddr split) stack)))))
+ (unless (eq all-visible t)
+ all-visible)))
(defun gnus-window-top-edge (&optional window)
(nth 1 (window-edges window)))
;; from `message'.
(apply 'format args)))
-(defun gnus-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))))
-
;; Generate a unique new group name.
(defun gnus-generate-new-group-name (leaf)
(let ((name leaf)
(setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
name))
+(defsubst gnus-hide-text (b e props)
+ "Set text PROPS on the B to E region, extending `intangble' 1 past B."
+ (add-text-properties b e props)
+ (when (memq 'intangible props)
+ (put-text-property (1- b) b 'intangible (cddr (memq 'intangible props)))))
+
+(defsubst gnus-unhide-text (b e)
+ "Remove hidden text properties from region between B and E."
+ (remove-text-properties b e gnus-hidden-properties)
+ (when (memq 'intangible gnus-hidden-properties)
+ (put-text-property (1- b) b 'intangible nil)))
+
+(defun gnus-hide-text-type (b e type)
+ "Hide text of TYPE between B and E."
+ (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
+
;; Find out whether the gnus-visual TYPE is wanted.
(defun gnus-visual-p (&optional type class)
(and gnus-visual ; Has to be non-nil, at least.
(<= (setq clevel (gnus-info-level info)) level)
(>= clevel lowest)
(or all ; We list all groups?
- (and gnus-group-list-inactive-groups
- (eq unread t)) ; We list unactivated groups
- (> unread 0) ; We list groups with unread articles
+ (if (eq unread t) ; Unactivated?
+ gnus-group-list-inactive-groups ; We list unactivated
+ (> unread 0)) ; We list groups with unread articles
(and gnus-list-groups-with-ticked-articles
(cdr (assq 'tick (gnus-info-marks info))))
; And groups with tickeds
(string-match regexp (symbol-name group))
(setq groups (cons (symbol-name group) groups))))
gnus-active-hashtb)
- ;; Go through all descriptions that are known to Gnus.
- (if search-description
- (mapatoms
- (lambda (group)
- (and (string-match regexp (symbol-value group))
- (gnus-active (symbol-name group))
- (setq groups (cons (symbol-name group) groups))))
- gnus-description-hashtb))
+ ;; Also go through all descriptions that are known to Gnus.
+ (when search-description
+ (mapatoms
+ (lambda (group)
+ (and (string-match regexp (symbol-value group))
+ (gnus-active (symbol-name group))
+ (setq groups (cons (symbol-name group) groups))))
+ gnus-description-hashtb))
(if (not groups)
(gnus-message 3 "No groups matched \"%s\"." regexp)
;; Print out all the groups.
(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
(defun gnus-make-thread-indent-array ()
(let ((n 200))
- (if (and gnus-thread-indent-array
- (= gnus-thread-indent-level gnus-thread-indent-array-level))
- nil
+ (unless (and gnus-thread-indent-array
+ (= gnus-thread-indent-level gnus-thread-indent-array-level))
(setq gnus-thread-indent-array (make-vector 201 "")
gnus-thread-indent-array-level gnus-thread-indent-level)
(while (>= n 0)
(when (and (setq references (mail-header-references header))
(not (string= references "")))
(insert references)
- (setq child (downcase (mail-header-id header))
+ (setq child (mail-header-id header)
subject (mail-header-subject header))
(setq generation 0)
(while (search-backward ">" nil t)
(setq end (1+ (point)))
(when (search-backward "<" nil t)
(push (list (incf generation)
- child (setq child (downcase
- (buffer-substring (point) end)))
+ child (setq child (buffer-substring (point) end))
subject)
relations)))
(push (list (1+ generation) child nil subject) relations)
(defun gnus-id-to-thread (id)
"Return the (sub-)thread where ID appears."
- (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
+ (gnus-gethash id gnus-newsgroup-dependencies))
(defun gnus-id-to-article (id)
"Return the article number of ID."
(defun gnus-root-id (id)
"Return the id of the root of the thread where ID appears."
(let (last-id prev)
- (while (and id (setq prev (car (gnus-gethash
- (downcase id)
- gnus-newsgroup-dependencies))))
+ (while (and id (setq prev (car (gnus-gethash
+ id gnus-newsgroup-dependencies))))
(setq last-id id
id (gnus-parent-id (mail-header-references prev))))
last-id))
(if thread
(unless dont-remove
(setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
- (setq thread (gnus-gethash (downcase last-id) dep)))
+ (setq thread (gnus-gethash last-id dep)))
(when thread
(prog1
thread ; We return this thread.
(or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
gnus-summary-default-score 0)
(mapcar 'gnus-thread-total-score
- (cdr (gnus-gethash (downcase (mail-header-id root))
+ (cdr (gnus-gethash (mail-header-id root)
gnus-newsgroup-dependencies)))))
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(setq end (match-end 0))
(save-excursion
(setq ref
- (downcase
- (buffer-substring
- (progn
- (end-of-line)
- (search-backward ">" end t)
- (1+ (point)))
- (progn
- (search-backward "<" end t)
- (point)))))))
+ (buffer-substring
+ (progn
+ (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
;; Get the references from the in-reply-to header if there
;; were no references and the in-reply-to header looks
;; promising.
(prog1
(setq ref (substring in-reply-to (match-beginning 0)
(match-end 0)))
- (setq ref (downcase ref))))
+ (setq ref ref)))
(setq ref "")))
;; Chars.
0
;; the same hash table. Some tippy-toeing around has to be
;; done in case an article has arrived before the article
;; which it refers to.
- (if (boundp (setq id-dep (intern (downcase id) dependencies)))
+ (if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
;; An article with this Message-ID has already
(search-forward "\t" eol)
(if (search-backward ">" beg t)
(setq ref
- (downcase
- (buffer-substring
- (1+ (point))
- (progn
- (search-backward "<" beg t)
- (point)))))
+ (buffer-substring
+ (1+ (point))
+ (search-backward "<" beg t)))
(setq ref nil))))
(gnus-nov-field)) ; refs
(gnus-nov-read-integer) ; chars
;; We build the thread tree.
(when header
- (if (boundp (setq id-dep (intern (downcase id) dependencies)))
+ (if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
;; An article with this Message-ID has already been seen,
(setq message-id (concat "<" message-id)))
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
- (let ((header (car (gnus-gethash (downcase message-id)
+ (let ((header (car (gnus-gethash message-id
gnus-newsgroup-dependencies))))
(if header
;; The article is present in the buffer, to we just go to it.
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
If PREVIOUS is non-nil, go to previous thread instead.
+Return the article number moved to, or nil if moving was impossible."
+ (let ((level (gnus-summary-thread-level))
+ (way (if previous -1 1))
+ (beg (point)))
+ (forward-line way)
+ (while (and (not (eobp))
+ (< level (gnus-summary-thread-level)))
+ (forward-line way))
+ (if (eobp)
+ (progn
+ (goto-char beg)
+ nil)
+ (setq beg (point))
+ (prog1
+ (gnus-summary-article-number)
+ (goto-char beg)))))
+
+(defun gnus-summary-go-to-next-thread-old (&optional previous)
+ "Go to the same level (or less) next thread.
+If PREVIOUS is non-nil, go to previous thread instead.
Return the article number moved to, or nil if moving was impossible."
(if (and (eq gnus-summary-make-false-root 'dummy)
(gnus-summary-article-intangible-p))
(n (abs n))
old dum int)
(while (and (> n 0)
- (setq old (save-excursion
- (forward-line 1)
- (setq int (gnus-summary-article-intangible-p))
- (point)))
- (or int
- (gnus-summary-go-to-next-thread backward)))
- (when (and (eq gnus-summary-make-false-root 'dummy)
- (setq dum (text-property-not-all
- old (point) 'gnus-intangible nil)))
- (goto-char dum))
+ (gnus-summary-go-to-next-thread backward))
(decf n))
(unless silent
(gnus-summary-position-point))
(goto-char (point-max))
(insert ".\n")
(goto-char (point-min))
- (insert "211 "
- (int-to-string
- (cond
- ((numberp id)
- id)
- ((cdr where)
- (cdr where))
- (t
- gnus-reffed-article-number)))
- " Article retrieved.\n"))
+ (insert "211 ")
+ (princ (cond
+ ((numberp id) id)
+ ((cdr where) (cdr where))
+ (t gnus-reffed-article-number))
+ (current-buffer))
+ (insert " Article retrieved.\n"))
(if (not (setq header (car (gnus-get-newsgroup-headers))))
() ; Malformed head.
(if (and (stringp id)
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil))
- (remove-text-properties (point-min) (point-max)
- gnus-hidden-properties))))
+ (gnus-unhide-text (point-min) (point-max)))))
(defun gnus-article-hide-headers-if-wanted ()
"Hide unwanted headers if `gnus-have-all-headers' is nil.
(set-buffer gnus-article-buffer)
(save-restriction
(let ((buffer-read-only nil)
+ (props (nconc (list 'gnus-type 'headers)
+ gnus-hidden-properties))
(ignored (when (not (stringp gnus-visible-headers))
(cond ((stringp gnus-ignored-headers)
gnus-ignored-headers)
(while (looking-at "From ")
(forward-line 1))
(unless (bobp)
- (add-text-properties
- (point-min) (point)
- (nconc (list 'gnus-type 'headers) gnus-hidden-properties)))
+ (gnus-hide-text (point-min) (point) props))
;; Then treat the rest of the header lines.
(narrow-to-region
(point)
(if delete
(delete-region (point-min) (point-max))
;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (add-text-properties
- (point) (point-max)
- (nconc (list 'gnus-type 'headers)
- gnus-hidden-properties)))))))))
+ (gnus-hide-text-type (point) (point-max) 'headers))))))))
(defsubst gnus-article-header-rank (header)
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
((eq elem 'empty)
(while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
(forward-line -1)
- (add-text-properties
+ (gnus-hide-text-type
(progn (beginning-of-line) (point))
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
(point-max)))
- (nconc (list 'gnus-type 'boring-headers)
- gnus-hidden-properties))))
+ 'boring-headers)))
;; Hide boring Newsgroups header.
((eq elem 'newsgroups)
(when (equal (mail-fetch-field "newsgroups")
(save-excursion
(goto-char (point-min))
(when (re-search-forward (concat "^" header ":") nil t)
- (add-text-properties
+ (gnus-hide-text-type
(progn (beginning-of-line) (point))
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
(point-max)))
- (nconc (list 'gnus-type 'boring-headers)
- gnus-hidden-properties)))))
+ 'boring-headers))))
;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-article-treat-overstrike ()
(goto-char (point-min))
;; Hide the "header".
(and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
- (add-text-properties (match-beginning 0) (match-end 0) props))
+ (gnus-hide-text (match-beginning 0) (match-end 0) props))
(setq beg (point))
;; Hide the actual signature.
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
(setq end (match-beginning 0))
- (add-text-properties
+ (gnus-hide-text
(match-beginning 0)
(if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
(match-end 0)
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "^- " nil t)
- (add-text-properties (match-beginning 0) (match-end 0) props))
+ (gnus-hide-text (match-beginning 0) (match-end 0) props))
(widen))))))
(defun gnus-article-hide-signature (&optional arg)
(save-restriction
(let ((buffer-read-only nil))
(when (gnus-narrow-to-signature)
- (add-text-properties
- (point-min) (point-max)
- (nconc (list 'gnus-type 'signature)
- gnus-hidden-properties))))))))
+ (gnus-hide-text-type (point-min) (point-max) 'signature)))))))
(defun gnus-article-strip-leading-blank-lines ()
"Remove all blank lines from the beginning of the article."
(setq beg (point))
(forward-char)
(if hide
- (add-text-properties beg (point) gnus-hidden-properties)
- (remove-text-properties beg (point) gnus-hidden-properties))
+ (gnus-hide-text beg (point) gnus-hidden-properties)
+ (gnus-unhide-text beg (point)))
(setq beg (point)))
t)))
(defun gnus-open-server (method)
"Open a connection to METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(let ((elem (assoc method gnus-opened-servers)))
;; If this method was previously denied, we just return nil.
(if (eq (nth 1 elem) 'denied)
(defun gnus-close-server (method)
"Close the connection to METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'close-server) (nth 1 method)))
(defun gnus-request-list (method)
"Request the active file from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-list) (nth 1 method)))
(defun gnus-request-list-newsgroups (method)
"Request the newsgroups file from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
(defun gnus-request-newgroups (date method)
"Request all new groups since DATE from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-newgroups)
date (nth 1 method)))
(defun gnus-server-opened (method)
"Check whether a connection to METHOD has been opened."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'server-opened) (nth 1 method)))
(defun gnus-status-message (method)
(defun gnus-request-group (group &optional dont-check method)
"Request GROUP. If DONT-CHECK, no information is required."
(let ((method (or method (gnus-find-method-for-group group))))
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-group)
(gnus-group-real-name group) (nth 1 method) dont-check)))
(defun gnus-retrieve-groups (groups method)
"Request active information on GROUPS from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
(defun gnus-request-type (group &optional article)
(defun gnus-request-post (method)
"Post the current buffer using METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-post) (nth 1 method)))
(defun gnus-request-scan (group method)
(defsubst gnus-request-update-info (info method)
"Request that METHOD update INFO."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(when (gnus-check-backend-function 'request-update-info (car method))
(funcall (gnus-get-function method 'request-update-info)
(gnus-group-real-name (gnus-info-group info))
(defun gnus-request-accept-article (group &optional last method)
;; Make sure there's a newline at the end of the article.
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
article (gnus-group-real-name group) (nth 1 method))))
(defun gnus-request-create-group (group &optional method)
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(let ((method (or method (gnus-find-method-for-group group))))
(funcall (gnus-get-function method 'request-create-group)
(gnus-group-real-name group) (nth 1 method))))
(defun gnus-method-option-p (method option)
"Return non-nil if select METHOD has OPTION as a parameter."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(memq option (assoc (format "%s" (car method))
gnus-valid-select-methods)))
(gnus-check-server gnus-select-method))
(gnus-find-new-newsgroups))
+ ;; We might read in new NoCeM messages here.
+ (when gnus-use-nocem
+ (gnus-nocem-scan-groups))
+
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
(gnus-get-unread-articles level))
(setq gnus-killed-hashtb
(gnus-make-hashtable
(+ (length gnus-killed-list) (length gnus-zombie-list))))
- (while lists
- (setq list (symbol-value (car lists)))
- (setq lists (cdr lists))
+ (while (setq list (symbol-value (pop lists)))
(while list
- (gnus-sethash (car list) (car list) gnus-killed-hashtb)
- (setq list (cdr list))))))
+ (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when active
(set-buffer (create-file-buffer gnus-current-startup-file))
(let ((newsrc (cdr gnus-newsrc-alist))
(standard-output (current-buffer))
- info ranges range)
+ info ranges range method)
(setq buffer-file-name gnus-current-startup-file)
(buffer-disable-undo (current-buffer))
(erase-buffer)
;; Write subscribed and unsubscribed.
(while (setq info (pop newsrc))
;; Don't write foreign groups to .newsrc.
- (when (gnus-server-equal (gnus-info-method info) gnus-select-method)
+ (when (or (null (setq method (gnus-info-method info)))
+ (equal method "native")
+ (gnus-server-equal method gnus-select-method))
(insert (gnus-info-group info)
(if (> (gnus-info-level info) gnus-level-subscribed)
"!" ":"))
(princ (car ranges))
(insert "-")
(princ (cdr ranges)))
- (while ranges
- (setq range (car ranges)
- ranges (cdr ranges))
+ (while (setq range (pop ranges))
(if (or (atom range) (= (car range) (cdr range)))
(princ (or (and (atom range) range) (car range)))
(princ (car range))
(list (list group ""))
nnmail-split-methods)))
(save-excursion
- ;; Open the message-id cache.
- (nnmail-cache-open)
;; Insert the incoming file.
(set-buffer (get-buffer-create " *nnmail incoming*"))
(buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-file-contents incoming)
- (goto-char (point-min))
- (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
- ;; Handle both babyl, MMDF and unix mail formats, since movemail will
- ;; use the former when fetching from a mailbox, the latter when
- ;; fetches from a file.
- (cond ((or (looking-at "\^L")
- (looking-at "BABYL OPTIONS:"))
- (nnmail-process-babyl-mail-format func))
- ((looking-at "\^A\^A\^A\^A")
- (nnmail-process-mmdf-mail-format func))
- (t
- (nnmail-process-unix-mail-format func)))
- ;; Close the message-id cache.
- (nnmail-cache-close)
+ (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
+ ;; Handle both babyl, MMDF and unix mail formats, since movemail will
+ ;; use the former when fetching from a mailbox, the latter when
+ ;; fetches from a file.
+ (cond ((or (looking-at "\^L")
+ (looking-at "BABYL OPTIONS:"))
+ (nnmail-process-babyl-mail-format func))
+ ((looking-at "\^A\^A\^A\^A")
+ (nnmail-process-mmdf-mail-format func))
+ (t
+ (nnmail-process-unix-mail-format func))))
(if exit-func (funcall exit-func))
(kill-buffer (current-buffer)))))
(nnmail-activate method)
;; Allow the user to hook.
(run-hooks 'nnmail-pre-get-new-mail-hook)
+ ;; Open the message-id cache.
+ (nnmail-cache-open)
;; The we go through all the existing spool files and split the
;; mail from each.
(while spools
(funcall exit-func))
(run-hooks 'nnmail-read-incoming-hook)
(nnheader-message 3 "%s: Reading incoming mail...done" method))
+ ;; Close the message-id cache.
+ (nnmail-cache-close)
;; Allow the user to hook.
(run-hooks 'nnmail-post-get-new-mail-hook)
;; Delete all the temporary files.
(setq result (nnmbox-save-mail (and (stringp group) group))))
(save-excursion
(set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-max))
(insert-buffer-substring buf)
(and last (save-buffer))
result)
(defvar nnsoup-replies-list nil)
(defvar nnsoup-buffers nil)
(defvar nnsoup-current-group nil)
+(defvar nnsoup-group-alist-touched nil)
\f
(nnsoup-packet-directory ,nnsoup-packet-directory)
(nnsoup-unpacker ,nnsoup-unpacker)
(nnsoup-packer ,nnsoup-packer)
+ (nnsoup-group-alist-touched nil)
(nnsoup-replies-index-type ,nnsoup-replies-index-type)
(nnsoup-replies-format-type ,nnsoup-replies-format-type)
(nnsoup-replies-directory ,nnsoup-replies-directory)
(defun nnsoup-close-server (&optional server)
(setq nnsoup-current-server nil
+ nnsoup-group-alist-touched nil
nnsoup-group-alist nil)
t)
(buffer-name buffer)
(kill-buffer buffer))))
(setq nnsoup-group-alist nil
+ nnsoup-group-alist-touched nil
nnsoup-current-group nil
nnsoup-current-server nil
nnsoup-server-alist nil
(set-buffer nntp-server-buffer)
(erase-buffer)
(let ((alist nnsoup-group-alist)
+ (standard-output (current-buffer))
entry)
(while (setq entry (pop alist))
- (insert (format "%s %d %d y\n" (car entry)
- (cdadr entry) (caadr entry))))
+ (insert (car entry) " ")
+ (princ (cdadr entry))
+ (insert " ")
+ (princ (caadr entry))
+ (insert " y\n"))
t)))
(defun nnsoup-request-scan (group &optional server)
(if (cddr total-infolist)
(setcar active (caaadr (cdr total-infolist)))
(setcar active (1+ (cdr active))))
- (nnsoup-write-active-file)
+ (nnsoup-write-active-file t)
;; Return the articles that weren't expired.
articles))
(setq nnsoup-group-alist)
(when (file-exists-p nnsoup-active-file)
(condition-case ()
- (load nnsoup-active-file)
+ (load nnsoup-active-file t t t)
(error nil))
;; Be backwards compatible.
(when (and nnsoup-group-alist
(while (cdr e)
(setq e (cdr e)))
(setq max (cdaar e))
- (setcdr entry (cons (cons min max) (cdr entry))))))
+ (setcdr entry (cons (cons min max) (cdr entry)))))
+ (setq nnsoup-group-alist-touched t))
nnsoup-group-alist))
-(defun nnsoup-write-active-file ()
- (when nnsoup-group-alist
- (save-excursion
- (set-buffer (get-buffer-create " *nnsoup work*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert (format "(setq nnsoup-group-alist '%S)\n" nnsoup-group-alist))
- (insert (format "(setq nnsoup-current-prefix %d)\n"
- nnsoup-current-prefix))
- (write-region (point-min) (point-max) nnsoup-active-file
- nil 'silent)
- (kill-buffer (current-buffer)))))
+(defun nnsoup-write-active-file (&optional force)
+ (when (and nnsoup-group-alist
+ (or force
+ nnsoup-group-alist-touched))
+ (setq nnsoup-group-alist-touched 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))))))
(defun nnsoup-next-prefix ()
"Return the next free prefix."
(+ lnum number))
area)))
(setcdr (cadr entry) (+ lnum number))))))
- (nnsoup-write-active-file)
+ (nnsoup-write-active-file t)
(delete-file (concat nnsoup-tmp-directory "AREAS"))))
(defun nnsoup-number-of-articles (area)
(while active
(setcdr (car active) (nreverse (cdar active)))
(setq active (cdr active)))
- (nnsoup-write-active-file)))
+ (nnsoup-write-active-file t)))
(defun nnsoup-delete-unreferenced-message-files ()
"Delete any *.MSG and *.IDX files that aren't known by nnsoup."
(when (nnspool-possibly-change-directory group)
(let* ((number (length articles))
(count 0)
+ (default-directory nnspool-current-directory)
(do-message (and (numberp nnspool-large-newsgroup)
(> number nnspool-large-newsgroup)))
file beg article ag)
;; We successfully retrieved the NOV headers.
'nov
;; No NOV headers here, so we do it the hard way.
- (while articles
- (setq article (pop articles))
+ (while (setq article (pop articles))
(if (stringp article)
;; This is a Message-ID.
(setq ag (nnspool-find-id article)
(car ag) (cdr ag)))
article (cdr ag))
;; This is an article in the current group.
- (setq file (nnspool-article-pathname
- nnspool-current-group article)))
+ (setq file (int-to-string article)))
;; Insert the head of the article.
(when (and file
(file-exists-p file))
- (insert (format "221 %d Article retrieved.\n" article))
+ (insert "221 ")
+ (princ article (current-buffer))
+ (insert " Article retrieved.\n")
(setq beg (point))
- (nnheader-insert-head file)
+ (inline (nnheader-insert-head file))
(goto-char beg)
(search-forward "\n\n" nil t)
(forward-char -1)
(defun nntp-send-xover-command (beg end &optional wait-for-reply)
"Send the XOVER command to the server."
- (let ((range (format "%d-%d" beg end)))
+ (let ((range (format "%d-%d" (or beg 1) (or end beg 1))))
(if (stringp nntp-server-xover)
;; If `nntp-server-xover' is a string, then we just send this
;; command.
(nnvirtual-possibly-change-group group server t)
(let ((gnus-group-marked nnvirtual-component-groups)
(gnus-expert-user t))
+ ;; Make sure all groups are activated.
+ (mapcar
+ (lambda (g)
+ (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
+ (gnus-activate-group g)))
+ nnvirtual-component-groups)
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-group-catchup-current nil all))))
* Saving Articles:: Ways of customizing article saving.
* Decoding Articles:: Gnus can treat series of (uu)encoded articles.
* Article Treatment:: The article buffer can be mangled at will.
-* Summary Sorting:: You can sort the summary buffer four ways.
+* Summary Sorting:: Sorting the summary buffer in various ways.
* Finding the Parent:: No child support? Get the parent.
* Alternative Approaches:: Reading using non-default summaries.
* Tree Display:: A more visual display of threads.
projects / gnus / commitdiff