*** pub/rgnus/lisp/article.el Mon Nov 18 12:16:06 1996 --- rgnus/lisp/article.el Fri Nov 22 00:07:20 1996 *************** *** 29,34 **** --- 29,35 ---- (require 'nnheader) (require 'gnus-util) (require 'message) + (require 'gnus-sum) (defgroup article nil "Article display." *************** *** 232,240 **** (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)) (delete-region b (incf b)))))) (defun article-text-type-exists-p (type) --- 233,240 ---- (defun article-delete-text-of-type (type) "Delete text of TYPE in the current buffer." (save-excursion ! (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) *************** *** 792,801 **** 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") "")) (date (if (vectorp header) (mail-header-date header) header)) ! (date-regexp "^Date: \\|^X-Sent: ") (inhibit-point-motion-hooks t) bface eface) (when (and date (not (string= date ""))) --- 792,803 ---- 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") ! (mail-header-date gnus-current-headers) ! "")) (date (if (vectorp header) (mail-header-date header) header)) ! (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") (inhibit-point-motion-hooks t) bface eface) (when (and date (not (string= date ""))) *** pub/rgnus/lisp/gnus-art.el Wed Nov 20 19:25:24 1996 --- rgnus/lisp/gnus-art.el Sat Nov 23 04:58:16 1996 *************** *** 678,688 **** ["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)) ! (define-key gnus-article-mode-map [menu-bar post] ! (cons "Post" gnus-summary-post-menu)) (run-hooks 'gnus-article-menu-hook))) --- 678,690 ---- ["Remove carriage return" gnus-article-remove-cr t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t])) ! (when (boundp 'gnus-summary-article-menu) ! (define-key gnus-article-mode-map [menu-bar commands] ! (cons "Commands" gnus-summary-article-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))) *************** *** 702,709 **** \\[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)) (gnus-article-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) --- 704,710 ---- \\[gnus-article-describe-briefly]\t Describe the current mode briefly \\[gnus-info-find-node]\t Go to the Gnus info node" (interactive) ! (when (gnus-visual-p 'article-menu 'menu) (gnus-article-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) *** pub/rgnus/lisp/gnus-cache.el Wed Nov 20 15:30:54 1996 --- rgnus/lisp/gnus-cache.el Sat Nov 23 07:09:52 1996 *************** *** 254,259 **** --- 254,260 ---- (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 *************** *** 587,595 **** ;; 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)))) ;;;###autoload (defun gnus-cache-generate-active (&optional directory) --- 588,596 ---- ;; 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))) ;;;###autoload (defun gnus-cache-generate-active (&optional directory) *** pub/rgnus/lisp/gnus-dup.el Tue Oct 8 12:47:03 1996 --- rgnus/lisp/gnus-dup.el Fri Nov 22 00:05:39 1996 *************** *** 110,126 **** (gnus-dup-open)) (setq gnus-dup-list-dirty t) ; mark list for saving (let ((data gnus-newsgroup-data) ! datum) ;; 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-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)))) ;; Chop off excess Message-IDs from the list. (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) (when end --- 110,127 ---- (gnus-dup-open)) (setq gnus-dup-list-dirty t) ; mark list for saving (let ((data gnus-newsgroup-data) ! 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) ! (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 *************** *** 131,143 **** (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) (setq gnus-newsgroup-unreads ! (delq (setq number (mail-header-number header)) ! gnus-newsgroup-unreads)) (push (cons number gnus-duplicate-mark) gnus-newsgroup-reads)))) (gnus-message 6 "Suppressing duplicates...done")) --- 132,145 ---- (unless gnus-dup-list (gnus-dup-open)) (gnus-message 6 "Suppressing duplicates...") ! (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 (gnus-data-number d)) gnus-newsgroup-unreads)) (push (cons number gnus-duplicate-mark) gnus-newsgroup-reads)))) (gnus-message 6 "Suppressing duplicates...done")) *** pub/rgnus/lisp/gnus-eform.el Tue Oct 8 12:47:02 1996 --- rgnus/lisp/gnus-eform.el Fri Nov 22 05:14:21 1996 *************** *** 73,80 **** \\{gnus-edit-form-mode-map}" (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'group-menu 'menu)) (gnus-edit-form-make-menu-bar)) (kill-all-local-variables) (setq major-mode 'gnus-edit-form-mode) --- 73,79 ---- \\{gnus-edit-form-mode-map}" (interactive) ! (when (gnus-visual-p 'group-menu 'menu) (gnus-edit-form-make-menu-bar)) (kill-all-local-variables) (setq major-mode 'gnus-edit-form-mode) *** pub/rgnus/lisp/gnus-group.el Wed Nov 20 23:51:42 1996 --- rgnus/lisp/gnus-group.el Sat Nov 23 04:58:16 1996 *************** *** 922,929 **** \\{gnus-group-mode-map}" (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'group-menu 'menu)) (gnus-group-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) --- 922,928 ---- \\{gnus-group-mode-map}" (interactive) ! (when (gnus-visual-p 'group-menu 'menu) (gnus-group-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) *************** *** 1965,1971 **** (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))))) (unless (gnus-check-backend-function 'request-rename-group group) (error "This backend does not support renaming groups")) --- 1964,1970 ---- (unless (gnus-check-backend-function 'request-rename-group (gnus-group-group-name)) (error "This backend does not support renaming groups")) ! (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")) *** pub/rgnus/lisp/gnus-move.el Sun Nov 10 11:57:31 1996 --- rgnus/lisp/gnus-move.el Sat Nov 23 05:31:02 1996 *************** *** 65,72 **** (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)) ;; Convert HEAD headers. I don't care. (when (eq type 'headers) (nnvirtual-convert-headers)) --- 65,74 ---- (setq to-active (gnus-parse-active) hashtb (make-vector 1023 0)) ;; Fetch the headers from the `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)) *************** *** 74,81 **** (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) (gnus-sethash (buffer-substring (match-beginning 1) (match-end 1)) (read (current-buffer)) --- 76,82 ---- (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (looking-at ! "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") (gnus-sethash (buffer-substring (match-beginning 1) (match-end 1)) (read (current-buffer)) *************** *** 106,113 **** (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) (setq to-article (gnus-gethash (buffer-substring (match-beginning 1) (match-end 1)) --- 107,113 ---- (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (looking-at ! "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") (setq to-article (gnus-gethash (buffer-substring (match-beginning 1) (match-end 1)) *************** *** 144,150 **** (while a (setcdr (car a) (gnus-compress-sequence (sort (cdar a) '<))) (pop a)) ! (gnus-info-set-marks info lists))))) (gnus-message 7 "Translating %s...done" group))) (defun gnus-group-move-group-to-server (info from-server to-server) --- 144,150 ---- (while a (setcdr (car a) (gnus-compress-sequence (sort (cdar a) '<))) (pop a)) ! (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) *** pub/rgnus/lisp/gnus-salt.el Fri Nov 15 23:41:57 1996 --- rgnus/lisp/gnus-salt.el Fri Nov 22 05:14:20 1996 *************** *** 115,122 **** (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)) (gnus-pick-make-menu-bar)) (unless (assq 'gnus-pick-mode minor-mode-alist) (push '(gnus-pick-mode " Pick") minor-mode-alist)) --- 115,121 ---- (gnus-update-summary-mark-positions) (set (make-local-variable 'gnus-summary-goto-unread) 'never) ;; Set up the 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)) *************** *** 311,318 **** (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)) (gnus-binary-make-menu-bar)) (unless (assq 'gnus-binary-mode minor-mode-alist) (push '(gnus-binary-mode " Binary") minor-mode-alist)) --- 310,316 ---- (make-local-variable 'gnus-summary-display-article-function) (setq gnus-summary-display-article-function 'gnus-binary-display-article) ;; Set up the 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)) *************** *** 419,426 **** (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)) (gnus-tree-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) --- 417,423 ---- (setq gnus-tree-line-format-spec (gnus-parse-format gnus-tree-line-format gnus-tree-line-format-alist t)) ! (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) *************** *** 532,540 **** (when (and win (not (eq tot wh))) (let ((selected (selected-window))) ! (select-window win) ! (enlarge-window (- tot wh)) ! (select-window selected))))))) ;;; Generating the tree. --- 529,537 ---- (when (and win (not (eq tot wh))) (let ((selected (selected-window))) ! (when (ignore-errors (select-window win)) ! (enlarge-window (- tot wh)) ! (select-window selected)))))))) ;;; Generating the tree. *** pub/rgnus/lisp/gnus-score.el Tue Nov 19 20:21:57 1996 --- rgnus/lisp/gnus-score.el Sat Nov 23 07:03:05 1996 *************** *** 2361,2378 **** (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)) (regexp (gnus-score-file-regexp)) (case-fold-search nil) ! 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 files to the list of score files. ((string-match regexp file) (push file out)))) --- 2361,2380 ---- (defun gnus-score-score-files-1 (dir) "Return all possible score files under DIR." ! (let ((files (list (expand-file-name dir))) (regexp (gnus-score-file-regexp)) (case-fold-search nil) ! seen out file) (while (setq file (pop files)) (cond ;; Ignore "." and "..". ((member (file-name-nondirectory file) '("." "..")) nil) ! ;; 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)))) *************** *** 2473,2489 **** (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)) (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)))) (defun gnus-score-file-rank (file) "Return a number that says how specific score FILE is. --- 2475,2501 ---- (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* ((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) ! (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. *** pub/rgnus/lisp/gnus-srvr.el Tue Nov 19 18:42:48 1996 --- rgnus/lisp/gnus-srvr.el Fri Nov 22 05:14:20 1996 *************** *** 143,150 **** \\{gnus-server-mode-map}" (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'server-menu 'menu)) (gnus-server-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) --- 143,149 ---- \\{gnus-server-mode-map}" (interactive) ! (when (gnus-visual-p 'server-menu 'menu) (gnus-server-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) *************** *** 610,617 **** 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)) (gnus-browse-make-menu-bar)) (gnus-simplify-mode-line) (setq major-mode 'gnus-browse-mode) --- 609,615 ---- 3) `\\[gnus-browse-exit]' to return to the group buffer." (interactive) (kill-all-local-variables) ! (when (gnus-visual-p 'browse-menu 'menu) (gnus-browse-make-menu-bar)) (gnus-simplify-mode-line) (setq major-mode 'gnus-browse-mode) *** pub/rgnus/lisp/gnus-start.el Wed Nov 20 15:51:12 1996 --- rgnus/lisp/gnus-start.el Sat Nov 23 06:06:02 1996 *************** *** 636,642 **** (gnus-read-init-file) (setq gnus-slave slave) ! (when (string-match "XEmacs" (emacs-version)) (gnus-xmas-splash)) (let ((level (and (numberp arg) (> arg 0) arg)) --- 636,644 ---- (gnus-read-init-file) (setq gnus-slave slave) ! (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)) *************** *** 849,855 **** ;; Find new newsgroups and treat them. (when (and init gnus-check-new-newsgroups (not level) ! (gnus-check-server gnus-select-method)) (gnus-find-new-newsgroups)) ;; We might read in new NoCeM messages here. --- 851,858 ---- ;; Find new newsgroups and treat them. (when (and init gnus-check-new-newsgroups (not level) ! (gnus-check-server gnus-select-method) ! (not gnus-slave)) (gnus-find-new-newsgroups)) ;; We might read in new NoCeM messages here. *** pub/rgnus/lisp/gnus-sum.el Wed Nov 20 23:51:40 1996 --- rgnus/lisp/gnus-sum.el Sat Nov 23 06:06:02 1996 *************** *** 1997,2004 **** \\{gnus-summary-mode-map}" (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'summary-menu 'menu)) (gnus-summary-make-menu-bar)) (kill-all-local-variables) (gnus-summary-make-local-variables) --- 1997,2003 ---- \\{gnus-summary-mode-map}" (interactive) ! (when (gnus-visual-p 'summary-menu 'menu) (gnus-summary-make-menu-bar)) (kill-all-local-variables) (gnus-summary-make-local-variables) *************** *** 2171,2176 **** --- 2170,2183 ---- "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))) *************** *** 3489,3496 **** default-score) gnus-summary-mark-below) ;; Don't touch sparse articles. ! (not (memq number gnus-newsgroup-sparse)) ! (not (memq number gnus-newsgroup-ancient))) (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire --- 3496,3503 ---- default-score) gnus-summary-mark-below) ;; Don't touch sparse articles. ! (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 *************** *** 3611,3617 **** (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-mark-below) ! (not (memq number gnus-newsgroup-ancient))) (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire --- 3618,3624 ---- (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-mark-below) ! (not (gnus-summary-article-ancient-p number))) (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire *************** *** 4057,4067 **** (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))) ;; If the read list is nil, we init it. (and active (null (gnus-info-read info)) --- 4064,4077 ---- (when (or (> id (cdr active)) (< id (car active))) (setq articles (delq id articles)))))) ! (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)) *************** *** 4161,4174 **** ;; 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))))))) ;; References. (progn (goto-char p) --- 4171,4181 ---- ;; Message-ID. (progn (goto-char p) ! (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) *************** *** 4262,4268 **** (defmacro gnus-nov-field () '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) ! (defvar gnus-nov-none-counter 0) ;; This function has to be called with point after the article number ;; on the beginning of the line. --- 4269,4275 ---- (defmacro gnus-nov-field () '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) ! ;; (defvar gnus-nov-none-counter 0) ;; This function has to be called with point after the article number ;; on the beginning of the line. *************** *** 4283,4291 **** (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 (progn (let ((beg (point))) (search-forward "\t" eol) --- 4290,4296 ---- (gnus-nov-field) ; from (gnus-nov-field) ; date (setq id (or (gnus-nov-field) ! (nnheader-generate-fake-message-id))) ; id (progn (let ((beg (point))) (search-forward "\t" eol) *************** *** 5845,5852 **** (while (and thread (or ! (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) ! (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)) (or (<= (length (cdr thread)) 1) (gnus-invisible-cut-children (cdr thread)))) (setq thread (cadr thread)))) --- 5850,5858 ---- (while (and thread (or ! (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)))) *************** *** 5925,5936 **** ;; 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) (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) (zerop children)) ;; If we use expunging, and this article is really ;; low-scored, then we don't want this article. --- 5931,5942 ---- ;; 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) ! (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) ! (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. *************** *** 6057,6064 **** (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)))) (if header (prog1 ;; The article is present in the buffer, to we just go to it. --- 6063,6070 ---- (setq message-id (concat message-id ">"))) (let* ((header (gnus-id-to-header message-id)) (sparse (and header ! (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. *************** *** 6251,6265 **** (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)))))) (gnus-message 7 "")) ;; Return whether we found the regexp. (when (eq found 'found) --- 6257,6276 ---- (setq point (point))) ;; We didn't find it, so we go to the next article. (set-buffer sum) ! (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) *************** *** 8293,8299 **** ;; 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))) ;; We have found the header. header ;; We have to really fetch the header to this article. --- 8304,8310 ---- ;; This is an article number. (setq header (or header (gnus-summary-article-header id)))) (if (and header ! (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. *************** *** 8313,8319 **** (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) (when (and (stringp id) (not (string= (gnus-group-real-name group) (car where)))) --- 8324,8330 ---- (insert " Article retrieved.\n")) (if (not (setq header (car (gnus-get-newsgroup-headers nil t)))) () ; Malformed head. ! (unless (gnus-summary-article-sparse-p (mail-header-number header)) (when (and (stringp id) (not (string= (gnus-group-real-name group) (car where)))) *************** *** 8439,8449 **** (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)))) ;; Enter this list into the group info. (gnus-info-set-read info (if (> (length read) 1) (nreverse read) read)) --- 8450,8463 ---- (setq unread (cdr unread))) (when (<= prev (cdr active)) (push (cons prev (cdr active)) read)) ! (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)) *** pub/rgnus/lisp/gnus-topic.el Sat Nov 16 19:14:20 1996 --- rgnus/lisp/gnus-topic.el Fri Nov 22 05:14:20 1996 *************** *** 891,898 **** (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. (when gnus-topic-mode ! (when (and menu-bar-mode ! (gnus-visual-p 'topic-menu 'menu)) (gnus-topic-make-menu-bar)) (setq gnus-topic-line-format-spec (gnus-parse-format gnus-topic-line-format --- 891,897 ---- (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. (when gnus-topic-mode ! (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 *** pub/rgnus/lisp/gnus-undo.el Sun Nov 10 10:21:07 1996 --- rgnus/lisp/gnus-undo.el Fri Nov 22 05:14:19 1996 *************** *** 90,97 **** (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)) (gnus-undo-make-menu-bar)) ;; Don't display anything in the mode line -- too annoying. ;;(unless (assq 'gnus-undo-mode minor-mode-alist) --- 90,96 ---- (set (make-local-variable 'gnus-undo-boundary) t) (when gnus-undo-mode ;; Set up the 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) *** pub/rgnus/lisp/gnus-util.el Mon Nov 18 19:25:55 1996 --- rgnus/lisp/gnus-util.el Fri Nov 22 05:19:34 1996 *************** *** 597,602 **** --- 597,681 ---- (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 *** pub/rgnus/lisp/gnus.el Thu Nov 21 05:41:45 1996 --- rgnus/lisp/gnus.el Fri Nov 22 00:37:22 1996 *************** *** 42,48 **** "Score and kill file handling." :group 'gnus ) ! (defconst gnus-version-number "0.68" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) --- 42,48 ---- "Score and kill file handling." :group 'gnus ) ! (defconst gnus-version-number "0.69" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) *************** *** 173,178 **** --- 173,180 ---- (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. *************** *** 212,217 **** --- 214,220 ---- (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) *************** *** 1350,1356 **** (defun gnus-info-set-entry (info entry number) ;; Extend the info until we have enough elements. ! (while (< (length info) number) (nconc info (list nil))) ;; Set the entry. (setcar (nthcdr number info) entry)) --- 1353,1359 ---- (defun gnus-info-set-entry (info entry number) ;; Extend the info until we have enough elements. ! (while (<= (length info) number) (nconc info (list nil))) ;; Set the entry. (setcar (nthcdr number info) entry)) *** pub/rgnus/lisp/message.el Wed Nov 20 23:37:29 1996 --- rgnus/lisp/message.el Fri Nov 22 22:32:43 1996 *************** *** 1844,1850 **** ;; Check "Shoot me". (message-check 'shoot (if (re-search-forward ! "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me" nil t) (y-or-n-p "You appear to have a misconfigured system. Really post? ") t)) ;; Check for Approved. --- 1844,1850 ---- ;; Check "Shoot me". (message-check 'shoot (if (re-search-forward ! "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. *************** *** 2316,2322 **** (match-string 1 user-mail)) ;; Default to this bogus thing. (t ! (concat system-name ".i-have-a-misconfigured-system-so-shoot-me"))))) (defun message-make-host-name () "Return the name of the host." --- 2316,2322 ---- (match-string 1 user-mail)) ;; Default to this bogus thing. (t ! (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me"))))) (defun message-make-host-name () "Return the name of the host." *** pub/rgnus/lisp/nnheader.el Wed Nov 20 19:13:57 1996 --- rgnus/lisp/nnheader.el Fri Nov 22 00:05:39 1996 *************** *** 143,155 **** "Create a new mail header structure initialized with the parameters given." (vector number subject from date id references chars lines xref)) ;; 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)) --- 143,164 ---- "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))) (defun nnheader-parse-head (&optional naked) (let ((case-fold-search t) (cur (current-buffer)) *************** *** 204,212 **** (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))))) ;; References. (progn (goto-char p) --- 213,219 ---- (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) *************** *** 253,259 **** (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) ! (defvar nnheader-none-counter 0) (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) --- 260,266 ---- (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) ! ;; (defvar nnheader-none-counter 0) (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) *************** *** 263,271 **** (nnheader-nov-field) ; from (nnheader-nov-field) ; date (or (nnheader-nov-field) ! (concat "none+" ! (int-to-string ! (incf nnheader-none-counter)))) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines --- 270,276 ---- (nnheader-nov-field) ; from (nnheader-nov-field) ; date (or (nnheader-nov-field) ! (nnheader-generate-fake-message-id)) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines *** pub/rgnus/lisp/nnml.el Wed Nov 20 15:30:53 1996 --- rgnus/lisp/nnml.el Sat Nov 23 05:00:44 1996 *************** *** 706,731 **** ;; Save the active file. (nnmail-save-active nnml-group-alist nnml-active-file)) ! (defun nnml-generate-nov-databases-1 (dir) (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)))) (defvar files) (defun nnml-generate-active-info (dir) --- 706,733 ---- ;; Save the active file. (nnmail-save-active nnml-group-alist nnml-active-file)) ! (defun nnml-generate-nov-databases-1 (dir &optional seen) (setq dir (file-name-as-directory dir)) ! ;; 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) *** pub/rgnus/lisp/nnoo.el Thu Nov 21 05:41:45 1996 --- rgnus/lisp/nnoo.el Thu Nov 21 21:55:47 1996 *************** *** 174,183 **** (while (setq def (pop defs)) (unless (assq (car def) bvariables) (nconc bvariables ! (list (cons (car def) ! (condition-case () ! (symbol-value (car def)) ! (error nil)))))) (set (car def) (cadr def)))) (while parents (nnoo-change-server --- 174,181 ---- (while (setq def (pop defs)) (unless (assq (car def) bvariables) (nconc bvariables ! (list (cons (car def) (and (boundp (car def)) ! (symbol-value (car def))))))) (set (car def) (cadr def)))) (while parents (nnoo-change-server *** pub/rgnus/lisp/nnvirtual.el Fri Nov 15 22:12:47 1996 --- rgnus/lisp/nnvirtual.el Fri Nov 22 05:21:44 1996 *************** *** 268,276 **** (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)) t) --- 268,274 ---- (deffoo nnvirtual-close-group (group &optional server) (when (and (nnvirtual-possibly-change-server server) (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) ! (nnvirtual-update-read-and-marked t t)) t) *************** *** 288,299 **** (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)))) t)) --- 286,299 ---- (deffoo nnvirtual-request-update-info (group info &optional server) (when (nnvirtual-possibly-change-server server) ! ;; 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)) *************** *** 301,307 **** (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) ;; do a catchup on all component groups (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) (gnus-expert-user t)) --- 301,307 ---- (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-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)) *************** *** 381,422 **** (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) "Copy marks from the virtual group to the component groups. If UPDATE-P is not nil, call gnus-group-update-group on the components." ! (let ((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))) ;; possibly update the display, it is really slow (when update-p --- 381,425 ---- (nnvirtual-open-server server))) ! (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 ((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 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 *** pub/rgnus/lisp/score-mode.el Sun Jun 30 20:01:53 1996 --- rgnus/lisp/score-mode.el Fri Nov 22 05:14:19 1996 *************** *** 54,61 **** (interactive) (kill-all-local-variables) (use-local-map gnus-score-mode-map) ! (when menu-bar-mode ! (gnus-score-make-menu-bar)) (set-syntax-table emacs-lisp-mode-syntax-table) (setq major-mode 'gnus-score-mode) (setq mode-name "Score") --- 54,60 ---- (interactive) (kill-all-local-variables) (use-local-map gnus-score-mode-map) ! (gnus-score-make-menu-bar) (set-syntax-table emacs-lisp-mode-syntax-table) (setq major-mode 'gnus-score-mode) (setq mode-name "Score") *** pub/rgnus/lisp/ChangeLog Thu Nov 21 05:41:44 1996 --- rgnus/lisp/ChangeLog Sat Nov 23 07:09:53 1996 *************** *** 1,3 **** --- 1,115 ---- + Sat Nov 23 05:00:36 1996 Lars Magne Ingebrigtsen + + * 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 + + * gnus-score.el (gnus-score-score-files-1): Don't infloop. + + Sat Nov 23 04:40:55 1996 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * nnheader.el (nnheader-generate-fake-message-id): Interact better + with duplicate suppression. + + Thu Nov 21 23:31:30 1996 Lars Magne Ingebrigtsen + + * 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 + + * gnus-dup.el (gnus-dup-enter-articles): Ignore sparse articles. + + Thu Nov 21 21:57:52 1996 Lars Magne Ingebrigtsen + + * 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 + + * nnoo.el (nnoo-change-server): Only preserve un-ooed variables if + they exist globally. + + Thu Nov 21 10:52:39 1996 Steven L Baur + + * 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 + + * gnus.el: Red Gnus v0.68 is released. + Thu Nov 21 05:33:24 1996 Lars Magne Ingebrigtsen * nnoo.el (nnoo-change-server): Protect against void vars. *** pub/rgnus/texi/gnus.texi Thu Nov 21 19:48:07 1996 --- rgnus/texi/gnus.texi Sat Nov 23 07:14:51 1996 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Red Gnus 0.68 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Red Gnus 0.69 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 287,293 **** @tex @titlepage ! @title Red Gnus 0.68 Manual @author by Lars Magne Ingebrigtsen @page --- 287,293 ---- @tex @titlepage ! @title Red Gnus 0.69 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 323,329 **** 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 @end ifinfo --- 323,329 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Red Gnus 0.69 @end ifinfo