+Sat Nov 23 05:00:36 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-cache.el (gnus-cache-update-active): Wouldn't mark the
+ cache active file as changed.
+
+ * gnus-start.el (gnus-setup-news): Slaves shouldn't check for new
+ newsgroups.
+
+ * gnus-sum.el (gnus-group-make-articles-read): Update group line
+ on undo.
+
+ * gnus-move.el (gnus-move-group-to-server): Check whether
+ to-active is nil.
+
+ * gnus-score.el (gnus-score-find-hierarchical): Do the right thing
+ for prefixed group names.
+
+ * nnml.el (nnml-generate-nov-databases-1): Don't infloop.
+
+Sat Nov 23 04:58:49 1996 Steven L. Baur <steve@miranova.com>
+
+ * gnus-score.el (gnus-score-score-files-1): Don't infloop.
+
+Sat Nov 23 04:40:55 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-art.el (gnus-article-make-menu-bar): Protect against
+ undefined menu vars.
+
+ * gnus-group.el (gnus-group-rename-group): Prompt fix.
+
+Fri Nov 22 12:17:14 1996 David Moore <dmoore@ucsd.edu>
+
+ * nnml.el (nnml-generate-nov-databases-1): Don't infloop.
+
+ * gnus-score.el (gnus-score-score-files-1): Don't infloop, be
+ slightly faster.
+
+Fri Nov 22 22:18:52 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-move.el (gnus-move-group-to-server): Looking-at bug.
+ (gnus-move-group-to-server): Extend.
+
+ * message.el (message-check-news-header-syntax): Change shoot-me
+ line.
+
+Thu Nov 21 18:31:56 1996 David Moore <dmoore@ucsd.edu>
+
+ * gnus-util.el (gnus-atomic-progn, gnus-atomic-progn-assign,
+ gnus-atomic-setq): Routines to help protect against corruption to
+ internal Gnus datastructures from C-g or error signals.
+
+ * gnus-util.el (gnus-atomic-be-safe): Variable which can set to
+ nil to disable the C-g atomic protection.
+
+ * nnvirtual.el (nnvirtual-update-read-and-marked): Replaces
+ nnvirtual-update-reads and nnvirtual-update-marked. Does updates
+ to component groups atomically.
+ (nnvirtual-request-update-info): Update the virtual group
+ atomically.
+
+Fri Nov 22 00:19:23 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el: Create menu bar even when not using menu-bar-mode.
+
+ * gnus-start.el (gnus-1): Don't paint picture gnu twice.
+
+ * gnus-sum.el (gnus-group-make-articles-read): Undo in the right
+ buffer.
+ (gnus-update-read-articles): Ditto.
+
+Fri Nov 22 00:04:59 1996 Raja R. Harinath <harinath@cs.umn.edu>
+
+ * nnheader.el (nnheader-generate-fake-message-id): Interact better
+ with duplicate suppression.
+
+Thu Nov 21 23:31:30 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el (gnus-info-set-entry): Wouldn't extend far enough.
+
+ * gnus-salt.el (gnus-tree-minimize): Ignore errors.
+
+ * gnus-sum.el (gnus-summary-article-sparse-p): New macro.
+ (gnus-summary-article-ancient-p): Ditto.
+ (gnus-summary-search-article): Skip sparse articles.
+
+ * article.el (article-date-ut): Wouldn't pick out the date right.
+
+Thu Nov 21 23:07:34 1996 Raja R. Harinath <harinath@cs.umn.edu>
+
+ * gnus-dup.el (gnus-dup-enter-articles): Ignore sparse articles.
+
+Thu Nov 21 21:57:52 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-dup.el (gnus-dup-suppress-articles): Only suppress read
+ articles.
+
+ * article.el (article-delete-text-of-type): Would bug out.
+
+Thu Nov 21 11:02:36 1996 David Moore <dmoore@ucsd.edu>
+
+ * nnoo.el (nnoo-change-server): Only preserve un-ooed variables if
+ they exist globally.
+
+Thu Nov 21 10:52:39 1996 Steven L Baur <steve@miranova.com>
+
+ * article.el (article-date-ut): Extend date header recognition to
+ deal with systems that put a TAB after the colon.
+
+Thu Nov 21 19:50:26 1996 Lars Magne Ingebrigtsen <menja.larsi@ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.68 is released.
+
Thu Nov 21 05:33:24 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* nnoo.el (nnoo-change-server): Protect against void vars.
(require 'nnheader)
(require 'gnus-util)
(require 'message)
+(require 'gnus-sum)
(defgroup article nil
"Article display."
(defun article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
(save-excursion
- (let ((b (point-min))
- (e (point-max)))
- (while (setq b (text-property-any b e 'article-type type))
+ (let ((b (point-min)))
+ (while (setq b (text-property-any b (point-max) 'article-type type))
(delete-region b (incf b))))))
(defun article-text-type-exists-p (type)
If TYPE is `local', convert to local time; if it is `lapsed', output
how much time has lapsed since DATE."
(interactive (list 'ut t))
- (let* ((header (or header (message-fetch-field "date") ""))
+ (let* ((header (or header (message-fetch-field "date")
+ (mail-header-date gnus-current-headers)
+ ""))
(date (if (vectorp header) (mail-header-date header)
header))
- (date-regexp "^Date: \\|^X-Sent: ")
+ (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
(inhibit-point-motion-hooks t)
bface eface)
(when (and date (not (string= date "")))
["Remove carriage return" gnus-article-remove-cr t]
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
- (define-key gnus-article-mode-map [menu-bar commands]
- (cons "Commands" gnus-summary-article-menu))
+ (when (boundp 'gnus-summary-article-menu)
+ (define-key gnus-article-mode-map [menu-bar commands]
+ (cons "Commands" gnus-summary-article-menu)))
- (define-key gnus-article-mode-map [menu-bar post]
- (cons "Post" gnus-summary-post-menu))
+ (when (boundp 'gnus-summary-post-menu)
+ (define-key gnus-article-mode-map [menu-bar post]
+ (cons "Post" gnus-summary-post-menu)))
(run-hooks 'gnus-article-menu-hook)))
\\[gnus-article-describe-briefly]\t Describe the current mode briefly
\\[gnus-info-find-node]\t Go to the Gnus info node"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'article-menu 'menu))
+ (when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar))
(kill-all-local-variables)
(gnus-simplify-mode-line)
(defun gnus-cache-possibly-alter-active (group active)
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
+ (when (equal group "no.norsk") (error "hie"))
(when gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
(and cache-active
;; Update the lower or upper bound.
(if low
(setcar active number)
- (setcdr active number))
- ;; Mark the active hashtb as altered.
- (setq gnus-cache-active-altered t))))
+ (setcdr active number)))
+ ;; Mark the active hashtb as altered.
+ (setq gnus-cache-active-altered t)))
;;;###autoload
(defun gnus-cache-generate-active (&optional directory)
(gnus-dup-open))
(setq gnus-dup-list-dirty t) ; mark list for saving
(let ((data gnus-newsgroup-data)
- datum)
+ datum msgid)
;; Enter the Message-IDs of all read articles into the list
;; and hash table.
(while (setq datum (pop data))
(when (and (not (gnus-data-pseudo-p datum))
+ (> (gnus-data-number datum) 0)
(gnus-data-read-p datum)
- (not (intern-soft (mail-header-id (gnus-data-header datum))
- gnus-dup-hashtb)))
- (intern (car (push (mail-header-id (gnus-data-header datum))
- gnus-dup-list))
- gnus-dup-hashtb))))
+ (setq msgid (mail-header-id (gnus-data-header datum)))
+ (not (nnheader-fake-message-id-p msgid))
+ (not (intern-soft msgid gnus-dup-hashtb)))
+ (push msgid gnus-dup-list)
+ (intern msgid gnus-dup-hashtb))))
;; Chop off excess Message-IDs from the list.
(let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
(when end
(unless gnus-dup-list
(gnus-dup-open))
(gnus-message 6 "Suppressing duplicates...")
- (let ((headers gnus-newsgroup-headers)
- number header)
- (while (setq header (pop headers))
- (when (intern-soft (mail-header-id header) gnus-dup-hashtb)
+ (let ((data gnus-newsgroup-data)
+ number d)
+ (while (setq d (pop data))
+ (when (and (intern-soft (mail-header-id (gnus-data-header d))
+ gnus-dup-hashtb)
+ (gnus-data-unread-p d))
(setq gnus-newsgroup-unreads
- (delq (setq number (mail-header-number header))
- gnus-newsgroup-unreads))
+ (delq (setq number (gnus-data-number d)) gnus-newsgroup-unreads))
(push (cons number gnus-duplicate-mark)
gnus-newsgroup-reads))))
(gnus-message 6 "Suppressing duplicates...done"))
\\{gnus-edit-form-mode-map}"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'group-menu 'menu))
+ (when (gnus-visual-p 'group-menu 'menu)
(gnus-edit-form-make-menu-bar))
(kill-all-local-variables)
(setq major-mode 'gnus-edit-form-mode)
\\{gnus-group-mode-map}"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'group-menu 'menu))
+ (when (gnus-visual-p 'group-menu 'menu)
(gnus-group-make-menu-bar))
(kill-all-local-variables)
(gnus-simplify-mode-line)
(unless (gnus-check-backend-function
'request-rename-group (gnus-group-group-name))
(error "This backend does not support renaming groups"))
- (read-string "New group name: " (gnus-group-group-name)))))
+ (read-string "Rename group to: " (gnus-group-group-name)))))
(unless (gnus-check-backend-function 'request-rename-group group)
(error "This backend does not support renaming groups"))
(setq to-active (gnus-parse-active)
hashtb (make-vector 1023 0))
;; Fetch the headers from the `to-server'.
- (when (setq type (gnus-retrieve-headers
- (gnus-uncompress-range to-active) group to-server))
+ (when (and to-active
+ (setq type (gnus-retrieve-headers
+ (gnus-uncompress-range to-active)
+ group to-server)))
;; Convert HEAD headers. I don't care.
(when (eq type 'headers)
(nnvirtual-convert-headers))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(while (looking-at
- "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t"
- nil t)
+ "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
(gnus-sethash
(buffer-substring (match-beginning 1) (match-end 1))
(read (current-buffer))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(while (looking-at
- "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t"
- nil t)
+ "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
(setq to-article
(gnus-gethash
(buffer-substring (match-beginning 1) (match-end 1))
(while a
(setcdr (car a) (gnus-compress-sequence (sort (cdar a) '<)))
(pop a))
- (gnus-info-set-marks info lists)))))
+ (gnus-info-set-marks info lists t)))))
(gnus-message 7 "Translating %s...done" group)))
(defun gnus-group-move-group-to-server (info from-server to-server)
(gnus-update-summary-mark-positions)
(set (make-local-variable 'gnus-summary-goto-unread) 'never)
;; Set up the menu.
- (when (and menu-bar-mode
- (gnus-visual-p 'pick-menu 'menu))
+ (when (gnus-visual-p 'pick-menu 'menu)
(gnus-pick-make-menu-bar))
(unless (assq 'gnus-pick-mode minor-mode-alist)
(push '(gnus-pick-mode " Pick") minor-mode-alist))
(make-local-variable 'gnus-summary-display-article-function)
(setq gnus-summary-display-article-function 'gnus-binary-display-article)
;; Set up the menu.
- (when (and menu-bar-mode
- (gnus-visual-p 'binary-menu 'menu))
+ (when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar))
(unless (assq 'gnus-binary-mode minor-mode-alist)
(push '(gnus-binary-mode " Binary") minor-mode-alist))
(setq gnus-tree-line-format-spec
(gnus-parse-format gnus-tree-line-format
gnus-tree-line-format-alist t))
- (when (and menu-bar-mode
- (gnus-visual-p 'tree-menu 'menu))
+ (when (gnus-visual-p 'tree-menu 'menu)
(gnus-tree-make-menu-bar))
(kill-all-local-variables)
(gnus-simplify-mode-line)
(when (and win
(not (eq tot wh)))
(let ((selected (selected-window)))
- (select-window win)
- (enlarge-window (- tot wh))
- (select-window selected)))))))
+ (when (ignore-errors (select-window win))
+ (enlarge-window (- tot wh))
+ (select-window selected))))))))
;;; Generating the tree.
(defun gnus-score-score-files-1 (dir)
"Return all possible score files under DIR."
- (let ((files (directory-files (expand-file-name dir) t nil t))
+ (let ((files (list (expand-file-name dir)))
(regexp (gnus-score-file-regexp))
(case-fold-search nil)
- out file)
+ seen out file)
(while (setq file (pop files))
(cond
;; Ignore "." and "..".
((member (file-name-nondirectory file) '("." ".."))
nil)
- ;; Recurse down directories.
- ((file-directory-p file)
- (setq out (nconc (gnus-score-score-files-1 file) out)))
+ ;; Add subtrees of directory to also be searched.
+ ((and (file-directory-p file)
+ (not (member (file-truename file) seen)))
+ (push (file-truename file) seen)
+ (setq files (nconc (directory-files file t nil t) files)))
;; Add files to the list of score files.
((string-match regexp file)
(push file out))))
(defun gnus-score-find-hierarchical (group)
"Return list of score files for GROUP.
This includes the score file for the group and all its parents."
- (let ((all (copy-sequence '(nil)))
- (start 0))
+ (let* ((prefix (gnus-group-real-prefix group))
+ (all (list nil))
+ (group (gnus-group-real-name group))
+ (start 0))
(while (string-match "\\." group (1+ start))
(setq start (match-beginning 0))
(push (substring group 0 start) all))
(push group all)
- (nconc
- (mapcar (lambda (newsgroup)
- (gnus-score-file-name newsgroup gnus-adaptive-file-suffix))
- (setq all (nreverse all)))
- (mapcar 'gnus-score-file-name all))))
+ (setq all
+ (nconc
+ (mapcar (lambda (group)
+ (gnus-score-file-name group gnus-adaptive-file-suffix))
+ (setq all (nreverse all)))
+ (mapcar 'gnus-score-file-name all)))
+ (if (equal prefix "")
+ all
+ (mapcar
+ (lambda (file)
+ (concat (file-name-directory file) prefix
+ (file-name-nondirectory file)))
+ all))))
(defun gnus-score-file-rank (file)
"Return a number that says how specific score FILE is.
\\{gnus-server-mode-map}"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'server-menu 'menu))
+ (when (gnus-visual-p 'server-menu 'menu)
(gnus-server-make-menu-bar))
(kill-all-local-variables)
(gnus-simplify-mode-line)
3) `\\[gnus-browse-exit]' to return to the group buffer."
(interactive)
(kill-all-local-variables)
- (when (and menu-bar-mode
- (gnus-visual-p 'browse-menu 'menu))
+ (when (gnus-visual-p 'browse-menu 'menu)
(gnus-browse-make-menu-bar))
(gnus-simplify-mode-line)
(setq major-mode 'gnus-browse-mode)
(gnus-read-init-file)
(setq gnus-slave slave)
- (when (string-match "XEmacs" (emacs-version))
+ (when (and (string-match "XEmacs" (emacs-version))
+ gnus-simple-splash)
+ (setq gnus-simple-splash nil)
(gnus-xmas-splash))
(let ((level (and (numberp arg) (> arg 0) arg))
;; Find new newsgroups and treat them.
(when (and init gnus-check-new-newsgroups (not level)
- (gnus-check-server gnus-select-method))
+ (gnus-check-server gnus-select-method)
+ (not gnus-slave))
(gnus-find-new-newsgroups))
;; We might read in new NoCeM messages here.
\\{gnus-summary-mode-map}"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'summary-menu 'menu))
+ (when (gnus-visual-p 'summary-menu 'menu)
(gnus-summary-make-menu-bar))
(kill-all-local-variables)
(gnus-summary-make-local-variables)
"Say whether this article is a pseudo article or not."
(not (vectorp (gnus-data-header (gnus-data-find article)))))
+(defmacro gnus-summary-article-sparse-p (article)
+ "Say whether this article is a sparse article or not."
+ ` (memq ,article gnus-newsgroup-sparse))
+
+(defmacro gnus-summary-article-ancient-p (article)
+ "Say whether this article is a sparse article or not."
+ `(memq ,article gnus-newsgroup-ancient))
+
(defun gnus-article-parent-p (number)
"Say whether this article is a parent or not."
(let ((data (gnus-data-find-list number)))
default-score)
gnus-summary-mark-below)
;; Don't touch sparse articles.
- (not (memq number gnus-newsgroup-sparse))
- (not (memq number gnus-newsgroup-ancient)))
+ (not (gnus-summary-article-sparse-p number))
+ (not (gnus-summary-article-ancient-p number)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
gnus-summary-mark-below)
- (not (memq number gnus-newsgroup-ancient)))
+ (not (gnus-summary-article-ancient-p number)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
(when (or (> id (cdr active))
(< id (car active)))
(setq articles (delq id articles))))))
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-group-update-group ,group t)))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
;; If the read list is nil, we init it.
(and active
(null (gnus-info-read info))
;; Message-ID.
(progn
(goto-char p)
- (if (search-forward "\nmessage-id: " nil t)
- (setq id (nnheader-header-value))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (setq id (concat "none+"
- (int-to-string
- (setq gnus-newsgroup-none-id
- (1+ gnus-newsgroup-none-id)))))))
+ (setq id (if (search-forward "\nmessage-id: " nil t)
+ (nnheader-header-value)
+ ;; If there was no message-id, we just fake one
+ ;; to make subsequent routines simpler.
+ (nnheader-generate-fake-message-id))))
;; References.
(progn
(goto-char p)
(defmacro gnus-nov-field ()
'(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-(defvar gnus-nov-none-counter 0)
+;; (defvar gnus-nov-none-counter 0)
;; This function has to be called with point after the article number
;; on the beginning of the line.
(gnus-nov-field) ; from
(gnus-nov-field) ; date
(setq id (or (gnus-nov-field)
- (concat "none+"
- (int-to-string
- (incf gnus-nov-none-counter))))) ; id
+ (nnheader-generate-fake-message-id))) ; id
(progn
(let ((beg (point)))
(search-forward "\t" eol)
(while (and
thread
(or
- (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
- (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
+ (gnus-summary-article-sparse-p (mail-header-number (car thread)))
+ (gnus-summary-article-ancient-p
+ (mail-header-number (car thread))))
(or (<= (length (cdr thread)) 1)
(gnus-invisible-cut-children (cdr thread))))
(setq thread (cadr thread))))
;; If this is "fetch-old-headered" and there is only one
;; visible child (or less), then we don't want this article.
(and (eq gnus-fetch-old-headers 'some)
- (memq number gnus-newsgroup-ancient)
+ (gnus-summary-article-ancient-p number)
(zerop children))
;; If this is a sparsely inserted article with no children,
;; we don't want it.
(and (eq gnus-build-sparse-threads 'some)
- (memq number gnus-newsgroup-sparse)
+ (gnus-summary-article-sparse-p number)
(zerop children))
;; If we use expunging, and this article is really
;; low-scored, then we don't want this article.
(setq message-id (concat message-id ">")))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
- (memq (mail-header-number header)
- gnus-newsgroup-sparse))))
+ (gnus-summary-article-sparse-p
+ (mail-header-number header)))))
(if header
(prog1
;; The article is present in the buffer, to we just go to it.
(setq point (point)))
;; We didn't find it, so we go to the next article.
(set-buffer sum)
- (if (not (if backward (gnus-summary-find-prev)
- (gnus-summary-find-next)))
- ;; No more articles.
- (setq found t)
- ;; Select the next article and adjust point.
- (gnus-summary-select-article)
- (set-buffer gnus-article-buffer)
- (widen)
- (goto-char (if backward (point-max) (point-min))))))
+ (while (and (not found)
+ (gnus-summary-article-sparse-p
+ (gnus-summary-article-number)))
+ (if (not (if backward (gnus-summary-find-prev)
+ (gnus-summary-find-next)))
+ ;; No more articles.
+ (setq found t)
+ ;; Select the next article and adjust point.
+ (unless (gnus-summary-article-sparse-p
+ (gnus-summary-article-number))
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (goto-char (if backward (point-max) (point-min))))))))
(gnus-message 7 ""))
;; Return whether we found the regexp.
(when (eq found 'found)
;; This is an article number.
(setq header (or header (gnus-summary-article-header id))))
(if (and header
- (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
+ (not (gnus-summary-article-sparse-p (mail-header-number header))))
;; We have found the header.
header
;; We have to really fetch the header to this article.
(insert " Article retrieved.\n"))
(if (not (setq header (car (gnus-get-newsgroup-headers nil t))))
() ; Malformed head.
- (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
+ (unless (gnus-summary-article-sparse-p (mail-header-number header))
(when (and (stringp id)
(not (string= (gnus-group-real-name group)
(car where))))
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info (gnus-active ,group))))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
;; Enter this list into the group info.
(gnus-info-set-read
info (if (> (length read) 1) (nreverse read) read))
(> (prefix-numeric-value arg) 0)))
;; Infest Gnus with topics.
(when gnus-topic-mode
- (when (and menu-bar-mode
- (gnus-visual-p 'topic-menu 'menu))
+ (when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(setq gnus-topic-line-format-spec
(gnus-parse-format gnus-topic-line-format
(set (make-local-variable 'gnus-undo-boundary) t)
(when gnus-undo-mode
;; Set up the menu.
- (when (and menu-bar-mode
- (gnus-visual-p 'undo-menu 'menu))
+ (when (gnus-visual-p 'undo-menu 'menu)
(gnus-undo-make-menu-bar))
;; Don't display anything in the mode line -- too annoying.
;;(unless (assq 'gnus-undo-mode minor-mode-alist)
(when (file-exists-p file)
(delete-file file)))
+
+;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996
+;;; The primary idea here is to try to protect internal datastructures
+;;; from becoming corrupted when the user hits C-g, or if a hook or
+;;; similar blows up. Often in Gnus multiple tables/lists need to be
+;;; updated at the same time, or information can be lost.
+
+(defvar gnus-atomic-be-safe t
+ "If t, certain operations will be protected from interruption by C-g.")
+
+(defmacro gnus-atomic-progn (&rest forms)
+ "Evaluate FORMS atomically, which means to protect the evaluation
+from being interrupted by the user. An error from the forms themselves
+will return without finishing the operation. Since interrupts from
+the user are disabled, it is recommended that only the most minimal
+operations are performed by FORMS. If you wish to assign many
+complicated values atomically, compute the results into temporary
+variables and then do only the assignment atomically."
+ `(let ((inhibit-quit gnus-atomic-be-safe))
+ ,@forms))
+
+(put 'gnus-atomic-progn 'lisp-indent-function 0)
+
+
+(defmacro gnus-atomic-progn-assign (protect &rest forms)
+ "Evaluate FORMS, but insure that the variables listed in PROTECT
+are not changed if anything in FORMS signals an error or otherwise
+non-locally exits. The variables listed in PROTECT are updated atomically.
+It is safe to use gnus-atomic-progn-assign with long computations.
+
+Note that if any of the symbols in PROTECT were unbound, they will be
+set to nil on a sucessful assignment. In case of an error or other
+non-local exit, it will still be unbound."
+ (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
+ (concat (symbol-name x)
+ "-tmp"))
+ x))
+ protect))
+ (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x)))
+ temp-sym-map))
+ (temp-sym-let (mapcar (lambda (x) (list (car x)
+ `(and (boundp ',(cadr x))
+ ,(cadr x))))
+ temp-sym-map))
+ (sym-temp-let sym-temp-map)
+ (temp-sym-assign (apply 'append temp-sym-map))
+ (sym-temp-assign (apply 'append sym-temp-map))
+ (result (make-symbol "result-tmp")))
+ `(let (,@temp-sym-let
+ ,result)
+ (let ,sym-temp-let
+ (setq ,result (progn ,@forms))
+ (setq ,@temp-sym-assign))
+ (let ((inhibit-quit gnus-atomic-be-safe))
+ (setq ,@sym-temp-assign))
+ ,result)))
+
+(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
+;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
+
+
+(defmacro gnus-atomic-setq (&rest pairs)
+ "Similar to setq, except that the real symbols are only assigned when
+there are no errors. And when the real symbols are assigned, they are
+done so atomically. If other variables might be changed via side-effect,
+see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq
+with potentially long computations."
+ (let ((tpairs pairs)
+ syms)
+ (while tpairs
+ (push (car tpairs) syms)
+ (setq tpairs (cddr tpairs)))
+ `(gnus-atomic-progn-assign ,syms
+ (setq ,@pairs))))
+
+;(put 'gnus-atomic-setq 'edebug-form-spec '(body))
+
+
+
(provide 'gnus-util)
;;; gnus-util.el ends here
"Score and kill file handling."
:group 'gnus )
-(defconst gnus-version-number "0.68"
+(defconst gnus-version-number "0.69"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
(while (search-forward "\t" nil t)
(replace-match " " t t)))))
+(defvar gnus-simple-splash nil)
+
(defun gnus-group-startup-message (&optional x y)
"Insert startup message in current buffer."
;; Insert the message.
(put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
(goto-char (point-min))
(setq mode-line-buffer-identification gnus-version)
+ (setq gnus-simple-splash t)
(set-buffer-modified-p t))
(eval-when (load)
(defun gnus-info-set-entry (info entry number)
;; Extend the info until we have enough elements.
- (while (< (length info) number)
+ (while (<= (length info) number)
(nconc info (list nil)))
;; Set the entry.
(setcar (nthcdr number info) entry))
;; Check "Shoot me".
(message-check 'shoot
(if (re-search-forward
- "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me" nil t)
+ "Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t)
(y-or-n-p "You appear to have a misconfigured system. Really post? ")
t))
;; Check for Approved.
(match-string 1 user-mail))
;; Default to this bogus thing.
(t
- (concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
+ (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me")))))
(defun message-make-host-name ()
"Return the name of the host."
"Create a new mail header structure initialized with the parameters given."
(vector number subject from date id references chars lines xref))
+;; fake message-ids: generation and detection
+
+(defvar nnheader-fake-message-id 1)
+
+(defsubst nnheader-generate-fake-message-id ()
+ (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
+
+(defsubst nnheader-fake-message-id-p (id)
+ (save-match-data ; regular message-id's are <.*>
+ (string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
+
;; Parsing headers and NOV lines.
(defsubst nnheader-header-value ()
(buffer-substring (match-end 0) (gnus-point-at-eol)))
-(defvar nnheader-newsgroup-none-id 1)
-
(defun nnheader-parse-head (&optional naked)
(let ((case-fold-search t)
(cur (current-buffer))
(nnheader-header-value)
;; If there was no message-id, we just fake one to make
;; subsequent routines simpler.
- (concat "none+"
- (int-to-string
- (incf nnheader-newsgroup-none-id)))))
+ (nnheader-generate-fake-message-id)))
;; References.
(progn
(goto-char p)
(if (numberp num) num 0)))
(or (eobp) (forward-char 1))))
-(defvar nnheader-none-counter 0)
+;; (defvar nnheader-none-counter 0)
(defun nnheader-parse-nov ()
(let ((eol (gnus-point-at-eol)))
(nnheader-nov-field) ; from
(nnheader-nov-field) ; date
(or (nnheader-nov-field)
- (concat "none+"
- (int-to-string
- (incf nnheader-none-counter)))) ; id
+ (nnheader-generate-fake-message-id)) ; id
(nnheader-nov-field) ; refs
(nnheader-nov-read-integer) ; chars
(nnheader-nov-read-integer) ; lines
;; Save the active file.
(nnmail-save-active nnml-group-alist nnml-active-file))
-(defun nnml-generate-nov-databases-1 (dir)
+(defun nnml-generate-nov-databases-1 (dir &optional seen)
(setq dir (file-name-as-directory dir))
- ;; We descend recursively
- (let ((dirs (directory-files dir t nil t))
- dir)
- (while dirs
- (setq dir (pop dirs))
- (when (and (not (member (file-name-nondirectory dir) '("." "..")))
- (file-directory-p dir))
- (nnml-generate-nov-databases-1 dir))))
- ;; Do this directory.
- (let ((files (sort
- (mapcar
- (lambda (name) (string-to-int name))
- (directory-files dir nil "^[0-9]+$" t))
- '<)))
- (when files
- (funcall nnml-generate-active-function dir)
- ;; Generate the nov file.
- (nnml-generate-nov-file dir files))))
+ ;; Only scan this sub-tree if we haven't been here yet.
+ (unless (member (file-truename dir) seen)
+ (push (file-truename dir) seen)
+ ;; We descend recursively
+ (let ((dirs (directory-files dir t nil t))
+ dir)
+ (while (setq dir (pop dirs))
+ (when (and (not (member (file-name-nondirectory dir) '("." "..")))
+ (file-directory-p dir))
+ (nnml-generate-nov-databases-1 dir seen))))
+ ;; Do this directory.
+ (let ((files (sort
+ (mapcar
+ (lambda (name) (string-to-int name))
+ (directory-files dir nil "^[0-9]+$" t))
+ '<)))
+ (when files
+ (funcall nnml-generate-active-function dir)
+ ;; Generate the nov file.
+ (nnml-generate-nov-file dir files)))))
(defvar files)
(defun nnml-generate-active-info (dir)
(while (setq def (pop defs))
(unless (assq (car def) bvariables)
(nconc bvariables
- (list (cons (car def)
- (condition-case ()
- (symbol-value (car def))
- (error nil))))))
+ (list (cons (car def) (and (boundp (car def))
+ (symbol-value (car def)))))))
(set (car def) (cadr def))))
(while parents
(nnoo-change-server
(deffoo nnvirtual-close-group (group &optional server)
(when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
- ;; Copy (un)read status and marks back to component groups.
- (nnvirtual-update-reads)
- (nnvirtual-update-marked t))
+ (nnvirtual-update-read-and-marked t t))
t)
(deffoo nnvirtual-request-update-info (group info &optional server)
(when (nnvirtual-possibly-change-server server)
- ;; Install the lists.
- (setcar (cddr info) nnvirtual-mapping-reads)
- (if (nthcdr 3 info)
- (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
- (when nnvirtual-mapping-marks
- (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
+ ;; Install the precomputed lists atomically, so the virtual group
+ ;; is not left in a half-way state in case of C-g.
+ (gnus-atomic-progn
+ (setcar (cddr info) nnvirtual-mapping-reads)
+ (if (nthcdr 3 info)
+ (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
+ (when nnvirtual-mapping-marks
+ (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks)))))
t))
(when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
;; copy over existing marks first, in case they set anything
- (nnvirtual-update-marked nil)
+ (nnvirtual-update-read-and-marked nil nil)
;; do a catchup on all component groups
(let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
(gnus-expert-user t))
(nnvirtual-open-server server)))
-(defun nnvirtual-update-reads ()
- "Copy (un)read status from the virtual group to the component groups."
- (let ((unreads (nnvirtual-partition-sequence (gnus-list-of-unread-articles
- (nnvirtual-current-group))))
- entry)
- (while (setq entry (pop unreads))
- (gnus-update-read-articles (car entry) (cdr entry)))))
-
-
-(defun nnvirtual-update-marked (update-p)
+(defun nnvirtual-update-read-and-marked (read-p update-p)
"Copy marks from the virtual group to the component groups.
+If READ-P is not nil, update the (un)read status of the components.
If UPDATE-P is not nil, call gnus-group-update-group on the components."
- (let ((type-marks (mapcar (lambda (ml)
+ (let ((unreads (and read-p
+ (nnvirtual-partition-sequence
+ (gnus-list-of-unread-articles
+ (nnvirtual-current-group)))))
+ (type-marks (mapcar (lambda (ml)
(cons (car ml)
(nnvirtual-partition-sequence (cdr ml))))
(gnus-info-marks (gnus-get-info
(nnvirtual-current-group)))))
- mark type groups carticles info)
-
- ;; clear all existing marks on the component groups, since
- ;; we install new versions below.
- (setq groups nnvirtual-component-groups)
- (while groups
- (when (and (setq info (gnus-get-info (pop groups)))
- (gnus-info-marks info))
- (gnus-info-set-marks info nil)))
-
- ;; Ok, currently type-marks is an assq list with keys of a mark type,
- ;; with data of an assq list with keys of component group names
- ;; and the articles which correspond to that key/group pair.
- (while (setq mark (pop type-marks))
- (setq type (car mark))
- (setq groups (cdr mark))
- (while (setq carticles (pop groups))
- (gnus-add-marked-articles (car carticles) type (cdr carticles)
- nil t)))
+ mark type groups carticles info entry)
+
+ ;; Ok, atomically move all of the (un)read info, clear any old
+ ;; marks, and move all of the current marks. This way if someone
+ ;; hits C-g, you won't leave the component groups in a half-way state.
+ (gnus-atomic-progn
+ ;; move (un)read
+ (while (setq entry (pop unreads))
+ (gnus-update-read-articles (car entry) (cdr entry)))
+
+ ;; clear all existing marks on the component groups
+ (setq groups nnvirtual-component-groups)
+ (while groups
+ (when (and (setq info (gnus-get-info (pop groups)))
+ (gnus-info-marks info))
+ (gnus-info-set-marks info nil)))
+
+ ;; Ok, currently type-marks is an assq list with keys of a mark type,
+ ;; with data of an assq list with keys of component group names
+ ;; and the articles which correspond to that key/group pair.
+ (while (setq mark (pop type-marks))
+ (setq type (car mark))
+ (setq groups (cdr mark))
+ (while (setq carticles (pop groups))
+ (gnus-add-marked-articles (car carticles) type (cdr carticles)
+ nil t))))
;; possibly update the display, it is really slow
(when update-p
(interactive)
(kill-all-local-variables)
(use-local-map gnus-score-mode-map)
- (when menu-bar-mode
- (gnus-score-make-menu-bar))
+ (gnus-score-make-menu-bar)
(set-syntax-table emacs-lisp-mode-syntax-table)
(setq major-mode 'gnus-score-mode)
(setq mode-name "Score")
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Red Gnus 0.68 Manual
+@settitle Red Gnus 0.69 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Red Gnus 0.68 Manual
+@title Red Gnus 0.69 Manual
@author by Lars Magne Ingebrigtsen
@page
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Red Gnus 0.68
+This manual corresponds to Red Gnus 0.69
@end ifinfo
projects / gnus / commitdiff