*** pub/sgnus/lisp/dgnushack.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/dgnushack.el Wed Jan 3 13:33:06 1996 *************** *** 1,5 **** ;;; dgnushack.el --- a hack to set the load path for byte-compiling ! ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Version: 4.19 --- 1,5 ---- ;;; dgnushack.el --- a hack to set the load path for byte-compiling ! ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Version: 4.19 *** pub/sgnus/lisp/gnus-cache.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-cache.el Sat Jan 13 01:10:14 1996 *************** *** 1,5 **** ;;; gnus-cache.el --- cache interface for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; gnus-cache.el --- cache interface for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 41,47 **** (defvar gnus-cache-remove-articles '(read) "*Classes of articles to remove from the cache.") ! (defvar gnus-uncacheable-groups "^nnvirtual" "*Groups that match this regexp will not be cached. If you want to avoid caching your nnml groups, you could set this --- 41,47 ---- (defvar gnus-cache-remove-articles '(read) "*Classes of articles to remove from the cache.") ! (defvar gnus-uncacheable-groups nil "*Groups that match this regexp will not be cached. If you want to avoid caching your nnml groups, you could set this *************** *** 56,62 **** (defvar gnus-cache-active-altered nil) (eval-and-compile ! (autoload 'nnml-generate-nov-databases-1 "nnml")) --- 56,63 ---- (defvar gnus-cache-active-altered nil) (eval-and-compile ! (autoload 'nnml-generate-nov-databases-1 "nnml") ! (autoload 'nnvirtual-find-group-art "nnvirtual")) *************** *** 106,116 **** (defun gnus-cache-possibly-enter-article (group article headers ticked dormant unread &optional force) ! (when (or force (not (eq gnus-use-cache 'passive))) (let ((number (mail-header-number headers)) file dir) ! (when (and (vectorp headers) ; This might be a dummy article. ! (> number 0) ; Reffed article. (or (not gnus-uncacheable-groups) (not (string-match gnus-uncacheable-groups group))) (or force --- 107,124 ---- (defun gnus-cache-possibly-enter-article (group article headers ticked dormant unread &optional force) ! (when (and (or force (not (eq gnus-use-cache 'passive))) ! (vectorp headers)) ; This might be a dummy article. ! ;; If this is a virtual group, we find the real group. ! (when (gnus-virtual-group-p group) ! (let ((result (nnvirtual-find-group-art group article))) ! (setq group (car result) ! article (cdr result) ! headers (copy-sequence headers)) ! (aset headers 0 article))) (let ((number (mail-header-number headers)) file dir) ! (when (and (> number 0) ; Reffed article. (or (not gnus-uncacheable-groups) (not (string-match gnus-uncacheable-groups group))) (or force *************** *** 170,180 **** (defun gnus-cache-enter-remove-article (article) "Mark ARTICLE for later possible removal." ! (setq gnus-cache-removeable-articles ! (cons article gnus-cache-removeable-articles))) (defun gnus-cache-possibly-remove-articles () "Possibly remove some of the removable articles." (unless (eq gnus-use-cache 'passive) (let ((articles gnus-cache-removeable-articles) (cache-articles gnus-newsgroup-cached) --- 178,200 ---- (defun gnus-cache-enter-remove-article (article) "Mark ARTICLE for later possible removal." ! (push article gnus-cache-removeable-articles)) (defun gnus-cache-possibly-remove-articles () "Possibly remove some of the removable articles." + (if (not (gnus-virtual-group-p gnus-newsgroup-name)) + (gnus-cache-possibly-remove-articles-1) + (let ((arts gnus-cache-removeable-articles) + ga) + (while arts + (setq ga (nnvirtual-find-group-art gnus-newsgroup-name (pop arts))) + (let ((gnus-cache-removeable-articles (list (cdr ga))) + (gnus-newsgroup-name (car ga))) + (gnus-cache-possibly-remove-articles-1)))) + (setq gnus-cache-removeable-articles nil))) + + (defun gnus-cache-possibly-remove-articles-1 () + "Possibly remove some of the removable articles." (unless (eq gnus-use-cache 'passive) (let ((articles gnus-cache-removeable-articles) (cache-articles gnus-newsgroup-cached) *************** *** 329,335 **** (let ((group (concat group ""))) (if (string-match ":" group) (aset group (match-beginning 0) ?/)) ! (gnus-replace-chars-in-string group ?. ?/)))) (if (stringp article) article (int-to-string article)))) (defun gnus-cache-possibly-remove-article --- 349,355 ---- (let ((group (concat group ""))) (if (string-match ":" group) (aset group (match-beginning 0) ?/)) ! (nnheader-replace-chars-in-string group ?. ?/)))) (if (stringp article) article (int-to-string article)))) (defun gnus-cache-possibly-remove-article *************** *** 431,446 **** (gnus-cache-enter-articles '(unread)) (gnus-mark-article-hook nil) (gnus-expert-user t) (gnus-large-newsgroup nil)) (while newsrc ! (gnus-summary-read-group (car (car newsrc))) ! (if (not (eq major-mode 'gnus-summary-mode)) ! () (while gnus-newsgroup-unreads ! (gnus-summary-select-article t t nil (car gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-unreads (cdr gnus-newsgroup-unreads))) ! (kill-buffer (current-buffer))) ! (setq newsrc (cdr newsrc))))) (defun gnus-cache-read-active (&optional force) "Read the cache active file." --- 451,466 ---- (gnus-cache-enter-articles '(unread)) (gnus-mark-article-hook nil) (gnus-expert-user t) + (nnmail-spool-file nil) + (gnus-use-dribble-file nil) + (gnus-novice-user nil) (gnus-large-newsgroup nil)) (while newsrc ! (gnus-summary-read-group (car (pop newsrc)) nil t) ! (when (eq major-mode 'gnus-summary-mode) (while gnus-newsgroup-unreads ! (gnus-summary-select-article t t nil (pop gnus-newsgroup-unreads))) ! (kill-buffer (current-buffer)))))) (defun gnus-cache-read-active (&optional force) "Read the cache active file." *************** *** 472,477 **** --- 492,498 ---- (symbol-name sym) (cdr (symbol-value sym)) (car (symbol-value sym)))))) gnus-cache-active-hashtb) + (gnus-make-directory (file-name-directory gnus-cache-active-file)) (write-region (point-min) (point-max) gnus-cache-active-file nil 'silent)) ;; Mark the active hashtb as unaltered. *************** *** 505,511 **** (concat "^" (file-name-as-directory (expand-file-name gnus-cache-directory))) (directory-file-name directory)) ! (gnus-replace-chars-in-string (substring (directory-file-name directory) (match-end 0)) ?/ ?.))) nums alphs) --- 526,532 ---- (concat "^" (file-name-as-directory (expand-file-name gnus-cache-directory))) (directory-file-name directory)) ! (nnheader-replace-chars-in-string (substring (directory-file-name directory) (match-end 0)) ?/ ?.))) nums alphs) *** pub/sgnus/lisp/gnus-cite.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-cite.el Tue Jan 16 15:33:47 1996 *************** *** 1,5 **** ;;; gnus-cite.el --- parse citations in articles for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: news, mail --- 1,5 ---- ;;; gnus-cite.el --- parse citations in articles for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: news, mail *************** *** 207,218 **** skip (gnus-cite-find-prefix number)) (gnus-cite-add-face number skip gnus-cite-attribution-face))))) ! (defun gnus-article-hide-citation (&optional show force) ! "Hide all cited text except attribution lines. ! See the documentation for `gnus-article-highlight-citation'." (interactive (list current-prefix-arg 'force)) ! (if show ! (gnus-article-show-hidden-text 'cite) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) --- 207,280 ---- skip (gnus-cite-find-prefix number)) (gnus-cite-add-face number skip gnus-cite-attribution-face))))) ! (defun gnus-article-fill-cited-article (&optional force) ! "Do word wrapping in the current article." ! (interactive (list t)) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe force) ! (let ((buffer-read-only nil) ! (alist gnus-cite-prefix-alist) ! (inhibit-point-motion-hooks t) ! prefix numbers number marks ! (adaptive-fill-mode nil)) ! ;; Loop through citation prefixes. ! (while alist ! (setq numbers (pop alist) ! prefix (pop numbers)) ! (while numbers ! (setq number (pop numbers)) ! (goto-char (point-min)) ! (forward-line number) ! (push (cons (point-marker) "") marks) ! (while (and numbers ! (= (1- number) (car numbers))) ! (setq number (pop numbers))) ! (goto-char (point-min)) ! (forward-line (1- number)) ! (push (cons (point-marker) prefix) marks))) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (push (cons (point-marker) "") marks) ! (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) ! (push (cons (point-marker) "") marks) ! (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) ! (let* ((omarks marks)) ! (setq marks nil) ! (while (cdr omarks) ! (if (= (caar omarks) (caadr omarks)) ! (progn ! (unless (equal (cdar omarks) "") ! (push (car omarks) marks)) ! (unless (equal (cdadr omarks) "") ! (push (cadr omarks) marks)) ! (setq omarks (cdr omarks))) ! (push (car omarks) marks)) ! (setq omarks (cdr omarks))) ! (push (car omarks) marks) ! (setq marks (nreverse marks))) ! (save-restriction ! (while (cdr marks) ! (widen) ! (narrow-to-region (car (car marks)) (car (cadr marks))) ! (let ((adaptive-fill-regexp (concat "^" (regexp-quote ! (cdr (car marks))) ! " *")) ! (fill-prefix (cdr (car marks))) ! ) ! (fill-region (point-min) (point-max))) ! (set-marker (caar marks) nil) ! (setq marks (cdr marks))) ! (set-marker (caar marks) nil))))) ! ! (defun gnus-article-hide-citation (&optional arg force) ! "Toggle hiding of all cited text except attribution lines. ! See the documentation for `gnus-article-highlight-citation'. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." (interactive (list current-prefix-arg 'force)) ! (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) *************** *** 233,248 **** (nconc (list 'gnus-type 'cite) gnus-hidden-properties))))))))) ! (defun gnus-article-hide-citation-maybe (&optional show force) ! "Hide cited text that has an attribution line. This will do nothing unless at least `gnus-cite-hide-percentage' percent and at least `gnus-cite-hide-absolute' lines of the body is cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." (interactive (list current-prefix-arg 'force)) ! (if show ! (gnus-article-show-hidden-text 'cite) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) --- 295,311 ---- (nconc (list 'gnus-type 'cite) gnus-hidden-properties))))))))) ! (defun gnus-article-hide-citation-maybe (&optional arg force) ! "Toggle hiding of cited text that has an attribution line. ! If given a negative prefix, always show; if given a positive prefix, ! always hide. This will do nothing unless at least `gnus-cite-hide-percentage' percent and at least `gnus-cite-hide-absolute' lines of the body is cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." (interactive (list current-prefix-arg 'force)) ! (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) *** pub/sgnus/lisp/gnus-cus.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-cus.el Tue Jan 9 12:01:06 1996 *************** *** 1,5 **** ;;; gnus-cus.el --- User friendly customization of Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, news --- 1,5 ---- ;;; gnus-cus.el --- User friendly customization of Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, news *************** *** 65,70 **** --- 65,71 ---- (summary-highlight article-highlight summary-menu group-menu article-menu + tree-highlight menu highlight browse-menu server-menu page-marker)) (name . gnus-visual) *************** *** 115,120 **** --- 116,122 ---- (name . gnus-article-display-hook) (type . list) (default . (gnus-article-hide-headers-if-wanted + gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-maybe-highlight)) (data ((type . repeat) *************** *** 332,338 **** ((eq gnus-background-mode 'dark) (list (list "From" nil (custom-face-lookup ! "dark blue" nil nil t t nil)) (list "Subject" nil (custom-face-lookup "pink" nil nil t t nil)) --- 334,340 ---- ((eq gnus-background-mode 'dark) (list (list "From" nil (custom-face-lookup ! "light blue" nil nil t t nil)) (list "Subject" nil (custom-face-lookup "pink" nil nil t t nil)) *** pub/sgnus/lisp/gnus-demon.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-demon.el Sun Jan 7 13:46:00 1996 *************** *** 1,5 **** ;;; gnus-demon.el --- daemonic Gnus behaviour ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; gnus-demon.el --- daemonic Gnus behaviour ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 130,137 **** (string-to-number (aref dv 1)) (string-to-number (aref dv 2)) time (or (aref dv 4) "UT"))) ! (nseconds (- (gnus-seconds-since-epoch tdate) ! (gnus-seconds-since-epoch date)))) (round (/ (if (< nseconds 0) (+ nseconds (* 60 60 24)) --- 130,137 ---- (string-to-number (aref dv 1)) (string-to-number (aref dv 2)) time (or (aref dv 4) "UT"))) ! (nseconds (gnus-time-minus ! (gnus-encode-date tdate) (gnus-encode-date date)))) (round (/ (if (< nseconds 0) (+ nseconds (* 60 60 24)) *** pub/sgnus/lisp/gnus-edit.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-edit.el Wed Jan 3 13:33:04 1996 *************** *** 1,5 **** ;;; gnus-edit.el --- Gnus SCORE file editing ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: news, help --- 1,5 ---- ;;; gnus-edit.el --- Gnus SCORE file editing ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: news, help *** pub/sgnus/lisp/gnus-ems.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-ems.el Fri Jan 12 23:01:52 1996 *************** *** 1,5 **** ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 134,141 **** ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-define)) ! ((and (not (string-match "28.9" emacs-version)) ! (not (string-match "29" emacs-version))) ;; Remove the `intangible' prop. (let ((props (and (boundp 'gnus-hidden-properties) gnus-hidden-properties))) --- 134,141 ---- ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-define)) ! ((or (not (boundp 'emacs-minor-version)) ! (< emacs-minor-version 30)) ;; Remove the `intangible' prop. (let ((props (and (boundp 'gnus-hidden-properties) gnus-hidden-properties))) *************** *** 166,171 **** --- 166,180 ---- (file-exists-p file)))) (or (fboundp 'face-list) (defun face-list (&rest args)))) + + (eval-and-compile + (let ((case-fold-search t)) + (cond + ((string-match "windows-nt\\|os/2" (format "%s" system-type)) + (setq nnheader-file-name-translation-alist + (append nnheader-file-name-translation-alist + '((?: . ?_) + (?+ . ?-)))))))) (defun gnus-ems-redefine () (cond *** pub/sgnus/lisp/gnus-kill.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-kill.el Wed Jan 3 13:33:04 1996 *************** *** 1,5 **** ;;; gnus-kill.el --- kill commands for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; gnus-kill.el --- kill commands for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *** pub/sgnus/lisp/gnus-mh.el Thu Dec 21 04:09:35 1995 --- sgnus/lisp/gnus-mh.el Wed Jan 3 13:33:04 1996 *************** *** 1,5 **** ;;; gnus-mh.el --- mh-e interface for Gnus ! ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; gnus-mh.el --- mh-e interface for Gnus ! ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *** pub/sgnus/lisp/gnus-msg.el Thu Dec 21 04:09:36 1995 --- sgnus/lisp/gnus-msg.el Mon Jan 15 20:56:48 1996 *************** *** 1,5 **** ;;; gnus-msg.el --- mail and post interface for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; gnus-msg.el --- mail and post interface for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *************** *** 30,35 **** --- 30,48 ---- (require 'gnus-ems) (eval-when-compile (require 'cl)) + ;; Added by Sudish Joseph . + (defvar gnus-post-method nil + "*Preferred method for posting USENET news. + If this variable is nil, Gnus will use the current method to decide + which method to use when posting. If it is non-nil, it will override + the current method. This method will not be used in mail groups and + the like, only in \"real\" newsgroups. + + The value must be a valid method as discussed in the documentation of + `gnus-select-method'. It can also be a list of methods. If that is + the case, the user will be queried for what select method to use when + posting.") + (defvar gnus-organization-file "/usr/lib/news/organization" "*Local news organization file.") *************** *** 48,58 **** If you want to insert the signature, you might put `gnus-inews-insert-signature' in this hook.") ! (defvar gnus-use-followup-to t "*Specifies what to do with Followup-To header. ! If nil, ignore the header. If it is t, use its value, but ignore ! `poster'. If it is the symbol `ask', query the user before posting. ! If it is the symbol `use', always use the value.") (defvar gnus-followup-to-function nil "*A variable that contains a function that returns a followup address. --- 61,72 ---- If you want to insert the signature, you might put `gnus-inews-insert-signature' in this hook.") ! (defvar gnus-use-followup-to 'ask "*Specifies what to do with Followup-To header. ! If nil, ignore the header. If it is t, use its value, but ignore ! \"poster\". If it is the symbol `ask', query the user whether to ! ignore the \"poster\" value. If it is the symbol `use', always use ! the value.") (defvar gnus-followup-to-function nil "*A variable that contains a function that returns a followup address. *************** *** 120,125 **** --- 134,147 ---- current newsgroup name and then returns a suitable group name (or list of names).") + (defvar gnus-message-archive-group + '((if (eq major-mode 'news-reply-mode) "misc-news" "misc-mail")) + "*Name of the group in which to save the messages you've written. + This can either be a string, a list of strings; or an alist + of regexps/functions/forms to be evaluated to return a string (or a list + of strings). The functions are called with the name of the current + group (or nil) as a parameter.") + (defvar gnus-mailing-list-groups nil "*Regexp matching groups that are really mailing lists. This is useful when you're reading a mailing list that has been *************** *** 225,231 **** (defvar gnus-check-before-posting '(subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text ! signature approved sender) "In non-nil, Gnus will attempt to run some checks on outgoing posts. If this variable is t, Gnus will check everything it can. If it is a list, then those elements in that list will be checked.") --- 247,253 ---- (defvar gnus-check-before-posting '(subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text ! redirected-followup signature approved sender) "In non-nil, Gnus will attempt to run some checks on outgoing posts. If this variable is t, Gnus will check everything it can. If it is a list, then those elements in that list will be checked.") *************** *** 248,253 **** --- 270,280 ---- "*This is inserted at the start of a mailed copy of a posted message. If this variable is nil, no such courtesy message will be added.") + (defvar gnus-mail-method 'sendmail + "*Method to use for composing mail. + There are three legal values: `sendmail' (which is the default), `mh', + and `vm'.") + (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail) "*Function to compose a reply. Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail); *************** *** 290,301 **** (defvar gnus-post-news-buffer "*post-news*") (defvar gnus-mail-buffer "*mail*") - (defvar gnus-summary-send-map nil) - (defvar gnus-send-bounce-map nil) (defvar gnus-article-copy nil) (defvar gnus-reply-subject nil) (defvar gnus-add-to-address nil) (defvar gnus-in-reply-to nil) (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) --- 317,329 ---- (defvar gnus-post-news-buffer "*post-news*") (defvar gnus-mail-buffer "*mail*") (defvar gnus-article-copy nil) (defvar gnus-reply-subject nil) + (defvar gnus-newsgroup-followup nil) (defvar gnus-add-to-address nil) (defvar gnus-in-reply-to nil) + (defvar gnus-last-posting-server nil) + (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) *************** *** 308,336 **** ;;; Gnus Posting Functions ;;; ! (define-prefix-command 'gnus-summary-send-map) ! (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) ! (define-key gnus-summary-send-map "p" 'gnus-summary-post-news) ! (define-key gnus-summary-send-map "f" 'gnus-summary-followup) ! (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original) ! (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply) ! (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original) ! (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article) ! (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article) ! (define-key gnus-summary-send-map "r" 'gnus-summary-reply) ! (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original) ! (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window) ! (define-key gnus-summary-send-map "u" 'gnus-uu-post-news) ! (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward) ! (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward) ! (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward) ! (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward) ! ! (define-prefix-command 'gnus-send-bounce-map) ! (define-key gnus-summary-send-map "D" 'gnus-send-bounce-map) ! (define-key gnus-send-bounce-map "b" 'gnus-summary-resend-bounced-mail) ! (define-key gnus-send-bounce-map "c" 'gnus-summary-send-draft) ! (define-key gnus-send-bounce-map "r" 'gnus-summary-resend-message) ;;; Internal functions. --- 336,364 ---- ;;; Gnus Posting Functions ;;; ! (gnus-define-keys ! (gnus-summary-send-map "S" gnus-summary-mode-map) ! "p" gnus-summary-post-news ! "f" gnus-summary-followup ! "F" gnus-summary-followup-with-original ! "b" gnus-summary-followup-and-reply ! "B" gnus-summary-followup-and-reply-with-original ! "c" gnus-summary-cancel-article ! "s" gnus-summary-supersede-article ! "r" gnus-summary-reply ! "R" gnus-summary-reply-with-original ! "m" gnus-summary-mail-other-window ! "u" gnus-uu-post-news ! "om" gnus-summary-mail-forward ! "op" gnus-summary-post-forward ! "Om" gnus-uu-digest-mail-forward ! "Op" gnus-uu-digest-post-forward) ! ! (gnus-define-keys ! (gnus-send-bounce-map "D" gnus-summary-send-map) ! "b" gnus-summary-resend-bounced-mail ! "c" gnus-summary-send-draft ! "r" gnus-summary-resend-message) ;;; Internal functions. *************** *** 451,457 **** (gnus-new-news gnus-newsgroup-name t) (erase-buffer) (insert-buffer-substring gnus-original-article-buffer) ! (gnus-narrow-to-headers) ;; Remove unwanted headers. (when gnus-delete-supersedes-headers (nnheader-remove-header gnus-delete-supersedes-headers t)) --- 479,485 ---- (gnus-new-news gnus-newsgroup-name t) (erase-buffer) (insert-buffer-substring gnus-original-article-buffer) ! (nnheader-narrow-to-headers) ;; Remove unwanted headers. (when gnus-delete-supersedes-headers (nnheader-remove-header gnus-delete-supersedes-headers t)) *************** *** 526,531 **** --- 554,624 ---- (setq gnus-add-to-address group))) (gnus-mail-reply yank to-address 'followup))))) + (defun gnus-post-method (group query-method &optional silent) + "Return the posting method based on GROUP and query-method. + If SILENT, don't prompt the user." + (let ((group-method (if (stringp group) + (gnus-find-method-for-group group) + group))) + (cond + ;; If the group-method is nil (which shouldn't happen) we use + ;; the default method. + ((null group-method) + gnus-select-method) + ;; We want this group's method. + ((and query-method (not (eq query-method 0))) + group-method) + ;; We query the user for a post method. + ((or query-method + (and gnus-post-method + (listp (car gnus-post-method)))) + (let* ((methods + ;; Collect all methods we know about. + (append + (when gnus-post-method + (if (listp (car gnus-post-method)) + gnus-post-method + (listp gnus-post-method))) + gnus-secondary-select-methods + (list gnus-select-method) + (list group-method))) + method-alist post-methods method) + ;; Weed out all mail methods. + (while methods + (setq method (gnus-server-get-method "" (pop methods))) + (when (or (gnus-method-option-p method 'post) + (gnus-method-option-p method 'post-mail)) + (push method post-methods))) + ;; Create a name-method alist. + (setq method-alist + (mapcar + (lambda (m) + (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) + post-methods)) + ;; Query the user. + (cadr + (assoc + (setq gnus-last-posting-server + (if (and silent + gnus-last-posting-server) + ;; Just use the last value. + gnus-last-posting-server + (completing-read + "Posting method: " method-alist nil t + (cons (or gnus-last-posting-server "") 0)))) + method-alist)))) + ;; Override normal method. + ((and gnus-post-method + (or (gnus-method-option-p group-method 'post) + (gnus-method-option-p group-method 'post-mail))) + gnus-post-method) + ;; Perhaps this is a mail group? + ((and (not (gnus-member-of-valid 'post group)) + (not (gnus-method-option-p group-method 'post-mail))) + group-method) + ;; Use the normal select method. + (t gnus-select-method)))) + (defun gnus-news-group-p (group &optional article) "Return non-nil if GROUP (and ARTICLE) come from a news server." (or (gnus-member-of-valid 'post group) ; Ordinary news group. *************** *** 534,541 **** (defun gnus-inews-news (&optional use-group-method) "Send a news message. ! If given a prefix, and the group is a foreign group, this function ! will attempt to use the foreign server to post the article." (interactive "P") (or gnus-current-select-method (setq gnus-current-select-method gnus-select-method)) --- 627,638 ---- (defun gnus-inews-news (&optional use-group-method) "Send a news message. ! ! If given a non-zero prefix and the group is a foreign group, this ! function will attempt to use the foreign server to post the article. ! ! If given an zero prefix, the user will be prompted for a posting ! method to use." (interactive "P") (or gnus-current-select-method (setq gnus-current-select-method gnus-select-method)) *************** *** 551,576 **** ;; Send to server. (gnus-message 5 "Posting to USENET...") (setq post-result (funcall gnus-inews-article-function use-group-method)) ! (cond ((eq post-result 'illegal) ! (setq error t) ! (ding)) ! (post-result ! (gnus-message 5 "Posting to USENET...done") ! (if (gnus-buffer-exists-p (car-safe reply)) ! (progn ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-mark-article-as-replied ! (cdr reply))))) ! (set-buffer-modified-p nil)) ! (t ! ;; We cannot signal an error. ! (setq error t) ! (ding) ! (gnus-message ! 1 "Article rejected: %s" ! (gnus-status-message ! (gnus-post-method gnus-newsgroup-name use-group-method)))))) (let ((conf gnus-prev-winconf)) (unless error --- 648,673 ---- ;; Send to server. (gnus-message 5 "Posting to USENET...") (setq post-result (funcall gnus-inews-article-function use-group-method)) ! (cond ! ((eq post-result 'illegal) ! (setq error t) ! (ding)) ! (post-result ! (gnus-message 5 "Posting to USENET...done") ! (set-buffer-modified-p nil) ! ;; We mark the article as replied. ! (when (gnus-buffer-exists-p (car-safe reply)) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-mark-article-as-replied (cdr reply))))) ! (t ! ;; We cannot signal an error. ! (setq error t) ! (ding) ! (gnus-message ! 1 "Article rejected: %s" ! (gnus-status-message ! (gnus-post-method gnus-newsgroup-name use-group-method t)))))) (let ((conf gnus-prev-winconf)) (unless error *************** *** 585,591 **** (or (and (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (match-beginning 0)) ! (point-max)))) (defun gnus-inews-send-mail-copy () ;; Mail the message if To, Bcc or Cc exists. --- 682,689 ---- (or (and (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (match-beginning 0)) ! (point-max))) ! (goto-char (point-min))) (defun gnus-inews-send-mail-copy () ;; Mail the message if To, Bcc or Cc exists. *************** *** 666,672 **** (save-excursion (save-restriction (let ((case-fold-search t)) ! (gnus-narrow-to-headers) (while (re-search-forward "^X-\\(to\\|[bcf]cc\\|cc\\):" nil t) (beginning-of-line) (delete-char 2)) --- 764,770 ---- (save-excursion (save-restriction (let ((case-fold-search t)) ! (nnheader-narrow-to-headers) (while (re-search-forward "^X-\\(to\\|[bcf]cc\\|cc\\):" nil t) (beginning-of-line) (delete-char 2)) *************** *** 741,746 **** --- 839,862 ---- (gnus-y-or-n-p "The article contains an Approved header. Really post? ") t))) + ;; Check whether a Followup-To has redirected the newsgroup. + (or + (gnus-check-before-posting 'redirected-followup) + (not gnus-newsgroup-followup) + (save-excursion + (let ((followups (gnus-tokenize-header + (mail-fetch-field "Newsgroups"))) + (newsgroups (gnus-tokenize-header + (car gnus-newsgroup-followup))) + shared) + (while (and followups + (not (member followups newsgroups))) + (setq followups (cdr followups))) + (if followups + t + (gnus-y-or-n-p + "Followup redirected from original newsgroups. Really post? " + ))))) ;; Check the Message-ID header. (or (gnus-check-before-posting 'message-id) (save-excursion *************** *** 754,785 **** "The Message-ID looks strange: \"%s\". Really post? " message-id)))))) ;; Check the From header. ! (or (gnus-check-before-posting 'from) ! (save-excursion ! (let* ((case-fold-search t) ! (from (mail-fetch-field "from"))) ! (cond ! ((not from) ! (gnus-y-or-n-p "There is no From line. Really post? ")) ! ((not (string-match "@[^\\.]*\\." from)) ! (gnus-y-or-n-p ! (format ! "The address looks strange: \"%s\". Really post? " from))) ! ((string-match "(.*).*(.*)" from) (gnus-y-or-n-p (format ! "The From header looks strange: \"%s\". Really post? " ! from))) ! ((string-match "<[^>]+> *$" from) ! (let ((name (substring from 0 (match-beginning 0)))) ! (or ! (string-match "^ *\"[^\"]*\" *$" name) ! (not (string-match "[][.!()<>@,;:\\]" name)) ! (gnus-y-or-n-p ! (format ! "The From header name has bogus characters. Really post? " ! from))))) ! (t t))))) ))) ;; Check for long lines. (or (gnus-check-before-posting 'long-lines) --- 870,902 ---- "The Message-ID looks strange: \"%s\". Really post? " message-id)))))) ;; Check the From header. ! (or ! (gnus-check-before-posting 'from) ! (save-excursion ! (let* ((case-fold-search t) ! (from (mail-fetch-field "from"))) ! (cond ! ((not from) ! (gnus-y-or-n-p "There is no From line. Really post? ")) ! ((not (string-match "@[^\\.]*\\." from)) ! (gnus-y-or-n-p ! (format ! "The address looks strange: \"%s\". Really post? " from))) ! ((string-match "(.*).*(.*)" from) ! (gnus-y-or-n-p ! (format ! "The From header looks strange: \"%s\". Really post? " ! from))) ! ((string-match "<[^>]+> *$" from) ! (let ((name (substring from 0 (match-beginning 0)))) ! (or ! (string-match "^ *\"[^\"]*\" *$" name) ! (not (string-match "[][.!()<>@,;:\\]" name)) (gnus-y-or-n-p (format ! "The From header name has bogus characters. Really post? " ! from))))) ! (t t))))) ))) ;; Check for long lines. (or (gnus-check-before-posting 'long-lines) *************** *** 833,838 **** --- 950,970 ---- (count-lines (point) (point-max)))) t))))))) + (defun gnus-tokenize-header (header &optional separator) + "Split HEADER into a list of header elements. + \",\" is used as the separator." + (let* ((beg 0) + (separator (or separator ",")) + (regexp + (format "[ \t]*\\([^%s]+\\)?\\(%s\\|\\'\\)" separator separator)) + elems) + (while (and (string-match regexp header beg) + (< beg (length header))) + (when (match-beginning 1) + (push (match-string 1 header) elems)) + (setq beg (match-end 0))) + (nreverse elems))) + (defun gnus-article-checksum () (let ((sum 0)) (save-excursion *************** *** 986,993 **** ;; Copy the article over to some group, possibly. (and gcc (gnus-inews-do-gcc gcc)) ;; Post the article. ! (let ((method (gnus-post-method gnus-newsgroup-name use-group-method))) ! (setq result (gnus-request-post method))) (kill-buffer (current-buffer))) (run-hooks 'gnus-message-sent-hook) ;; If the posting was unsuccessful (that it, it was rejected) we --- 1118,1125 ---- ;; Copy the article over to some group, possibly. (and gcc (gnus-inews-do-gcc gcc)) ;; Post the article. ! (setq result (gnus-request-post ! (gnus-post-method gnus-newsgroup-name use-group-method))) (kill-buffer (current-buffer))) (run-hooks 'gnus-message-sent-hook) ;; If the posting was unsuccessful (that it, it was rejected) we *************** *** 1297,1303 **** list file) (save-excursion (save-restriction ! (gnus-narrow-to-headers) (while (setq file (mail-fetch-field "fcc")) (push file list) (nnheader-remove-header "fcc" nil t)) --- 1429,1435 ---- list file) (save-excursion (save-restriction ! (nnheader-narrow-to-headers) (while (setq file (mail-fetch-field "fcc")) (push file list) (nnheader-remove-header "fcc" nil t)) *************** *** 1463,1470 **** (defun gnus-inews-date () "Current time string." ! (timezone-make-date-arpa-standard ! (current-time-string) (current-time-zone))) (defun gnus-inews-organization () "Return user's organization. --- 1595,1603 ---- (defun gnus-inews-date () "Current time string." ! (let ((now (current-time))) ! (timezone-make-date-arpa-standard ! (current-time-string now) (current-time-zone now)))) (defun gnus-inews-organization () "Return user's organization. *************** *** 1634,1639 **** --- 1767,1773 ---- (erase-buffer) (gnus-mail-setup 'new to subject) (gnus-inews-insert-gcc) + (gnus-inews-insert-archive-gcc) (run-hooks 'gnus-mail-hook))) (defun gnus-mail-reply (&optional yank to-address followup) *************** *** 1657,1663 **** (gnus-copy-article-buffer) (save-restriction (set-buffer gnus-article-copy) ! (gnus-narrow-to-headers) (if (not followup) ;; This is a regular reply. (if (gnus-functionp gnus-reply-to-function) --- 1791,1797 ---- (gnus-copy-article-buffer) (save-restriction (set-buffer gnus-article-copy) ! (nnheader-narrow-to-headers) (if (not followup) ;; This is a regular reply. (if (gnus-functionp gnus-reply-to-function) *************** *** 1681,1687 **** (setq to (mail-fetch-field "to")) (setq cc (mail-fetch-field "cc")) (setq mct (mail-fetch-field "mail-copies-to")) ! (setq reply-to (mail-fetch-field "reply-to")) (setq references (mail-fetch-field "references")) (setq message-id (mail-fetch-field "message-id")) --- 1815,1823 ---- (setq to (mail-fetch-field "to")) (setq cc (mail-fetch-field "cc")) (setq mct (mail-fetch-field "mail-copies-to")) ! (setq reply-to ! (unless (gnus-group-get-parameter group 'broken-reply-to) ! (mail-fetch-field "reply-to"))) (setq references (mail-fetch-field "references")) (setq message-id (mail-fetch-field "message-id")) *************** *** 1746,1751 **** --- 1882,1888 ---- (auto-save-mode auto-save-default) (gnus-inews-insert-gcc) + (gnus-inews-insert-archive-gcc) (if (and follow-to (listp follow-to)) (progn *************** *** 1833,1847 **** (gnus-inews-insert-bfcc) (gnus-inews-insert-gcc) (gnus-inews-insert-signature) (and gnus-post-prepare-function (gnus-functionp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) - (goto-char (point-min)) - (if group - (re-search-forward "^Subject: " nil t) - (re-search-forward "^Newsgroups: " nil t)) (run-hooks 'gnus-post-prepare-hook) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (gnus-inews-modify-mail-mode-map) --- 1970,1982 ---- (gnus-inews-insert-bfcc) (gnus-inews-insert-gcc) + (gnus-inews-insert-archive-gcc) (gnus-inews-insert-signature) (and gnus-post-prepare-function (gnus-functionp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) (run-hooks 'gnus-post-prepare-hook) + (gnus-inews-set-point) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (gnus-inews-modify-mail-mode-map) *************** *** 1875,1881 **** (gnus-copy-article-buffer) (save-restriction (set-buffer gnus-article-copy) ! (gnus-narrow-to-headers) (if (gnus-functionp gnus-followup-to-function) (save-excursion (setq follow-to --- 2010,2016 ---- (gnus-copy-article-buffer) (save-restriction (set-buffer gnus-article-copy) ! (nnheader-narrow-to-headers) (if (gnus-functionp gnus-followup-to-function) (save-excursion (setq follow-to *************** *** 1935,1940 **** --- 2070,2079 ---- (setq gnus-reply-subject (mail-header-subject gnus-current-headers)) (make-local-variable 'gnus-in-reply-to) (setq gnus-in-reply-to message-of) + (when (and followup-to newsgroups) + (make-local-variable 'gnus-newsgroup-followup) + (setq gnus-newsgroup-followup + (cons newsgroups followup-to))) (gnus-inews-insert-signature) *************** *** 1973,1979 **** gnus-auto-mail-to-author) (or (save-excursion (set-buffer gnus-article-copy) ! (gnus-fetch-field "reply-to")) from))) (x-mail (save-excursion (set-buffer gnus-article-copy) --- 2112,2120 ---- gnus-auto-mail-to-author) (or (save-excursion (set-buffer gnus-article-copy) ! (unless (gnus-group-get-parameter ! group 'broken-reply-to) ! (gnus-fetch-field "reply-to"))) from))) (x-mail (save-excursion (set-buffer gnus-article-copy) *************** *** 1996,2002 **** (gnus-inews-insert-bfcc) (gnus-inews-insert-gcc) ! ;; Now the headers should be ok, so we do the yanking. (goto-char (point-min)) (re-search-forward --- 2137,2144 ---- (gnus-inews-insert-bfcc) (gnus-inews-insert-gcc) ! (gnus-inews-insert-archive-gcc) ! ;; Now the headers should be ok, so we do the yanking. (goto-char (point-min)) (re-search-forward *************** *** 2033,2052 **** (make-local-variable 'gnus-article-check-size) (setq gnus-article-check-size ! (cons (buffer-size) (gnus-article-checksum)))))))) (defun gnus-message-of (from date) ! "Take a FROM and a DATE and create an IN-REPLY-TO." ! (cond ! ((not from) ! nil) ! (t (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " (if (or (not date) (string= date "")) ! "(unknown date)" date)))))) (defun gnus-mail-yank-original () (interactive) --- 2175,2192 ---- (make-local-variable 'gnus-article-check-size) (setq gnus-article-check-size ! (cons (buffer-size) (gnus-article-checksum))) ! (gnus-inews-set-point)))))) (defun gnus-message-of (from date) ! "Take a FROM and a DATE and return an IN-REPLY-TO." ! (when from (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " (if (or (not date) (string= date "")) ! "(unknown date)" date))))) (defun gnus-mail-yank-original () (interactive) *************** *** 2067,2077 **** (let ((buffer-file-name nil)) (or dont-send (gnus-mail-send))) (bury-buffer) ! ;; This mail group doesn't have a `to-address', so we add one ;; here. Magic! (and to-address (gnus-group-add-parameter ! address-group (cons 'to-address to-address))) (if (get-buffer gnus-group-buffer) (progn (if (gnus-buffer-exists-p (car-safe reply)) --- 2207,2217 ---- (let ((buffer-file-name nil)) (or dont-send (gnus-mail-send))) (bury-buffer) ! ;; This mail group doesn't have a `to-list', so we add one ;; here. Magic! (and to-address (gnus-group-add-parameter ! address-group (cons 'to-list to-address))) (if (get-buffer gnus-group-buffer) (progn (if (gnus-buffer-exists-p (car-safe reply)) *************** *** 2234,2240 **** (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version))) (gnus-debug) (goto-char (point-min)) (search-forward "Subject: " nil t) --- 2374,2382 ---- (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (insert (gnus-version) "\n") ! (emacs-version t) ! (insert "\n\n\n\n\n") (gnus-debug) (goto-char (point-min)) (search-forward "Subject: " nil t) *************** *** 2337,2343 **** (let (references) (save-excursion (save-restriction ! (gnus-narrow-to-headers) (nnheader-remove-header gnus-bounced-headers-junk t) (setq references (mail-fetch-field "references")) (goto-char (point-max)) --- 2479,2485 ---- (let (references) (save-excursion (save-restriction ! (nnheader-narrow-to-headers) (nnheader-remove-header gnus-bounced-headers-junk t) (setq references (mail-fetch-field "references")) (goto-char (point-max)) *************** *** 2374,2380 **** ;; Run final inews hooks. This hook may do FCC. (run-hooks 'gnus-inews-article-hook) (gnus-inews-do-gcc) ! (gnus-narrow-to-headers) (nnheader-remove-header "^[gf]cc:" t) (widen) (goto-char (point-min)) --- 2516,2522 ---- ;; Run final inews hooks. This hook may do FCC. (run-hooks 'gnus-inews-article-hook) (gnus-inews-do-gcc) ! (nnheader-narrow-to-headers) (nnheader-remove-header "^[gf]cc:" t) (widen) (goto-char (point-min)) *************** *** 2388,2394 **** (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) (local-set-key "\C-c\C-p" 'gnus-put-message) ! (local-set-key "\C-c\C-d" 'gnus-put-draft-group)) (defun gnus-mail-setup (type &optional to subject in-reply-to cc replybuffer actions) --- 2530,2536 ---- (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) (local-set-key "\C-c\C-p" 'gnus-put-message) ! (local-set-key "\C-c\C-d" 'gnus-put-in-draft-group)) (defun gnus-mail-setup (type &optional to subject in-reply-to cc replybuffer actions) *************** *** 2397,2402 **** --- 2539,2545 ---- (funcall (cond ((or + (eq gnus-mail-method 'mh) (and (or (eq type 'reply) (eq type 'followup)) (eq gnus-mail-reply-method 'gnus-mail-reply-using-mhe)) (and (eq type 'forward) *************** *** 2406,2411 **** --- 2549,2555 ---- 'gnus-mail-other-window-using-mhe))) 'gnus-mh-mail-setup) ((or + (eq gnus-mail-method 'vm) (and (or (eq type 'reply) (eq type 'followup)) (eq gnus-mail-reply-method 'gnus-mail-reply-using-vm)) (and (eq type 'forward) *************** *** 2422,2432 **** (defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions) (mail-mode) (mail-setup to subject nil cc replybuffer actions) ! (goto-char (point-min)) ! (if (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$") nil t) ! (forward-line 1) ! (goto-char (point-max))) (gnus-inews-modify-mail-mode-map)) ;;; Gcc handling. --- 2566,2572 ---- (defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions) (mail-mode) (mail-setup to subject nil cc replybuffer actions) ! (gnus-inews-set-point) (gnus-inews-modify-mail-mode-map)) ;;; Gcc handling. *************** *** 2435,2455 **** (defun gnus-inews-do-gcc (&optional gcc) (save-excursion (save-restriction ! (gnus-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) ! end) ! (if (not gcc) ! () ; Nothing to be done. (nnheader-remove-header "gcc") ;; Copy the article over to some group(s). ! (while (string-match ! "^[ \t]*\\([^ \t]+\\)\\([ \t]+\\|$\\)" gcc) ! (setq end (match-end 0)) ! (condition-case () ! (gnus-request-accept-article ! (substring gcc (match-beginning 1) (match-end 1)) t) ! (error nil)) ! (setq gcc (substring gcc end)))))))) (defun gnus-inews-insert-bfcc () "Insert Bcc and Fcc headers." --- 2575,2612 ---- (defun gnus-inews-do-gcc (&optional gcc) (save-excursion (save-restriction ! (nnheader-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) ! (cur (current-buffer)) ! end groups group method) ! (when gcc (nnheader-remove-header "gcc") + (widen) + (setq groups (gnus-tokenize-header gcc " ")) ;; Copy the article over to some group(s). ! (while (setq group (pop groups)) ! (gnus-check-server ! (setq method ! (cond ((and (null (gnus-get-info group)) ! (eq (car gnus-message-archive-method) ! (car (gnus-group-method-name group)))) ! ;; If the group doesn't exist, we assume ! ;; it's an archive group... ! gnus-message-archive-method) ! (t (gnus-find-method-for-group group))))) ! (unless (gnus-request-group group t method) ! (gnus-request-create-group group method)) ! (gnus-check-server method) ! (save-excursion ! (nnheader-set-temp-buffer " *acc*") ! (insert-buffer-substring cur) ! (unless (condition-case () ! (gnus-request-accept-article group t method) ! (error nil)) ! (gnus-message 1 "Couldn't store article in group %s: %s" ! group (gnus-status-message method)) ! (sit-for 2)) ! (kill-buffer (current-buffer))))))))) (defun gnus-inews-insert-bfcc () "Insert Bcc and Fcc headers." *************** *** 2467,2472 **** --- 2624,2630 ---- (insert gnus-author-copy)))) (defun gnus-inews-insert-gcc () + "Insert Gcc headers based on `gnus-outgoing-message-group'." (save-excursion (save-restriction (gnus-inews-narrow-to-headers) *************** *** 2482,2487 **** --- 2640,2689 ---- (mapconcat 'identity group " ")) "\n")))))) + (defun gnus-inews-insert-archive-gcc () + "Insert the Gcc to say where the article is to be archived." + (let* ((var gnus-message-archive-group) + result + (groups + (cond + ((stringp var) + ;; Just a single group. + (list var)) + ((and (listp var) (stringp (car var))) + ;; A list of groups. + var) + (t + ;; An alist of regexps/functions/forms. + (while (and var + (not + (setq result + (cond + ((stringp (caar var)) + ;; Regexp. + (when (string-match (caar var) + gnus-newsgroup-name) + (cdar var))) + ((gnus-functionp (car var)) + ;; Function. + (funcall (car var) gnus-newsgroup-name)) + (t + (eval (car var))))))) + (setq var (cdr var))) + result)))) + (when groups + (when (stringp groups) + (setq groups (list groups))) + (save-excursion + (save-restriction + (gnus-inews-narrow-to-headers) + (goto-char (point-max)) + (insert "Gcc: ") + (while groups + (insert (gnus-group-prefixed-name + (pop groups) gnus-message-archive-method)) + (insert " ")) + (insert "\n")))))) + ;;; Handling rejected (and postponed) news. (defun gnus-draft-group () *************** *** 2612,2617 **** --- 2814,2834 ---- (push (cons (car attribute) value-value) gnus-required-mail-headers))))))))) + (defun gnus-inews-set-point () + "Move point to where the user probably wants to find it." + (gnus-inews-narrow-to-headers) + (cond + ((re-search-forward "^[^:]+:[ \t]*$" nil t) + (search-backward ":" ) + (widen) + (forward-char 2)) + (t + (goto-char (point-max)) + (widen) + (forward-line 1) + (unless (looking-at "$") + (forward-line 2))))) + ;;; Allow redefinition of functions. (gnus-ems-redefine) *** pub/sgnus/lisp/gnus-nocem.el Thu Dec 21 04:09:36 1995 --- sgnus/lisp/gnus-nocem.el Wed Jan 3 13:33:04 1996 *************** *** 1,5 **** ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *** pub/sgnus/lisp/gnus-picon.el Thu Dec 21 04:09:36 1995 --- sgnus/lisp/gnus-picon.el Wed Jan 10 21:50:10 1996 *************** *** 1,39 **** ! ;; gnus-picon.el: Copyright (C) 1995 Wes Hardaker ! ;; Icon hacks for displaying pretty icons in Gnus. ! ;; ! ;; Author: Wes hardaker ! ;; hardaker@ece.ucdavis.edu ! ;; ;; Usage: ! ;; - You must have XEmacs to use this. ! ;; - (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) ! ;; This HAS to have the 't' flag above to make sure it appends the hook. ;; - Read the variable descriptions below. ;; ;; Warnings: ;; - I'm not even close to being a lisp expert. ;; ;; TODO: ! ;; - Following the Gnus motto: We've got to build him bigger, ! ;; better, stronger, faster than before... errr.... sorry. ! ;; - Create a seperate frame to store icons in so icons are ! ;; visibile immediately upon entering a group rather than just ! ;; at the top of the article buffer. ;; ! ;; (require 'xpm) (require 'annotations) (defvar gnus-picons-database "/usr/local/faces" ! "defines the location of the faces database. For information on ! obtaining this database of pretty pictures, please see ! http://www.cs.indiana.edu/picons/ftp/index.html" ! ) (defvar gnus-picons-news-directory "news" ! "Sub-directory of the faces database containing the icons for ! newsgroups." ) (defvar gnus-picons-user-directories '("local" "users" "usenix" "misc/MISC") --- 1,78 ---- ! ;;; gnus-picons.el: Icon hacks for displaying pretty icons in Gnus. ! ;; Copyright (C) 1996 Wes Hardaker ! ! ;; Author: Wes hardaker ! ;; Keywords: gnus xpm annotation glyph faces ! ! ;;; Commentary: ! ;; Usage: ! ;; - You must have XEmacs (19.12 or above I think) to use this. ;; - Read the variable descriptions below. ;; + ;; - chose a setup: + ;; + ;; 1) display the icons in its own buffer: + ;; + ;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) + ;; (add-hook 'gnus-summary-display-hook 'gnus-group-display-picons t) + ;; (setq gnus-picons-display-where 'picons) + ;; + ;; Then add the picons buffer to your display configuration: + ;; The picons buffer needs to be at least 48 pixels high, + ;; which for me is 5 lines: + ;; + ;; (gnus-add-configuration + ;; '(article (vertical 1.0 + ;; (group 6) + ;; (picons 5) + ;; (summary .25 point) + ;; (article 1.0)))) + ;; + ;; (gnus-add-configuration + ;; '(summary (vertical 1.0 (group 6) + ;; (picons 5) + ;; (summary 1.0 point)))) + ;; + ;; 2) display the icons in the summary buffer + ;; + ;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) + ;; (add-hook 'gnus-summary-display-hook 'gnus-group-display-picons t) + ;; (setq gnus-picons-display-where 'summary) + ;; + ;; 3) display the icons in the article buffer + ;; + ;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) + ;; (add-hook 'gnus-article-display-hook 'gnus-group-display-picons t) + ;; (setq gnus-picons-display-where 'article) + ;; + ;; ;; Warnings: ;; - I'm not even close to being a lisp expert. + ;; - The 't' (append) flag MUST be in the add-hook line ;; ;; TODO: ! ;; - Remove the TODO section in the headers. ;; ! ! ;;; Code: (require 'xpm) (require 'annotations) + (defvar gnus-picons-buffer "*Icon Buffer*" + "Buffer name to display the icons in if gnus-picons-display-where is 'picons.") + + (defvar gnus-picons-display-where 'picons + "Where to display the group and article icons.") + (defvar gnus-picons-database "/usr/local/faces" ! "Defines the location of the faces database. ! For information on obtaining this database of pretty pictures, please ! see http://www.cs.indiana.edu/picons/ftp/index.html" ) (defvar gnus-picons-news-directory "news" ! "Sub-directory of the faces database containing the icons for newsgroups." ) (defvar gnus-picons-user-directories '("local" "users" "usenix" "misc/MISC") *************** *** 41,121 **** ) (defvar gnus-picons-domain-directories '("domains") ! "List of directories to search for domain faces. Some people may ! want to add \"unknown\" to this list." ) (defun gnus-article-display-picons () ! "prepare article buffer with pretty pictures" (interactive) ! (if (featurep 'xpm) (save-excursion ! (beginning-of-buffer) ! (open-line 1) ! (let* ((iconpoint (point)) (from (mail-fetch-field "from")) ! (username ! (progn ! (string-match "\\([-_a-zA-Z0-9]+\\)@" from) ! (match-string 1 from))) ! (hostpath ! (gnus-picons-reverse-domain-path ! (replace-in-string ! (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*" "\\1") ! "\\." "/")))) ! (if (equal username from) ! (setq username (replace-in-string from ! ".*<\\([_a-zA-Z0-9-.]+\\)>.*" ! "\\1"))) ! (insert username) ! (gnus-picons-insert-face-if-exists ! (concat gnus-picons-database "/" gnus-picons-news-directory) ! (concat (replace-in-string gnus-newsgroup-name "\\." "/") "/unknown") ! iconpoint) ! (mapcar '(lambda (pathpart) ! (gnus-picons-insert-face-if-exists ! (concat gnus-picons-database "/" pathpart) ! (concat hostpath "/" username) ! iconpoint)) ! gnus-picons-user-directories) ! (mapcar '(lambda (pathpart) ! (gnus-picons-insert-face-if-exists ! (concat gnus-picons-database "/" pathpart) ! (concat hostpath "/" "unknown") ! iconpoint)) ! gnus-picons-domain-directories) ! )))) ! ! (defun gnus-picons-insert-face-if-exists (path filename ipoint) ! "inserts a face at point if I can find one" ! (let ((pathfile (concat path "/" filename "/face"))) ! (let ((newfilename ! (replace-in-string filename ! "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1"))) ! (if (not (equal filename newfilename)) ! (gnus-picons-insert-face-if-exists path newfilename ipoint))) ! (if (not (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint)) ! (gnus-picons-try-to-find-face (concat pathfile ".xbm") ipoint)) ) ) (defun gnus-picons-try-to-find-face (path ipoint) ! "if path exists, display it as a bitmap. Returns t if succedded." ! (if (file-exists-p path) ! (progn ! (setq gl (make-glyph path)) ! (set-glyph-face gl 'default) ! (setq annot (make-annotation gl ipoint 'text)) ! t) ! ; (insert (format "no: %s\n" path)) ! nil)) (defun gnus-picons-reverse-domain-path (str) "a/b/c/d -> d/c/b/a" (if (equal (replace-in-string str "^[^/]*$" "") "") str (concat (replace-in-string str "^.*/\\([_a-zA-Z0-9-]+\\)$" "\\1") "/" ! (gnus-picons-reverse-domain-path ! (replace-in-string str "^\\(.*\\)/[_a-zA-Z0-9-]+$" "\\1"))))) ! ! --- 80,258 ---- ) (defvar gnus-picons-domain-directories '("domains") ! "List of directories to search for domain faces. ! Some people may want to add \"unknown\" to this list." ! ) ! ! (setq gnus-group-annotations nil) ! (setq gnus-article-annotations nil) ! ! (defun gnus-picons-remove (plist) ! (let ((listitem (car plist))) ! (while (setq listitem (car plist)) ! (if (annotationp listitem) ! (delete-annotation listitem)) ! (setq plist (cdr plist)))) ) + (defun gnus-picons-remove-all () + "Removes all picons from the Gnus display(s)." + (interactive) + (gnus-picons-remove gnus-article-annotations) + (gnus-picons-remove gnus-group-annotations) + (setq gnus-article-annotations nil + gnus-group-annotations nil) + (if (bufferp gnus-picons-buffer) + (kill-buffer gnus-picons-buffer)) + ) + + (defun gnus-get-buffer-name (variable) + "Returns the buffer name associated with the contents of a variable." + (cond ((symbolp variable) + (let ((newvar (cdr (assq variable gnus-window-to-buffer)))) + (cond ((symbolp newvar) + (symbol-value newvar)) + ((stringp newvar) newvar)))) + ((stringp variable) + variable))) + (defun gnus-article-display-picons () ! "Display faces for an author and his/her domain in gnus-picons-display-where." (interactive) ! (if (and (featurep 'xpm) ! (or (not (fboundp 'device-type)) (equal (device-type) 'x))) (save-excursion ! (let* ((iconpoint (point)) (from (mail-fetch-field "from")) ! (username ! (progn ! (string-match "\\([-_a-zA-Z0-9]+\\)@" from) ! (match-string 1 from))) ! (hostpath ! (concat (gnus-picons-reverse-domain-path ! (replace-in-string ! (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*" ! "\\1") ! "\\." "/")) "/"))) ! (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where)) ! (beginning-of-buffer) ! (setq iconpoint (point)) ! (if (not (looking-at "^$")) ! (if buffer-read-only ! (progn ! (toggle-read-only) ! (open-line 1) ! (toggle-read-only) ! ) ! (open-line 1))) ! ! (end-of-line) ! (gnus-picons-remove gnus-article-annotations) ! (setq gnus-article-annotations 'nil) ! (if (equal username from) ! (setq username (progn ! (string-match "<\\([_a-zA-Z0-9-.]+\\)>" from) ! (match-string 1 from)))) ! (mapcar '(lambda (pathpart) ! (setq gnus-article-annotations ! (append ! (gnus-picons-insert-face-if-exists ! (concat ! (file-name-as-directory ! gnus-picons-database) pathpart) ! (concat hostpath username) ! iconpoint) ! gnus-article-annotations))) ! gnus-picons-user-directories) ! (mapcar '(lambda (pathpart) ! (setq gnus-article-annotations ! (append ! (gnus-picons-insert-face-if-exists ! (concat (file-name-as-directory ! gnus-picons-database) pathpart) ! (concat hostpath "unknown") ! iconpoint) ! gnus-article-annotations))) ! gnus-picons-domain-directories) ! (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all) ! )))) ! ! (defun gnus-group-display-picons () ! "Display icons for the group in the gnus-picons-display-where buffer." ! (interactive) ! (if (and (featurep 'xpm) ! (or (not (fboundp 'device-type)) (equal (device-type) 'x))) ! (save-excursion ! (let ! ((iconpoint (point))) ! (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where)) ! (beginning-of-buffer) ! (cond ! ((listp gnus-group-annotations) ! (mapcar 'delete-annotation gnus-group-annotations) ! (setq gnus-group-annotations nil)) ! ((annotationp gnus-group-annotations) ! (delete-annotation gnus-group-annotations) ! (setq gnus-group-annotations nil)) ! ) ! (setq iconpoint (point)) ! (if (not (looking-at "^$")) ! (open-line 1)) ! (gnus-picons-remove gnus-group-annotations) ! (setq gnus-group-annotations nil) ! (setq gnus-group-annotations ! (gnus-picons-insert-face-if-exists ! (concat (file-name-as-directory gnus-picons-database) ! gnus-picons-news-directory) ! (concat (replace-in-string gnus-newsgroup-name "\\." "/") ! "/unknown") ! iconpoint t)) ! (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))) ! ! ! (defun gnus-picons-insert-face-if-exists (path filename ipoint &optional rev) ! "Inserts a face at point if I can find one" ! (let ((pathfile (concat path "/" filename "/face")) ! (newfilename ! (replace-in-string filename ! "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1")) ! (annotations nil)) ! (if (and rev ! (not (equal filename newfilename))) ! (setq annotations (append ! (gnus-picons-insert-face-if-exists path newfilename ipoint rev) ! annotations))) ! (if (eq (length annotations) (length (setq annotations (append ! (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint) ! annotations)))) ! (setq annotations (append ! (gnus-picons-try-to-find-face ! (concat pathfile ".xbm") ipoint) ! annotations))) ! (if (and (not rev) ! (not (equal filename newfilename))) ! (setq annotations (append ! (gnus-picons-insert-face-if-exists path newfilename ipoint rev) ! annotations))) ! annotations ) ) (defun gnus-picons-try-to-find-face (path ipoint) ! "If PATH exists, display it as a bitmap. Returns t if succedded." ! (if (file-exists-p path) ! (progn ! ; (insert (format "yes: %s\n" path)) ! (setq gl (make-glyph path)) ! (set-glyph-face gl 'default) ! (list (make-annotation gl ipoint 'text))) ! ; (insert (format "no: %s\n" path)) ! nil)) (defun gnus-picons-reverse-domain-path (str) "a/b/c/d -> d/c/b/a" (if (equal (replace-in-string str "^[^/]*$" "") "") str (concat (replace-in-string str "^.*/\\([_a-zA-Z0-9-]+\\)$" "\\1") "/" ! (gnus-picons-reverse-domain-path ! (replace-in-string str "^\\(.*\\)/[_a-zA-Z0-9-]+$" "\\1"))))) *** pub/sgnus/lisp/gnus-salt.el Tue Jan 16 21:37:54 1996 --- sgnus/lisp/gnus-salt.el Sat Jan 13 13:23:22 1996 *************** *** 0 **** --- 1,608 ---- + ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to + ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + + ;;; + ;;; gnus-pick-mode + ;;; + + (defvar gnus-pick-mode nil + "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") + + (defvar gnus-pick-display-summary nil + "*Display summary while reading.") + + (defvar gnus-pick-mode-hook nil + "Hook run in summary pick mode buffers.") + + ;;; Internal variables. + + (defvar gnus-pick-mode-map nil) + + (unless gnus-pick-mode-map + (setq gnus-pick-mode-map (make-sparse-keymap)) + + (gnus-define-keys + gnus-pick-mode-map + "t" gnus-uu-mark-thread + "T" gnus-uu-unmark-thread + " " gnus-summary-mark-as-processable + "u" gnus-summary-unmark-as-processable + "U" gnus-summary-unmark-all-processable + "r" gnus-uu-mark-region + "R" gnus-uu-unmark-region + "e" gnus-uu-mark-by-regexp + "E" gnus-uu-mark-by-regexp + "b" gnus-uu-mark-buffer + "B" gnus-uu-unmark-buffer + "\r" gnus-pick-start-reading)) + + (defun gnus-pick-make-menu-bar () + (unless (boundp 'gnus-pick-menu) + (easy-menu-define + gnus-pick-menu gnus-pick-mode-map "" + '("Pick" + ("Pick" + ["Article" gnus-summary-mark-as-processable t] + ["Thread" gnus-uu-mark-thread t] + ["Region" gnus-uu-mark-region t] + ["Regexp" gnus-uu-mark-regexp t] + ["Buffer" gnus-uu-mark-buffer t]) + ("Unpick" + ["Article" gnus-summary-unmark-as-processable t] + ["Thread" gnus-uu-unmark-thread t] + ["Region" gnus-uu-unmark-region t] + ["Regexp" gnus-uu-unmark-regexp t] + ["Buffer" gnus-uu-unmark-buffer t]) + ["Start reading" gnus-pick-start-reading t] + ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) + + (defun gnus-pick-mode (&optional arg) + "Minor mode for provind a pick-and-read interface in Gnus summary buffers." + (interactive "P") + (when (eq major-mode 'gnus-summary-mode) + (make-local-variable 'gnus-pick-mode) + (setq gnus-pick-mode + (if (null arg) (not gnus-pick-mode) + (> (prefix-numeric-value arg) 0))) + (when gnus-pick-mode + ;; Make sure that we don't select any articles upon group entry. + (make-local-variable 'gnus-auto-select-first) + (setq gnus-auto-select-first nil) + ;; 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)) + (unless (assq 'gnus-topic-mode minor-mode-map-alist) + (push (cons 'gnus-topic-mode gnus-pick-mode-map) + minor-mode-map-alist)) + (run-hooks 'gnus-pick-mode-hook)))) + + (defun gnus-pick-start-reading (&optional catch-up) + "Start reading the picked articles. + If given a prefix, mark all unpicked articles as read." + (interactive "P") + (unless gnus-newsgroup-processable + (error "No articles have been picked")) + (gnus-summary-limit-to-articles nil) + (when catch-up + (gnus-summary-limit-mark-excluded-as-read)) + (gnus-configure-windows (if gnus-pick-display-summary 'summary 'pick) t)) + + + ;;; + ;;; gnus-binary-mode + ;;; + + (defvar gnus-binary-mode nil + "Minor mode for provind a binary group interface in Gnus summary buffers.") + + (defvar gnus-binary-mode-hook nil + "Hook run in summary binary mode buffers.") + + (defvar gnus-binary-mode-map nil) + + (unless gnus-binary-mode-map + (setq gnus-binary-mode-map (make-sparse-keymap)) + + (gnus-define-keys + gnus-binary-mode-map + "g" gnus-binary-show-article)) + + (defun gnus-binary-make-menu-bar () + (unless (boundp 'gnus-binary-menu) + (easy-menu-define + gnus-binary-menu gnus-binary-mode-map "" + '("Pick" + ["Switch binary mode off" gnus-binary-mode t])))) + + (defun gnus-binary-mode (&optional arg) + "Minor mode for providing a binary group interface in Gnus summary buffers." + (interactive "P") + (when (eq major-mode 'gnus-summary-mode) + (make-local-variable 'gnus-binary-mode) + (setq gnus-binary-mode + (if (null arg) (not gnus-binary-mode) + (> (prefix-numeric-value arg) 0))) + (when gnus-binary-mode + ;; Make sure that we don't select any articles upon group entry. + (make-local-variable 'gnus-auto-select-first) + (setq gnus-auto-select-first nil) + (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)) + (unless (assq 'gnus-topic-mode minor-mode-map-alist) + (push (cons 'gnus-topic-mode gnus-binary-mode-map) + minor-mode-map-alist)) + (run-hooks 'gnus-binary-mode-hook)))) + + (defun gnus-binary-display-article (article &optional all-header) + "Run ARTICLE through the binary decode functions." + (when (gnus-summary-goto-subject article) + (let ((gnus-view-pseudos 'automatic)) + (gnus-uu-decode-uu)))) + + (defun gnus-binary-show-article (&optional arg) + "Bypass the binary functions and show the article." + (interactive "P") + (let (gnus-summary-display-article-function) + (gnus-summary-show-article arg))) + + ;;; + ;;; gnus-tree-mode + ;;; + + (defvar gnus-tree-line-format "%(%[%3,3n%]%)" + "Format of tree elements.") + + (defvar gnus-tree-minimize-window t + "If non-nil, minimize the tree buffer window. + If a number, never let the tree buffer grow taller than that number of + lines.") + + (defvar gnus-selected-tree-face 'modeline + "*Face used for highlighting selected articles in the thread tree.") + + (defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) (?\{ . ?\})) + "Brackets used in tree nodes.") + + (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) + "Charaters used to connect parents with children.") + + (defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z" + "*The format specification for the tree mode line.") + + (defvar gnus-generate-tree-function 'gnus-generate-vertical-tree + "*Function for generating a thread tree. + Two predefined functions are available: + `gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.") + + (defvar gnus-tree-mode-hook nil + "*Hook run in tree mode buffers.") + + (defvar gnus-tree-buffer "*Tree*" + "Buffer where Gnus thread trees are displayed.") + + ;;; Internal variables. + + (defvar gnus-tree-line-format-alist + `((?n gnus-tmp-name ?s) + (?f gnus-tmp-from ?s) + (?N gnus-tmp-number ?d) + (?\[ gnus-tmp-open-bracket ?c) + (?\] gnus-tmp-close-bracket ?c) + (?s gnus-tmp-subject ?s))) + + (defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist) + + (defvar gnus-tree-mode-line-format-spec nil) + (defvar gnus-tree-line-format-spec nil) + + (defvar gnus-tree-node-length nil) + (defvar gnus-selected-tree-overlay nil) + + (defvar gnus-tree-displayed-thread nil) + + (defvar gnus-tree-mode-map nil) + (put 'gnus-tree-mode 'mode-class 'special) + + (unless gnus-tree-mode-map + (setq gnus-tree-mode-map (make-keymap)) + (suppress-keymap gnus-tree-mode-map) + (gnus-define-keys + gnus-tree-mode-map + "\r" gnus-tree-select-article + gnus-mouse-2 gnus-tree-pick-article + "\C-?" gnus-tree-read-summary-keys) + + (substitute-key-definition + 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) + + (defun gnus-tree-make-menu-bar () + ) + + (defun gnus-tree-mode () + "Major mode for displaying thread trees." + (interactive) + (setq gnus-tree-mode-line-format-spec + (gnus-parse-format gnus-tree-mode-line-format + gnus-summary-mode-line-format-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)) + (gnus-tree-make-menu-bar)) + (kill-all-local-variables) + (gnus-simplify-mode-line) + (setq mode-name "Tree") + (setq major-mode 'gnus-tree-mode) + (use-local-map gnus-tree-mode-map) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) + (setq truncate-lines t) + (save-excursion + (gnus-set-work-buffer) + (gnus-tree-node-insert (make-mail-header "") nil) + (setq gnus-tree-node-length (1- (point)))) + (run-hooks 'gnus-tree-mode-hook)) + + (defun gnus-tree-read-summary-keys (&optional arg) + "Read a summary buffer key sequence and execute it." + (interactive "P") + (let ((buf (current-buffer)) + win) + (gnus-article-read-summary-keys arg nil t) + (when (setq win (get-buffer-window buf)) + (select-window win) + (when gnus-selected-tree-overlay + (goto-char (overlay-end gnus-selected-tree-overlay))) + (gnus-tree-minimize)))) + + (defun gnus-tree-select-article (article) + "Select the article under point, if any." + (interactive (list (gnus-tree-article-number))) + (let ((buf (current-buffer))) + (when article + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-goto-article article)) + (select-window (get-buffer-window buf))))) + + (defun gnus-tree-pick-article (e) + "Select the article under the mouse pointer." + (interactive "e") + (mouse-set-point e) + (gnus-tree-select-article (gnus-tree-article-number))) + + (defun gnus-tree-article-number () + (get-text-property (point) 'gnus-number)) + + (defun gnus-tree-article-region (article) + "Return a cons with BEG and END of the article region." + (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (when pos + (cons pos (next-single-property-change pos 'gnus-number))))) + + (defun gnus-tree-goto-article (article) + (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (when pos + (goto-char pos)))) + + (defun gnus-tree-recenter () + "Center point in the tree window." + (when (get-buffer-window (current-buffer)) + (save-selected-window + (select-window (get-buffer-window (current-buffer))) + (let* ((top (cond ((< (window-height) 4) 0) + ((< (window-height) 7) 1) + (t 2))) + (height (1- (window-height))) + (bottom (save-excursion (goto-char (point-max)) + (forward-line (- height)) + (point))) + (window (get-buffer-window (current-buffer)))) + ;; Set the window start to either `bottom', which is the biggest + ;; possible valid number, or the second line from the top, + ;; whichever is the least. + (set-window-start + window (min bottom (save-excursion + (forward-line (- top)) (point)))))))) + + (defun gnus-get-tree-buffer () + "Return the tree buffer properly initialized." + (save-excursion + (set-buffer (get-buffer-create gnus-tree-buffer)) + (unless (eq major-mode 'gnus-tree-mode) + (gnus-add-current-to-buffer-list) + (gnus-tree-mode)) + (current-buffer))) + + (defun gnus-tree-minimize () + (when (and gnus-tree-minimize-window + (not (one-window-p))) + (let* ((window-min-height 2) + (height (count-lines (point-min) (point-max))) + (min (max (1- window-min-height) height)) + (tot (if (numberp gnus-tree-minimize-window) + (min gnus-tree-minimize-window min) + min)) + (win (get-buffer-window (current-buffer))) + (wh (and win (1- (window-height win))))) + (when (and win + (not (eq tot wh))) + (save-selected-window + (select-window win) + (enlarge-window (- tot wh))))))) + + ;;; Generating the tree. + + (defun gnus-tree-node-insert (header sparse) + (let* ((dummy (stringp header)) + (header (if (vectorp header) header + (progn + (setq header (make-mail-header "*****")) + (mail-header-set-number header 0) + (mail-header-set-lines header 0) + (mail-header-set-chars header 0) + header))) + (gnus-tmp-from (mail-header-from header)) + (gnus-tmp-subject (mail-header-subject header)) + (gnus-tmp-number (mail-header-number header)) + (gnus-tmp-name + (cond + ((string-match "(.+)" gnus-tmp-from) + (substring gnus-tmp-from + (1+ (match-beginning 0)) (1- (match-end 0)))) + ((string-match "<[^>]+> *$" gnus-tmp-from) + (let ((beg (match-beginning 0))) + (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) + (substring gnus-tmp-from (1+ (match-beginning 0)) + (1- (match-end 0)))) + (substring gnus-tmp-from 0 beg)))) + ((memq gnus-tmp-number sparse) + "***") + (t gnus-tmp-from))) + (gnus-tmp-open-bracket + (cond ((memq gnus-tmp-number sparse) + (caadr gnus-tree-brackets)) + (dummy (caaddr gnus-tree-brackets)) + (t (caar gnus-tree-brackets)))) + (gnus-tmp-close-bracket + (cond ((memq gnus-tmp-number sparse) + (cdadr gnus-tree-brackets)) + (dummy + (cdaddr gnus-tree-brackets)) + (t (cdar gnus-tree-brackets)))) + (buffer-read-only nil) + beg end) + (add-text-properties + (setq beg (point)) + (setq end (progn (eval gnus-tree-line-format-spec) (point))) + (list 'gnus-number gnus-tmp-number)) + (when (or t (gnus-visual-p 'tree-highlight 'highlight)) + (gnus-tree-highlight-node gnus-tmp-number beg end)))) + + (defun gnus-tree-highlight-node (article beg end) + "Highlight current line according to `gnus-summary-highlight'." + (let ((list gnus-summary-highlight) + face) + (save-excursion + (set-buffer gnus-summary-buffer) + (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) + gnus-summary-default-score 0)) + (default gnus-summary-default-score) + (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) + ;; Eval the cars of the lists until we find a match. + (while (and list + (not (eval (caar list)))) + (setq list (cdr list))))) + (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) + (put-text-property + beg end 'face + (if (boundp face) (symbol-value face) face))))) + + (defun gnus-tree-indent (level) + (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? ))) + + (defvar gnus-tmp-limit) + (defvar gnus-tmp-sparse) + (defvar gnus-tmp-indent) + + (defun gnus-generate-tree (thread) + "Generate a thread tree for THREAD." + (save-excursion + (set-buffer (gnus-get-tree-buffer)) + (let ((buffer-read-only nil) + (gnus-tmp-indent 0)) + (erase-buffer) + (funcall gnus-generate-tree-function thread 0) + (gnus-set-mode-line 'tree) + (goto-char (point-min)) + (gnus-tree-minimize) + (gnus-tree-recenter) + (gnus-horizontal-recenter)))) + + (defun gnus-generate-horizontal-tree (thread level &optional dummyp) + "Generate a horizontal tree." + (let* ((dummy (stringp (car thread))) + (do (or dummy + (memq (mail-header-number (car thread)) gnus-tmp-limit))) + col beg) + (if (not do) + ;; We don't want this article. + (setq thread (cdr thread)) + (if (not (bolp)) + ;; Not the first article on the line, so we insert a "-". + (insert (car gnus-tree-parent-child-edges)) + ;; If the level isn't zero, then we insert some indentation. + (unless (zerop level) + (gnus-tree-indent level) + (insert (cadr gnus-tree-parent-child-edges)) + (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) + ;; Draw "|" lines upwards. + (while (progn + (forward-line -1) + (forward-char col) + (= (following-char) ? )) + (delete-char 1) + (insert (caddr gnus-tree-parent-child-edges))) + (goto-char beg))) + (setq dummyp nil) + ;; Insert the article node. + (gnus-tree-node-insert (pop thread) gnus-tmp-sparse)) + (if (null thread) + ;; End of the thread, so we go to the next line. + (unless (bolp) + (insert "\n")) + ;; Recurse downwards in all children of this article. + (while thread + (gnus-generate-horizontal-tree + (pop thread) (if do (1+ level) level) + (or dummyp dummy)))))) + + (defsubst gnus-tree-indent-vertical () + (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) + (- (point) (gnus-point-at-bol))))) + (when (> len 0) + (insert (make-string len ? ))))) + + (defsubst gnus-tree-forward-line (n) + (while (>= (decf n) 0) + (unless (zerop (forward-line 1)) + (end-of-line) + (insert "\n"))) + (end-of-line)) + + (defun gnus-generate-vertical-tree (thread level &optional dummyp) + "Generate a vertical tree." + (let* ((dummy (stringp (car thread))) + (do (or dummy + (memq (mail-header-number (car thread)) gnus-tmp-limit))) + col beg) + (if (not do) + ;; We don't want this article. + (setq thread (cdr thread)) + (if (not (save-excursion (beginning-of-line) (bobp))) + ;; Not the first article on the line, so we insert a "-". + (progn + (gnus-tree-indent-vertical) + (insert (make-string (/ gnus-tree-node-length 2) ? )) + (insert (caddr gnus-tree-parent-child-edges)) + (gnus-tree-forward-line 1)) + ;; If the level isn't zero, then we insert some indentation. + (unless (zerop gnus-tmp-indent) + (gnus-tree-forward-line (1- (* 2 level))) + (gnus-tree-indent-vertical) + (delete-char -1) + (insert (cadr gnus-tree-parent-child-edges)) + (setq beg (point)) + ;; Draw "-" lines leftwards. + (while (progn + (forward-char -2) + (= (following-char) ? )) + (delete-char 1) + (insert (car gnus-tree-parent-child-edges))) + (goto-char beg) + (gnus-tree-forward-line 1))) + (setq dummyp nil) + ;; Insert the article node. + (gnus-tree-indent-vertical) + (gnus-tree-node-insert (pop thread) gnus-tmp-sparse) + (gnus-tree-forward-line 1)) + (if (null thread) + ;; End of the thread, so we go to the next line. + (progn + (goto-char (point-min)) + (end-of-line) + (incf gnus-tmp-indent)) + ;; Recurse downwards in all children of this article. + (while thread + (gnus-generate-vertical-tree + (pop thread) (if do (1+ level) level) + (or dummyp dummy)))))) + + ;;; Interface functions. + + (defun gnus-possibly-generate-tree (article &optional force) + "Generate the thread tree for ARTICLE if it isn't displayed already." + (save-excursion + (let ((top (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-cut-thread + (gnus-remove-thread + (mail-header-id (gnus-summary-article-header article)) t)))) + (gnus-tmp-limit gnus-newsgroup-limit) + (gnus-tmp-sparse gnus-newsgroup-sparse)) + (when (or force + (not (eq top gnus-tree-displayed-thread))) + (gnus-generate-tree top) + (setq gnus-tree-displayed-thread top))))) + + (defun gnus-tree-open (group) + (gnus-get-tree-buffer)) + + (defun gnus-tree-close (group) + (gnus-kill-buffer gnus-tree-buffer)) + + (defun gnus-highlight-selected-tree (article) + "Highlight the selected article in the tree." + (let ((buf (current-buffer)) + region) + (set-buffer gnus-tree-buffer) + (when (setq region (gnus-tree-article-region article)) + (unless gnus-selected-tree-overlay + ;; Create a new overlay. + (gnus-overlay-put + (setq gnus-selected-tree-overlay (gnus-make-overlay 1 1)) + 'face gnus-selected-tree-face)) + ;; Move the overlay to the article. + (gnus-move-overlay + gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) + (gnus-tree-minimize) + (gnus-tree-recenter) + (gnus-horizontal-recenter)) + ;; If we remove this save-excursion, it updates the wrong mode lines?!? + (save-excursion + (set-buffer gnus-tree-buffer) + (gnus-set-mode-line 'tree)) + (set-buffer buf))) + + (defun gnus-tree-highlight-article (article face) + (save-excursion + (set-buffer (gnus-get-tree-buffer)) + (let (region) + (when (setq region (gnus-tree-article-region article)) + (put-text-property (car region) (cdr region) 'face face))))) + + ;;; gnus-salt.el ends here *** pub/sgnus/lisp/gnus-score.el Thu Dec 21 04:09:38 1995 --- sgnus/lisp/gnus-score.el Mon Jan 15 14:00:47 1996 *************** *** 1,5 **** ;;; gnus-score.el --- scoring code for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; gnus-score.el --- scoring code for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen *************** *** 97,103 **** "*Scoring commands will raise/lower the score with this number as the default.") (defvar gnus-score-expiry-days 7 ! "*Number of days before unused score file entries are expired.") (defvar gnus-orphan-score nil "*All orphans get this score added. Set in the score file.") --- 97,109 ---- "*Scoring commands will raise/lower the score with this number as the default.") (defvar gnus-score-expiry-days 7 ! "*Number of days before unused score file entries are expired. ! If this variable is nil, no score file entries will be expired.") ! ! (defvar gnus-update-score-entry-dates t ! "*In non-nil, update matching score entry dates. ! If this variable is nil, then score entries that provide matches ! will be expired along with non-matching score entries.") (defvar gnus-orphan-score nil "*All orphans get this score added. Set in the score file.") *************** *** 111,123 **** (gnus-del-mark (from -2) (subject -15))) "*Alist of marks and scores.") - (defvar gnus-file-name-translation-table nil - "*Table for translating characters in file names. - - Under OS/2 you'd typically set this variable to - - '(\?: \?_)") - (defvar gnus-score-mimic-keymap nil "*Have the score entry functions pretend that they are a keymap.") --- 117,122 ---- *************** *** 203,208 **** --- 202,216 ---- (interactive "P") (gnus-summary-increase-score (- (gnus-score-default score)))) + (defvar gnus-score-default-header nil + "*The default header to score on when entering a score rule interactively.") + + (defvar gnus-score-default-type nil + "*The default score type to use when entering a score rule interactively.") + + (defvar gnus-score-default-duration nil + "*The default score duration to use on when entering a score rule interactively.") + (defun gnus-summary-increase-score (&optional score) "Make a score entry based on the current article. The user will be prompted for header to score on, match type, *************** *** 219,229 **** (?b "body" "" nil body-string) (?h "head" "" nil body-string) (?i "message-id" nil t string) ! (?t "references" "message-id" t string) (?x "xref" nil nil string) (?l "lines" nil nil number) (?d "date" nil nil date) ! (?f "followup" nil nil string))) (char-to-type '((?s s "substring" string) (?e e "exact string" string) --- 227,238 ---- (?b "body" "" nil body-string) (?h "head" "" nil body-string) (?i "message-id" nil t string) ! (?t "references" "message-id" nil string) (?x "xref" nil nil string) (?l "lines" nil nil number) (?d "date" nil nil date) ! (?f "followup" nil nil string) ! (?T "thread" nil nil string))) (char-to-type '((?s s "substring" string) (?e e "exact string" string) *************** *** 242,247 **** --- 251,257 ---- '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) hchar entry temporary tchar pchar end type match) + ;; First we read the header to score. (while (not hchar) (if mimic *************** *** 272,279 **** (progn ;; This was a majuscle, so we end reading and set the defaults. (if mimic (message "%c %c" prefix hchar) (message "")) ! (setq type nil ! temporary (current-time-string))) ;; We continue reading - the type. (while (not tchar) --- 282,293 ---- (progn ;; This was a majuscle, so we end reading and set the defaults. (if mimic (message "%c %c" prefix hchar) (message "")) ! (setq type gnus-score-default-type ! temporary (and gnus-score-default-duration ! (assq ! (aref (symbol-name gnus-score-default-duration) ! 0) ! char-to-perm)))) ;; We continue reading - the type. (while (not tchar) *************** *** 312,318 **** ;; It was a majuscle, so we end reading and the the default. (if mimic (message "%c %c %c" prefix hchar tchar) (message "")) ! (setq temporary (current-time-string))) ;; We continue reading. (while (not pchar) --- 326,337 ---- ;; It was a majuscle, so we end reading and the the default. (if mimic (message "%c %c %c" prefix hchar tchar) (message "")) ! (setq temporary ! (and gnus-score-default-duration ! (assq ! (aref (symbol-name gnus-score-default-duration) ! 0) ! char-to-perm)))) ;; We continue reading. (while (not pchar) *************** *** 597,602 **** --- 616,636 ---- (gnus-summary-update-line) (forward-line 1)))) + (defun gnus-score-update-all-lines () + "Update all lines in the summary buffer, even the hidden ones." + (save-excursion + (goto-char (point-min)) + (let (hidden) + (while (not (eobp)) + (when (gnus-summary-show-thread) + (push (point) hidden)) + (gnus-summary-update-line) + (forward-line 1)) + ;; Re-hide the hidden threads. + (while hidden + (goto-char (pop hidden)) + (gnus-summary-hide-thread))))) + (defun gnus-score-set-expunge-below (score) "Automatically expunge articles with score below SCORE." (interactive *************** *** 664,669 **** --- 698,704 ---- (interactive (list gnus-current-score-file)) (let ((winconf (current-window-configuration))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) + (gnus-make-directory (file-name-directory file)) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) *************** *** 677,682 **** --- 712,718 ---- "Edit a score file." (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) + (gnus-make-directory (file-name-directory file)) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) (let ((winconf (current-window-configuration))) (setq gnus-score-edit-buffer (find-file-noselect file)) *************** *** 803,833 **** (defun gnus-score-load-score-alist (file) (let (alist) ! (if (file-readable-p file) ! (progn ! (save-excursion ! (gnus-set-work-buffer) ! (insert-file-contents file) ! (goto-char (point-min)) ! ;; Only do the loading if the score file isn't empty. ! (if (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) ! (setq alist ! (condition-case () ! (read (current-buffer)) ! (error ! (progn ! (gnus-message 3 "Problem with score file %s" file) ! (ding) ! (sit-for 2) ! nil)))))) ! (if (eq (car alist) 'setq) ! (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) ! (setq gnus-score-alist alist)) ! (setq gnus-score-alist ! (gnus-score-check-syntax gnus-score-alist file))) ! (setq gnus-score-alist nil)))) (defun gnus-score-check-syntax (alist file) (cond ((null alist) nil) --- 839,871 ---- (defun gnus-score-load-score-alist (file) (let (alist) ! (if (not (file-readable-p file)) ! (setq gnus-score-alist nil) ! (save-excursion ! (gnus-set-work-buffer) ! (insert-file-contents file) ! (goto-char (point-min)) ! ;; Only do the loading if the score file isn't empty. ! (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) ! (setq alist ! (condition-case () ! (read (current-buffer)) ! (error ! (progn ! (gnus-message 3 "Problem with score file %s" file) ! (ding) ! (sit-for 2) ! nil)))))) ! (if (eq (car alist) 'setq) ! ;; This is an old-style score file. ! (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) ! (setq gnus-score-alist alist)) ! ;; Check the syntax of the score file. ! (setq gnus-score-alist ! (gnus-score-check-syntax gnus-score-alist file))))) (defun gnus-score-check-syntax (alist file) + "Check the syntax of the score ALIST." (cond ((null alist) nil) *************** *** 837,856 **** nil) (t (let ((a alist) ! err) (while (and a (not err)) ! (cond ((not (listp (car a))) ! (gnus-message 3 "Illegal score element %s in %s" (car a) file) ! (setq err t)) ! ((and (stringp (car (car a))) ! (not (listp (nth 1 (car a))))) ! (gnus-message 3 "Illegal header match %s in %s" (nth 1 (car a)) file) ! (setq err t)) ! (t ! (setq a (cdr a))))) (if err (progn (ding) nil) alist))))) --- 875,912 ---- nil) (t (let ((a alist) ! sr err s) (while (and a (not err)) ! (setq ! err ! (cond ! ((not (listp (car a))) ! (format "Illegal score element %s in %s" (car a) file)) ! ((stringp (car (car a))) ! (cond ! ((not (listp (setq sr (cdr (car a))))) ! (format "Illegal header match %s in %s" (nth 1 (car a)) file)) ! (t ! (while (and sr (not err)) ! (setq s (pop sr)) ! (setq ! err ! (cond ! ((not (stringp (car s))) ! (format "Illegal match %s in %s" (car s) file)) ! ((and (cadr s) (not (integerp (cadr s)))) ! (format "Non-integer score %s in %s" (cadr s) file)) ! ((and (caddr s) (not (integerp (caddr s)))) ! (format "Non-integer date %s in %s" (caddr s) file)) ! ((and (cadddr s) (not (symbolp (cadddr s)))) ! (format "Non-symbol match type %s in %s" (cadddr s) file))))) ! err))))) ! (setq a (cdr a))) (if err (progn (ding) + (gnus-message 3 err) + (sit-for 2) nil) alist))))) *************** *** 954,960 **** (length gnus-newsgroup-scored))) (let* ((entries gnus-header-index) (now (gnus-day-number (current-time-string))) ! (expire (- now gnus-score-expiry-days)) (headers gnus-newsgroup-headers) (current-score-file gnus-current-score-file) entry header) --- 1010,1017 ---- (length gnus-newsgroup-scored))) (let* ((entries gnus-header-index) (now (gnus-day-number (current-time-string))) ! (expire (and gnus-score-expiry-days ! (- now gnus-score-expiry-days))) (headers gnus-newsgroup-headers) (current-score-file gnus-current-score-file) entry header) *************** *** 1124,1133 **** (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) --- 1181,1190 ---- (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) *************** *** 1178,1187 **** (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) --- 1235,1244 ---- (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) *************** *** 1270,1287 **** kill) gnus-score-trace))))) ;; Update expire date ! (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))) (setq entries rest))))) (setq articles (cdr articles))))))) ! (defun gnus-score-followup (scores header now expire &optional trace) ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) (current-score-file gnus-current-score-file) --- 1327,1345 ---- kill) gnus-score-trace))))) ;; Update expire date ! (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))) (setq entries rest))))) (setq articles (cdr articles))))))) ! (defun gnus-score-followup (scores header now expire &optional trace thread) ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) (current-score-file gnus-current-score-file) *************** *** 1352,1358 **** (setq art (car arts) arts (cdr arts)) (gnus-score-add-followups ! (car art) score all-scores))))) (while (funcall search-func match nil t) (end-of-line) (setq found (setq arts (get-text-property (point) 'articles))) --- 1410,1416 ---- (setq art (car arts) arts (cdr arts)) (gnus-score-add-followups ! (car art) score all-scores thread))))) (while (funcall search-func match nil t) (end-of-line) (setq found (setq arts (get-text-property (point) 'articles))) *************** *** 1360,1372 **** (while arts (setq art (car arts) arts (cdr arts)) ! (gnus-score-add-followups (car art) score all-scores)))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) --- 1418,1430 ---- (while arts (setq art (car arts) arts (cdr arts)) ! (gnus-score-add-followups (car art) score all-scores thread)))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) *************** *** 1374,1380 **** ;; We change the score file back to the previous one. (gnus-score-load-file current-score-file))) ! (defun gnus-score-add-followups (header score scores) (save-excursion (set-buffer gnus-summary-buffer) (let* ((id (mail-header-id header)) --- 1432,1438 ---- ;; We change the score file back to the previous one. (gnus-score-load-file current-score-file))) ! (defun gnus-score-add-followups (header score scores &optional thread) (save-excursion (set-buffer gnus-summary-buffer) (let* ((id (mail-header-id header)) *************** *** 1392,1398 **** (setq scores (cdr scores))) (or dont (gnus-summary-score-entry ! "references" id 's score (current-time-string) nil t))))) (defun gnus-score-string (score-list header now expire &optional trace) --- 1450,1457 ---- (setq scores (cdr scores))) (or dont (gnus-summary-score-entry ! (if thread "thread" "references") ! id 's score (current-time-string) nil t))))) (defun gnus-score-string (score-list header now expire &optional trace) *************** *** 1514,1527 **** (setcdr art (+ score (cdr art))))) (forward-line 1))) ;; Update expire date ! (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries)))) (setq entries rest)))) ;; Find fuzzy matches. --- 1573,1587 ---- (setcdr art (+ score (cdr art))))) (forward-line 1))) ;; Update expire date ! (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries)))) (setq entries rest)))) ;; Find fuzzy matches. *************** *** 1569,1582 **** (forward-line 1)) ;; Update expire date (unless trace ! (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))))) (setq entries rest))))))) (defun gnus-score-string< (a1 a2) --- 1629,1643 ---- (forward-line 1)) ;; Update expire date (unless trace ! (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))))) (setq entries rest))))))) (defun gnus-score-string< (a1 a2) *************** *** 1603,1609 **** ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) ! ("followup" 2 gnus-score-followup))) (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) --- 1664,1671 ---- ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) ! ("followup" 2 gnus-score-followup) ! ("thread" 5 gnus-score-thread))) (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) *************** *** 1632,1642 **** (symbol-name (car (car elem)))) (cdr (car elem)))) (setcar (car elem) ! (intern ! (concat "gnus-header-" ! (if (eq (car (car elem)) 'followup) ! "message-id" ! (downcase (symbol-name (car (car elem)))))))) (setq elem (cdr elem))) (setq malist (cdr malist))) ;; We change the score file to the adaptive score file. --- 1694,1706 ---- (symbol-name (car (car elem)))) (cdr (car elem)))) (setcar (car elem) ! `(lambda (h) ! (,(intern ! (concat "gnus-header-" ! (if (eq (car (car elem)) 'followup) ! "message-id" ! (downcase (symbol-name (car (car elem))))))) ! h))) (setq elem (cdr elem))) (setq malist (cdr malist))) ;; We change the score file to the adaptive score file. *************** *** 1745,1751 **** (setq gnus-score-cache nil) (setq gnus-newsgroup-scored nil) (gnus-possibly-score-headers) ! (gnus-score-update-lines)) (defun gnus-score-flush-cache () "Flush the cache of score files." --- 1809,1815 ---- (setq gnus-score-cache nil) (setq gnus-newsgroup-scored nil) (gnus-possibly-score-headers) ! (gnus-score-update-all-lines)) (defun gnus-score-flush-cache () "Flush the cache of score files." *************** *** 1880,1886 **** (expand-file-name gnus-kill-files-directory))) (klen (length kill-dir)) (score-regexp (gnus-score-file-regexp)) ! (trans (cdr (memq ?: gnus-file-name-translation-table))) ofiles not-match regexp) (save-excursion (set-buffer (get-buffer-create "*gnus score files*")) --- 1944,1950 ---- (expand-file-name gnus-kill-files-directory))) (klen (length kill-dir)) (score-regexp (gnus-score-file-regexp)) ! (trans (cdr (assq ?: nnheader-file-name-translation-alist))) ofiles not-match regexp) (save-excursion (set-buffer (get-buffer-create "*gnus score files*")) *************** *** 2027,2034 **** (defun gnus-score-file-name (newsgroup &optional suffix) "Return the name of a score file for NEWSGROUP." (let ((suffix (or suffix gnus-score-file-suffix))) ! (apply ! 'gnus-replace-chars-in-string (cond ((or (null newsgroup) (string-equal newsgroup "")) --- 2091,2097 ---- (defun gnus-score-file-name (newsgroup &optional suffix) "Return the name of a score file for NEWSGROUP." (let ((suffix (or suffix gnus-score-file-suffix))) ! (nnheader-translate-file-chars (cond ((or (null newsgroup) (string-equal newsgroup "")) *************** *** 2044,2051 **** ;; Place "SCORE" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" suffix) ! (or gnus-kill-files-directory "~/News")))) ! gnus-file-name-translation-table))) (defun gnus-score-search-global-directories (files) "Scan all global score directories for score files." --- 2107,2113 ---- ;; Place "SCORE" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" suffix) ! (or gnus-kill-files-directory "~/News"))))))) (defun gnus-score-search-global-directories (files) "Scan all global score directories for score files." *** pub/sgnus/lisp/gnus-soup.el Thu Dec 21 04:09:38 1995 --- sgnus/lisp/gnus-soup.el Tue Jan 16 16:50:17 1996 *************** *** 1,5 **** ;;; gnus-soup.el --- SOUP packet writing support for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; gnus-soup.el --- SOUP packet writing support for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen *************** *** 304,309 **** --- 304,310 ---- (gnus-set-work-buffer) (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr (car prefix)))) + (gnus-make-directory (car (car prefix))) (write-region (point-min) (point-max) (concat (car (car prefix)) gnus-soup-prefix-file) *************** *** 420,426 **** area))) "")) ""))))) (write-region (point-min) (point-max) ! (concat gnus-soup-directory "AREAS")) (set-buffer-modified-p nil) (kill-buffer (current-buffer))))) --- 421,427 ---- area))) "")) ""))))) (write-region (point-min) (point-max) ! (concat gnus-soup-directory "AREAS") nil 'silent) (set-buffer-modified-p nil) (kill-buffer (current-buffer))))) *************** *** 439,445 **** (gnus-soup-reply-prefix area) (gnus-soup-reply-kind area) (gnus-soup-reply-encoding area))))) ! (write-region (point-min) (point-max) (concat dir "REPLIES")) (set-buffer-modified-p nil) (kill-buffer (current-buffer)))) --- 440,446 ---- (gnus-soup-reply-prefix area) (gnus-soup-reply-kind area) (gnus-soup-reply-encoding area))))) ! (write-region (point-min) (point-max) (concat dir "REPLIES") nil 'silent) (set-buffer-modified-p nil) (kill-buffer (current-buffer)))) *************** *** 473,479 **** () (and (file-exists-p (concat dir gnus-soup-prefix-file)) (condition-case nil ! (load-file (concat dir gnus-soup-prefix-file)) (error nil))) (setq gnus-soup-last-prefix (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0))) --- 474,480 ---- () (and (file-exists-p (concat dir gnus-soup-prefix-file)) (condition-case nil ! (load (concat dir gnus-soup-prefix-file) nil t t) (error nil))) (setq gnus-soup-last-prefix (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0))) *** pub/sgnus/lisp/gnus-srvr.el Thu Dec 21 04:09:38 1995 --- sgnus/lisp/gnus-srvr.el Wed Jan 10 22:07:18 1996 *************** *** 1,5 **** ;;; gnus-srvr.el --- virtual server support for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; gnus-srvr.el --- virtual server support for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 55,83 **** (defvar gnus-server-mode-line-format-spec nil) (defvar gnus-server-killed-servers nil) (defvar gnus-server-mode-map nil) (put 'gnus-server-mode 'mode-class 'special) ! (if gnus-server-mode-map ! nil (setq gnus-server-mode-map (make-sparse-keymap)) (suppress-keymap gnus-server-mode-map) ! (define-key gnus-server-mode-map " " 'gnus-server-read-server) ! (define-key gnus-server-mode-map "\r" 'gnus-server-read-server) ! (define-key gnus-server-mode-map gnus-mouse-2 'gnus-server-pick-server) ! (define-key gnus-server-mode-map "q" 'gnus-server-exit) ! (define-key gnus-server-mode-map "l" 'gnus-server-list-servers) ! (define-key gnus-server-mode-map "k" 'gnus-server-kill-server) ! (define-key gnus-server-mode-map "y" 'gnus-server-yank-server) ! (define-key gnus-server-mode-map "c" 'gnus-server-copy-server) ! (define-key gnus-server-mode-map "a" 'gnus-server-add-server) ! (define-key gnus-server-mode-map "e" 'gnus-server-edit-server) ! ! (define-key gnus-server-mode-map "O" 'gnus-server-open-server) ! (define-key gnus-server-mode-map "C" 'gnus-server-close-server) ! (define-key gnus-server-mode-map "D" 'gnus-server-deny-server) ! (define-key gnus-server-mode-map "R" 'gnus-server-remove-denials) ! ) (defun gnus-server-mode () "Major mode for listing and editing servers. --- 55,118 ---- (defvar gnus-server-mode-line-format-spec nil) (defvar gnus-server-killed-servers nil) + (defvar gnus-server-mode-map) + + (defvar gnus-server-menu-hook nil + "*Hook run after the creation of the server mode menu.") + + (defun gnus-server-make-menu-bar () + (gnus-visual-turn-off-edit-menu 'server) + (or + (boundp 'gnus-server-menu) + (progn + (easy-menu-define + gnus-server-menu gnus-server-mode-map "" + '("Server" + ["Add" gnus-server-add-server t] + ["Browse" gnus-server-read-server t] + ["List" gnus-server-list-servers t] + ["Kill" gnus-server-kill-server t] + ["Yank" gnus-server-yank-server t] + ["Copy" gnus-server-copy-server t] + ["Edit" gnus-server-edit-server t] + ["Exit" gnus-server-exit t] + )) + + (easy-menu-define + gnus-server-menu gnus-server-mode-map "" + '("Connections" + ["Open" gnus-server-open-server t] + ["Close" gnus-server-close-server t] + ["Deny" gnus-server-deny-servers t] + ["Reset" gnus-server-remove-denials t] + )) + + (run-hooks 'gnus-server-menu-hook)))) + (defvar gnus-server-mode-map nil) (put 'gnus-server-mode 'mode-class 'special) ! (unless gnus-server-mode-map (setq gnus-server-mode-map (make-sparse-keymap)) (suppress-keymap gnus-server-mode-map) ! ! (gnus-define-keys ! gnus-server-mode-map ! " " 'gnus-server-read-server ! "\r" 'gnus-server-read-server ! gnus-mouse-2 'gnus-server-pick-server ! "q" 'gnus-server-exit ! "l" 'gnus-server-list-servers ! "k" 'gnus-server-kill-server ! "y" 'gnus-server-yank-server ! "c" 'gnus-server-copy-server ! "a" 'gnus-server-add-server ! "e" 'gnus-server-edit-server ! ! "O" 'gnus-server-open-server ! "C" 'gnus-server-close-server ! "D" 'gnus-server-deny-server ! "R" 'gnus-server-remove-denials)) (defun gnus-server-mode () "Major mode for listing and editing servers. *************** *** 401,405 **** --- 436,676 ---- (interactive "e") (mouse-set-point e) (gnus-server-read-server (gnus-server-server-name))) + + + ;;; + ;;; Browse Server Mode + ;;; + + (defvar gnus-browse-menu-hook nil + "*Hook run after the creation of the browse mode menu.") + + (defvar gnus-browse-mode-hook nil) + (defvar gnus-browse-mode-map nil) + (put 'gnus-browse-mode 'mode-class 'special) + + (unless gnus-browse-mode-map + (setq gnus-browse-mode-map (make-keymap)) + (suppress-keymap gnus-browse-mode-map) + + (gnus-define-keys + gnus-browse-mode-map + " " gnus-browse-read-group + "=" gnus-browse-select-group + "n" gnus-browse-next-group + "p" gnus-browse-prev-group + "\177" gnus-browse-prev-group + "N" gnus-browse-next-group + "P" gnus-browse-prev-group + "\M-n" gnus-browse-next-group + "\M-p" gnus-browse-prev-group + "\r" gnus-browse-select-group + "u" gnus-browse-unsubscribe-current-group + "l" gnus-browse-exit + "L" gnus-browse-exit + "q" gnus-browse-exit + "Q" gnus-browse-exit + "\C-c\C-c" gnus-browse-exit + "?" gnus-browse-describe-briefly + "\C-c\C-i" gnus-info-find-node)) + + (defun gnus-browse-make-menu-bar () + (gnus-visual-turn-off-edit-menu 'browse) + (or + (boundp 'gnus-browse-menu) + (progn + (easy-menu-define + gnus-browse-menu gnus-browse-mode-map "" + '("Browse" + ["Subscribe" gnus-browse-unsubscribe-current-group t] + ["Read" gnus-browse-read-group t] + ["Select" gnus-browse-read-group t] + ["Next" gnus-browse-next-group t] + ["Prev" gnus-browse-next-group t] + ["Exit" gnus-browse-exit t] + )) + (run-hooks 'gnus-browse-menu-hook)))) + + (defvar gnus-browse-current-method nil) + (defvar gnus-browse-return-buffer nil) + + (defvar gnus-browse-buffer "*Gnus Browse Server*") + + (defun gnus-browse-foreign-server (method &optional return-buffer) + "Browse the server METHOD." + (setq gnus-browse-current-method method) + (setq gnus-browse-return-buffer return-buffer) + (let ((gnus-select-method method) + groups group) + (gnus-message 5 "Connecting to %s..." (nth 1 method)) + (cond + ((not (gnus-check-server method)) + (gnus-message + 1 "Unable to contact server: %s" (gnus-status-message method)) + nil) + ((not (gnus-request-list method)) + (gnus-message + 1 "Couldn't request list: %s" (gnus-status-message method)) + nil) + (t + (get-buffer-create gnus-browse-buffer) + (gnus-add-current-to-buffer-list) + (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) + (gnus-configure-windows 'browse) + (buffer-disable-undo (current-buffer)) + (let ((buffer-read-only nil)) + (erase-buffer)) + (gnus-browse-mode) + (setq mode-line-buffer-identification + (list + (format + "Gnus: %%b {%s:%s}" (car method) (car (cdr method))))) + (save-excursion + (set-buffer nntp-server-buffer) + (let ((cur (current-buffer))) + (goto-char (point-min)) + (or (string= gnus-ignored-newsgroups "") + (delete-matching-lines gnus-ignored-newsgroups)) + (while (re-search-forward + "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) + (goto-char (match-end 1)) + (setq groups (cons (cons (match-string 1) + (max 0 (- (1+ (read cur)) (read cur)))) + groups))))) + (setq groups (sort groups + (lambda (l1 l2) + (string< (car l1) (car l2))))) + (let ((buffer-read-only nil)) + (while groups + (setq group (car groups)) + (insert + (format "K%7d: %s\n" (cdr group) (car group))) + (setq groups (cdr groups)))) + (switch-to-buffer (current-buffer)) + (goto-char (point-min)) + (gnus-group-position-point) + t)))) + + (defun gnus-browse-mode () + "Major mode for browsing a foreign server. + + All normal editing commands are switched off. + + \\ + The only things you can do in this buffer is + + 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. + The group will be inserted into the group buffer upon exit from this + buffer. + + 2) `\\[gnus-browse-read-group]' to read a group ephemerally. + + 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) + (setq mode-name "Browse Server") + (setq mode-line-process nil) + (use-local-map gnus-browse-mode-map) + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t) + (setq buffer-read-only t) + (run-hooks 'gnus-browse-mode-hook)) + + (defun gnus-browse-read-group (&optional no-article) + "Enter the group at the current line." + (interactive) + (let ((group (gnus-browse-group-name))) + (or (gnus-group-read-ephemeral-group + group gnus-browse-current-method nil + (cons (current-buffer) 'browse)) + (error "Couldn't enter %s" group)))) + + (defun gnus-browse-select-group () + "Select the current group." + (interactive) + (gnus-browse-read-group 'no)) + + (defun gnus-browse-next-group (n) + "Go to the next group." + (interactive "p") + (prog1 + (forward-line n) + (gnus-group-position-point))) + + (defun gnus-browse-prev-group (n) + "Go to the next group." + (interactive "p") + (gnus-browse-next-group (- n))) + + (defun gnus-browse-unsubscribe-current-group (arg) + "(Un)subscribe to the next ARG groups." + (interactive "p") + (and (eobp) + (error "No group at current line.")) + (let ((ward (if (< arg 0) -1 1)) + (arg (abs arg))) + (while (and (> arg 0) + (not (eobp)) + (gnus-browse-unsubscribe-group) + (zerop (gnus-browse-next-group ward))) + (setq arg (1- arg))) + (gnus-group-position-point) + (if (/= 0 arg) (gnus-message 7 "No more newsgroups")) + arg)) + + (defun gnus-browse-group-name () + (save-excursion + (beginning-of-line) + (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) + (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method)))) + + (defun gnus-browse-unsubscribe-group () + "Toggle subscription of the current group in the browse buffer." + (let ((sub nil) + (buffer-read-only nil) + group) + (save-excursion + (beginning-of-line) + ;; If this group it killed, then we want to subscribe it. + (if (= (following-char) ?K) (setq sub t)) + (setq group (gnus-browse-group-name)) + (delete-char 1) + (if sub + (progn + (gnus-group-change-level + (list t group gnus-level-default-subscribed + nil nil gnus-browse-current-method) + gnus-level-default-subscribed gnus-level-killed + (and (car (nth 1 gnus-newsrc-alist)) + (gnus-gethash (car (nth 1 gnus-newsrc-alist)) + gnus-newsrc-hashtb)) + t) + (insert ? )) + (gnus-group-change-level + group gnus-level-killed gnus-level-default-subscribed) + (insert ?K))) + t)) + + (defun gnus-browse-exit () + "Quit browsing and return to the group buffer." + (interactive) + (if (eq major-mode 'gnus-browse-mode) + (kill-buffer (current-buffer))) + (if gnus-browse-return-buffer + (gnus-configure-windows 'server 'force) + (gnus-configure-windows 'group 'force) + (gnus-group-list-groups nil))) + + (defun gnus-browse-describe-briefly () + "Give a one line description of the group mode commands." + (interactive) + (gnus-message 6 + (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) + ;;; gnus-srvr.el ends here. *** pub/sgnus/lisp/gnus-topic.el Thu Dec 21 04:09:38 1995 --- sgnus/lisp/gnus-topic.el Tue Jan 16 16:50:14 1996 *************** *** 1,5 **** ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Ilja Weis ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Ilja Weis ;; Lars Magne Ingebrigtsen *************** *** 31,36 **** --- 31,39 ---- (defvar gnus-topic-mode nil "Minor mode for Gnus group buffers.") + (defvar gnus-topic-mode-hook nil + "Hook run in topic mode buffers.") + (defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %a ]%v\n" "Format of topic lines. It works along the same lines as a normal formatting string, *************** *** 55,60 **** --- 58,65 ---- ;; Internal variables. (defvar gnus-topic-killed-topics nil) + (defvar gnus-topic-inhibit-change-level nil) + (defconst gnus-topic-line-format-alist `((?n name ?s) *************** *** 65,70 **** --- 70,77 ---- (?l level ?d))) (defvar gnus-topic-line-format-spec nil) + (defvar gnus-topic-active-topology nil) + (defvar gnus-topic-active-alist nil) ;; Functions. *************** *** 77,82 **** --- 84,90 ---- (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) (defun gnus-topic-init-alist () + "Initialize the topic structures." (setq gnus-topic-topology (cons (list "Gnus" 'visible) (mapcar (lambda (topic) *************** *** 118,133 **** ;; Use topics. (when (< lowest gnus-level-zombie) ! (let (topics topic how) ! ;; The first time we set the topology to whatever we have ! ;; gotten here, which can be rather random. ! (unless gnus-topic-alist ! (gnus-topic-init-alist)) ! ! (if list-topic ! (let ((top (gnus-topic-find-topology list-topic))) ! (gnus-topic-prepare-topic (cdr top) (car top) level all)) ! (gnus-topic-prepare-topic gnus-topic-topology 0 level all))))) (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) --- 126,135 ---- ;; Use topics. (when (< lowest gnus-level-zombie) ! (if list-topic ! (let ((top (gnus-topic-find-topology list-topic))) ! (gnus-topic-prepare-topic (cdr top) (car top) level all)) ! (gnus-topic-prepare-topic gnus-topic-topology 0 level all)))) (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) *************** *** 220,226 **** (let ((topic (gnus-group-topic-name))) (when topic (save-excursion ! (gnus-topic-remove-topic (or insert (not (gnus-topic-visible-p)))))))) (defun gnus-group-topic-p () "Return non-nil if the current line is a topic." --- 222,234 ---- (let ((topic (gnus-group-topic-name))) (when topic (save-excursion ! (if (not (gnus-group-active-topic-p)) ! (gnus-topic-remove-topic ! (or insert (not (gnus-topic-visible-p)))) ! (let ((gnus-topic-topology gnus-topic-active-topology) ! (gnus-topic-alist gnus-topic-active-alist)) ! (gnus-topic-remove-topic ! (or insert (not (gnus-topic-visible-p)))))))))) (defun gnus-group-topic-p () "Return non-nil if the current line is a topic." *************** *** 234,240 **** (let* ((visible (if (and visiblep shownp) "" "...")) (indentation (make-string (* 2 level) ? )) (number-of-articles (gnus-topic-articles-in-topic entries)) ! (number-of-groups (length entries))) (setq gnus-topic-indentation "") (beginning-of-line) ;; Insert the text. --- 242,249 ---- (let* ((visible (if (and visiblep shownp) "" "...")) (indentation (make-string (* 2 level) ? )) (number-of-articles (gnus-topic-articles-in-topic entries)) ! (number-of-groups (length entries)) ! (active-topic (eq gnus-topic-alist gnus-topic-active-alist))) (setq gnus-topic-indentation "") (beginning-of-line) ;; Insert the text. *************** *** 245,250 **** --- 254,260 ---- (gnus-group-remove-excess-properties)) (list 'gnus-topic name 'gnus-topic-level level + 'gnus-active active-topic 'gnus-topic-visible visiblep)))) (defun gnus-topic-previous-topic (topic) *************** *** 290,295 **** --- 300,310 ---- result))) (defun gnus-topic-check-topology () + ;; The first time we set the topology to whatever we have + ;; gotten here, which can be rather random. + (unless gnus-topic-alist + (gnus-topic-init-alist)) + (let ((topics (gnus-topic-list)) (alist gnus-topic-alist) changed) *************** *** 303,309 **** (gnus-topic-enter-dribble))) (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) gnus-topic-alist))) ! (entry (assoc "Gnus" gnus-topic-alist)) (newsrc gnus-newsrc-alist) group) (while newsrc --- 318,324 ---- (gnus-topic-enter-dribble))) (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) gnus-topic-alist))) ! (entry (assoc (caar gnus-topic-topology) gnus-topic-alist)) (newsrc gnus-newsrc-alist) group) (while newsrc *************** *** 379,384 **** --- 394,459 ---- (car type) visiblep (not (eq (nth 2 type) 'hidden)) level entries)))) + (defun gnus-topic-grok-active (&optional force) + "Parse all active groups and create topic structures for them." + ;; First we make sure that we have really read the active file. + (when (or force + (not gnus-topic-active-alist)) + (when (or force + (not gnus-have-read-active-file)) + (let ((gnus-read-active-file t)) + (gnus-read-active-file))) + (let (topology groups alist) + ;; Get a list of all groups available. + (mapatoms (lambda (g) (when (symbol-value g) + (push (symbol-name g) groups))) + gnus-active-hashtb) + (setq groups (sort groups 'string<)) + ;; Init the variables. + (setq gnus-topic-active-topology '(("" visible))) + (setq gnus-topic-active-alist nil) + ;; Descend the top-level hierarchy. + (gnus-topic-grok-active-1 gnus-topic-active-topology groups) + ;; Set the top-level topic names to something nice. + (setcar (car gnus-topic-active-topology) "Gnus active") + (setcar (car gnus-topic-active-alist) "Gnus active")))) + + (defun gnus-topic-grok-active-1 (topology groups) + (let* ((name (caar topology)) + (prefix (concat "^" (regexp-quote name))) + tgroups nprefix ntopology group) + (while (and groups + (string-match prefix (setq group (car groups)))) + (if (not (string-match "\\." group (match-end 0))) + ;; There are no further hierarchies here, so we just + ;; enter this group into the list belonging to this + ;; topic. + (push (pop groups) tgroups) + ;; New sub-hierarchy, so we add it to the topology. + (nconc topology (list (setq ntopology + (list (list (substring + group 0 (match-end 0)) + 'invisible))))) + ;; Descend the hierarchy. + (setq groups (gnus-topic-grok-active-1 ntopology groups)))) + ;; We remove the trailing "." from the topic name. + (setq name + (if (string-match "\\.$" name) + (substring name 0 (match-beginning 0)) + name)) + ;; Add this topic and its groups to the topic alist. + (push (cons name (nreverse tgroups)) gnus-topic-active-alist) + (setcar (car topology) name) + ;; We return the rest of the groups that didn't belong + ;; to this topic. + groups)) + + (defun gnus-group-active-topic-p () + "Return whether the current active comes from the active topics." + (save-excursion + (beginning-of-line) + (get-text-property (point) 'gnus-active))) + ;;; Topic mode, commands and keymap. (defvar gnus-topic-mode-map nil) *************** *** 386,425 **** (unless gnus-topic-mode-map (setq gnus-topic-mode-map (make-sparse-keymap)) - (define-key gnus-topic-mode-map "=" 'gnus-topic-select-group) - (define-key gnus-topic-mode-map "\r" 'gnus-topic-select-group) - (define-key gnus-topic-mode-map " " 'gnus-topic-read-group) - (define-key gnus-topic-mode-map "\C-k" 'gnus-topic-kill-group) - (define-key gnus-topic-mode-map "\C-y" 'gnus-topic-yank-group) - (define-key gnus-topic-mode-map "\M-g" 'gnus-topic-get-new-news-this-topic) - (define-key gnus-topic-mode-map "\C-i" 'gnus-topic-indent) - - (define-prefix-command 'gnus-group-topic-map) - (define-key gnus-group-mode-map "T" 'gnus-group-topic-map) - (define-key gnus-group-topic-map "#" 'gnus-topic-mark-topic) - (define-key gnus-group-topic-map "n" 'gnus-topic-create-topic) - (define-key gnus-group-topic-map "m" 'gnus-topic-move-group) - (define-key gnus-group-topic-map "c" 'gnus-topic-copy-group) - (define-key gnus-group-topic-map "h" 'gnus-topic-hide-topic) - (define-key gnus-group-topic-map "s" 'gnus-topic-show-topic) - (define-key gnus-group-topic-map "M" 'gnus-topic-move-matching) - (define-key gnus-group-topic-map "C" 'gnus-topic-copy-matching) - (define-key gnus-group-topic-map "r" 'gnus-topic-rename) - (define-key gnus-group-topic-map "\177" 'gnus-topic-delete) ! (define-key gnus-topic-mode-map gnus-mouse-2 'gnus-mouse-pick-topic) ! ) - ;;;###autoload (defun gnus-topic-mode (&optional arg redisplay) ! "Minor mode for Gnus group buffers." (interactive (list current-prefix-arg t)) (when (eq major-mode 'gnus-group-mode) (make-local-variable 'gnus-topic-mode) (setq gnus-topic-mode (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) (when gnus-topic-mode (setq gnus-topic-line-format-spec (gnus-parse-format gnus-topic-line-format gnus-topic-line-format-alist t)) --- 461,530 ---- (unless gnus-topic-mode-map (setq gnus-topic-mode-map (make-sparse-keymap)) ! ;; Override certain group mode keys. ! (gnus-define-keys ! gnus-topic-mode-map ! "=" gnus-topic-select-group ! "\r" gnus-topic-select-group ! " " gnus-topic-read-group ! "\C-k" gnus-topic-kill-group ! "\C-y" gnus-topic-yank-group ! "\M-g" gnus-topic-get-new-news-this-topic ! "\C-i" gnus-topic-indent ! "AT" gnus-topic-list-active ! gnus-mouse-2 gnus-mouse-pick-topic) ! ! ;; Define a new submap. ! (gnus-define-keys ! (gnus-group-topic-map "T" gnus-group-mode-map) ! "#" gnus-topic-mark-topic ! "n" gnus-topic-create-topic ! "m" gnus-topic-move-group ! "c" gnus-topic-copy-group ! "h" gnus-topic-hide-topic ! "s" gnus-topic-show-topic ! "M" gnus-topic-move-matching ! "C" gnus-topic-copy-matching ! "r" gnus-topic-rename ! "\177" gnus-topic-delete)) ! ! (defun gnus-topic-make-menu-bar () ! (unless (boundp 'gnus-topic-menu) ! (easy-menu-define ! gnus-topic-menu gnus-topic-mode-map "" ! '("Topics" ! ["Toggle topics" gnus-topic-mode t] ! ("Groups" ! ["Copy" gnus-topic-copy-group t] ! ["Move" gnus-topic-move-group t] ! ["Copy matching" gnus-topic-copy-matching t] ! ["Move matching" gnus-topic-move-matching t]) ! ("Topics" ! ["Show" gnus-topic-show-topic t] ! ["Hide" gnus-topic-hide-topic t] ! ["Delete" gnus-topic-delete t] ! ["Rename" gnus-topic-rename t] ! ["Create" gnus-topic-create-topic t] ! ["Mark" gnus-topic-mark-topic t] ! ["Indent" gnus-topic-indent t]) ! ["List active" gnus-topic-list-active t])))) ! (defun gnus-topic-mode (&optional arg redisplay) ! "Minor mode for topicsifying Gnus group buffers." (interactive (list current-prefix-arg t)) (when (eq major-mode 'gnus-group-mode) (make-local-variable 'gnus-topic-mode) (setq gnus-topic-mode (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) + (make-local-variable 'gnus-group-prepare-function) + ;; 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 gnus-topic-line-format-alist t)) *************** *** 427,441 **** (push '(gnus-topic-mode " Topic") minor-mode-alist)) (unless (assq 'gnus-topic-mode minor-mode-map-alist) (push (cons 'gnus-topic-mode gnus-topic-mode-map) ! minor-mode-map-alist))) ! (make-local-variable 'gnus-group-prepare-function) ! (setq gnus-group-prepare-function ! (if gnus-topic-mode ! 'gnus-group-prepare-topics ! 'gnus-group-prepare-flat)) ! (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) ! ;; We check the topology. ! (gnus-topic-check-topology) (when redisplay (gnus-group-list-groups)))) --- 532,550 ---- (push '(gnus-topic-mode " Topic") minor-mode-alist)) (unless (assq 'gnus-topic-mode minor-mode-map-alist) (push (cons 'gnus-topic-mode gnus-topic-mode-map) ! minor-mode-map-alist)) ! (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) ! (setq gnus-group-prepare-function 'gnus-group-prepare-topics) ! (setq gnus-group-change-level-function 'gnus-topic-change-level) ! (run-hooks 'gnus-topic-mode-hook) ! ;; We check the topology. ! (gnus-topic-check-topology)) ! ;; Remove topic infestation. ! (unless gnus-topic-mode ! (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) ! (remove-hook 'gnus-group-change-level-function ! 'gnus-topic-change-level) ! (setq gnus-group-prepare-function 'gnus-group-prepare-flat)) (when redisplay (gnus-group-list-groups)))) *************** *** 525,530 **** --- 634,655 ---- (completing-read "Copy to topic: " gnus-topic-alist nil t))) (gnus-topic-move-group n topic t)) + (defun gnus-topic-change-level (group level oldlevel) + "Run when changing levels to enter/remove groups from topics." + (when (and gnus-topic-mode + (not gnus-topic-inhibit-change-level)) + ;; Remove the group from the topics. + (when (and (< oldlevel gnus-level-zombie) + (>= level gnus-level-zombie)) + (let (alist) + (when (setq alist (assoc (gnus-group-topic group) gnus-topic-alist)) + (setcdr alist (delete group (cdr alist)))))) + ;; If the group is subscribed. then we enter it into the topics. + (when (and (< level gnus-level-zombie) + (>= oldlevel gnus-level-zombie)) + (let ((entry (assoc (caar gnus-topic-topology) gnus-topic-alist))) + (setcdr entry (cons group (cdr entry))))))) + (defun gnus-topic-kill-group (&optional n discard) "Kill the next N groups." (interactive "P") *************** *** 533,548 **** (gnus-topic-remove-topic nil t) (push (gnus-topic-find-topology topic nil nil gnus-topic-topology) gnus-topic-killed-topics)) ! ;; We first kill the groups the normal way... ! (let ((killed (gnus-group-kill-group n discard)) ! group alist) ! ;; Then we remove the killed groups from the topics they belong to. ! (when (stringp killed) ! (setq killed (list killed))) ! (while killed ! (when (setq alist (assoc (gnus-group-topic (setq group (pop killed))) ! gnus-topic-alist)) ! (setcdr alist (delete group (cdr alist)))))))) (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." --- 658,664 ---- (gnus-topic-remove-topic nil t) (push (gnus-topic-find-topology topic nil nil gnus-topic-topology) gnus-topic-killed-topics)) ! (gnus-group-kill-group n discard))) (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." *************** *** 552,574 **** (item (nth 1 (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic (car item) (gnus-topic-parent-topic previous) previous)) ! ;; We first yank the groups the normal way... ! (let* ((topic (gnus-group-parent-topic)) ! (prev (gnus-group-group-name)) ! (alist (assoc topic gnus-topic-alist)) ! (yanked (gnus-group-yank-group arg)) ! group) ! ;; Then we enter the yanked groups in the topics they belong to. (when (stringp yanked) (setq yanked (list yanked))) (if (not prev) (nconc alist yanked) ! (setq alist (cdr alist)) ! (while (cdr alist) ! (when (equal (car (cdr alist)) prev) (setcdr alist (nconc yanked (cdr alist))) ! (setq alist nil)) ! (setq alist (cdr alist))))))) (defun gnus-topic-hide-topic () "Hide all subtopics under the current topic." --- 668,695 ---- (item (nth 1 (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic (car item) (gnus-topic-parent-topic previous) previous)) ! (let* ((prev (gnus-group-group-name)) ! (gnus-topic-inhibit-change-level t) ! yanked group alist) ! ;; We first yank the groups the normal way... ! (setq yanked (gnus-group-yank-group arg)) ! ;; Then we enter the yanked groups into the topics they belong ! ;; to. ! (setq alist (assoc (save-excursion ! (forward-line -1) ! (gnus-group-parent-topic)) ! gnus-topic-alist)) (when (stringp yanked) (setq yanked (list yanked))) (if (not prev) (nconc alist yanked) ! (if (not (cdr alist)) (setcdr alist (nconc yanked (cdr alist))) ! (while (cdr alist) ! (when (equal (car (cdr alist)) prev) ! (setcdr alist (nconc yanked (cdr alist))) ! (setq alist nil)) ! (setq alist (cdr alist)))))))) (defun gnus-topic-hide-topic () "Hide all subtopics under the current topic." *************** *** 677,682 **** --- 798,812 ---- (gnus-topic-goto-topic topic) (gnus-topic-kill-group) (gnus-topic-create-topic topic grandparent)))) + + (defun gnus-topic-list-active (&optional force) + "List all groups that Gnus knows about in a topicsified fashion. + If FORCE, always re-read the active file." + (interactive "P") + (gnus-topic-grok-active) + (let ((gnus-topic-topology gnus-topic-active-topology) + (gnus-topic-alist gnus-topic-active-alist)) + (gnus-group-list-groups 9 nil 1))) (provide 'gnus-topic) *** pub/sgnus/lisp/gnus-uu.el Thu Dec 21 04:09:39 1995 --- sgnus/lisp/gnus-uu.el Sun Jan 7 11:12:42 1996 *************** *** 1,5 **** ;;; gnus-uu.el --- extract (uu)encoded files in Gnus ! ;; Copyright (C) 1985,86,87,93,94,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 --- 1,5 ---- ;;; gnus-uu.el --- extract (uu)encoded files in Gnus ! ;; Copyright (C) 1985,86,87,93,94,95,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 *************** *** 273,324 **** ;; Keymaps ! (defvar gnus-uu-extract-map nil) ! (defvar gnus-uu-extract-view-map nil) ! (defvar gnus-uu-mark-map nil) ! ! (define-prefix-command 'gnus-uu-mark-map) ! (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map) ! (define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable) ! (define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable) ! (define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable) ! (define-key gnus-uu-mark-map "s" 'gnus-uu-mark-series) ! (define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region) ! (define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp) ! (define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread) ! (define-key gnus-uu-mark-map "T" 'gnus-uu-unmark-thread) ! (define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all) ! (define-key gnus-uu-mark-map "b" 'gnus-uu-mark-buffer) ! (define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse) ! ! (define-prefix-command 'gnus-uu-extract-map) ! (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) ! ;;(define-key gnus-uu-extract-map "x" 'gnus-uu-extract-any) ! ;;(define-key gnus-uu-extract-map "m" 'gnus-uu-extract-mime) ! (define-key gnus-uu-extract-map "u" 'gnus-uu-decode-uu) ! (define-key gnus-uu-extract-map "U" 'gnus-uu-decode-uu-and-save) ! (define-key gnus-uu-extract-map "s" 'gnus-uu-decode-unshar) ! (define-key gnus-uu-extract-map "S" 'gnus-uu-decode-unshar-and-save) ! (define-key gnus-uu-extract-map "o" 'gnus-uu-decode-save) ! (define-key gnus-uu-extract-map "O" 'gnus-uu-decode-save) ! (define-key gnus-uu-extract-map "b" 'gnus-uu-decode-binhex) ! (define-key gnus-uu-extract-map "B" 'gnus-uu-decode-binhex) ! (define-key gnus-uu-extract-map "p" 'gnus-uu-decode-postscript) ! (define-key gnus-uu-extract-map "P" 'gnus-uu-decode-postscript-and-save) ! ! (define-prefix-command 'gnus-uu-extract-view-map) ! (define-key gnus-uu-extract-map "v" 'gnus-uu-extract-view-map) ! (define-key gnus-uu-extract-view-map "u" 'gnus-uu-decode-uu-view) ! (define-key gnus-uu-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view) ! (define-key gnus-uu-extract-view-map "s" 'gnus-uu-decode-unshar-view) ! (define-key gnus-uu-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view) ! (define-key gnus-uu-extract-view-map "o" 'gnus-uu-decode-save-view) ! (define-key gnus-uu-extract-view-map "O" 'gnus-uu-decode-save-view) ! (define-key gnus-uu-extract-view-map "b" 'gnus-uu-decode-binhex-view) ! (define-key gnus-uu-extract-view-map "B" 'gnus-uu-decode-binhex-view) ! (define-key gnus-uu-extract-view-map "p" 'gnus-uu-decode-postscript-view) ! (define-key gnus-uu-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view) ! ;; Commands. --- 273,319 ---- ;; Keymaps ! (gnus-define-keys ! (gnus-uu-mark-map "P" gnus-summary-mark-map) ! "p" gnus-summary-mark-as-processable ! "u" gnus-summary-unmark-as-processable ! "U" gnus-summary-unmark-all-processable ! "s" gnus-uu-mark-series ! "r" gnus-uu-mark-region ! "R" gnus-uu-mark-by-regexp ! "t" gnus-uu-mark-thread ! "T" gnus-uu-unmark-thread ! "a" gnus-uu-mark-all ! "b" gnus-uu-mark-buffer ! "S" gnus-uu-mark-sparse) ! ! (gnus-define-keys ! (gnus-uu-extract-map "X" gnus-summary-mode-map) ! ;;"x" gnus-uu-extract-any ! ;;"m" gnus-uu-extract-mime ! "u" gnus-uu-decode-uu ! "U" gnus-uu-decode-uu-and-save ! "s" gnus-uu-decode-unshar ! "S" gnus-uu-decode-unshar-and-save ! "o" gnus-uu-decode-save ! "O" gnus-uu-decode-save ! "b" gnus-uu-decode-binhex ! "B" gnus-uu-decode-binhex ! "p" gnus-uu-decode-postscript ! "P" gnus-uu-decode-postscript-and-save) ! ! (gnus-define-keys ! (gnus-uu-extract-view-map "v" gnus-uu-extract-map) ! "u" gnus-uu-decode-uu-view ! "U" gnus-uu-decode-uu-and-save-view ! "s" gnus-uu-decode-unshar-view ! "S" gnus-uu-decode-unshar-and-save-view ! "o" gnus-uu-decode-save-view ! "O" gnus-uu-decode-save-view ! "b" gnus-uu-decode-binhex-view ! "B" gnus-uu-decode-binhex-view ! "p" gnus-uu-decode-postscript-view ! "P" gnus-uu-decode-postscript-and-save-view) ;; Commands. *************** *** 492,508 **** ;; Process marking. ! (defun gnus-uu-mark-by-regexp (regexp) "Ask for a regular expression and set the process mark on all articles that match." (interactive (list (read-from-minibuffer "Mark (regexp): "))) (gnus-set-global-variables) (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles ! (gnus-summary-set-process-mark (car articles)) ! (setq articles (cdr articles))) (message "")) (gnus-summary-position-point)) (defun gnus-uu-mark-series () "Mark the current series with the process mark." (interactive) --- 487,509 ---- ;; Process marking. ! (defun gnus-uu-mark-by-regexp (regexp &optional unmark) "Ask for a regular expression and set the process mark on all articles that match." (interactive (list (read-from-minibuffer "Mark (regexp): "))) (gnus-set-global-variables) (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles ! (if unmark ! (gnus-summary-remove-process-mark (pop articles)) ! (gnus-summary-set-process-mark (pop articles)))) (message "")) (gnus-summary-position-point)) + (defun gnus-uu-unmark-by-regexp (regexp &optional unmark) + "Ask for a regular expression and remove the process mark on all articles that match." + (interactive (list (read-from-minibuffer "Mark (regexp): "))) + (gnus-uu-mark-by-regexp regexp t)) + (defun gnus-uu-mark-series () "Mark the current series with the process mark." (interactive) *************** *** 514,535 **** (message "")) (gnus-summary-position-point)) ! (defun gnus-uu-mark-region (beg end) "Set the process mark on all articles between point and mark." (interactive "r") (gnus-set-global-variables) (save-excursion (goto-char beg) (while (< (point) end) ! (gnus-summary-set-process-mark (gnus-summary-article-number)) (forward-line 1))) (gnus-summary-position-point)) (defun gnus-uu-mark-buffer () "Set the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max))) (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) --- 515,548 ---- (message "")) (gnus-summary-position-point)) ! (defun gnus-uu-mark-region (beg end &optional unmark) "Set the process mark on all articles between point and mark." (interactive "r") (gnus-set-global-variables) (save-excursion (goto-char beg) (while (< (point) end) ! (if unmark ! (gnus-summary-remove-process-mark (gnus-summary-article-number)) ! (gnus-summary-set-process-mark (gnus-summary-article-number))) (forward-line 1))) (gnus-summary-position-point)) + (defun gnus-uu-unmark-region (beg end) + "Remove the process mark from all articles between point and mark." + (interactive "r") + (gnus-uu-mark-region beg end t)) + (defun gnus-uu-mark-buffer () "Set the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max))) + (defun gnus-uu-unmark-buffer () + "Remove the process mark on all articles in the buffer." + (interactive) + (gnus-uu-mark-region (point-min) (point-max) t)) + (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) *************** *** 580,592 **** (gnus-set-global-variables) (setq gnus-newsgroup-processable nil) (save-excursion ! (goto-char (point-min)) ! (let (number) ! (while (and (not (eobp)) ! (setq number (gnus-summary-article-number))) ! (if (not (memq number gnus-newsgroup-processable)) ! (save-excursion (gnus-uu-mark-series))) ! (forward-line 1)))) (gnus-summary-position-point)) ;; All PostScript functions written by Erik Selberg . --- 593,606 ---- (gnus-set-global-variables) (setq gnus-newsgroup-processable nil) (save-excursion ! (let ((data gnus-newsgroup-data) ! number) ! (while data ! (unless (memq (setq number (gnus-data-number (car data))) ! gnus-newsgroup-processable) ! (gnus-summary-goto-subject number) ! (gnus-uu-mark-series)) ! (setq data (cdr data))))) (gnus-summary-position-point)) ;; All PostScript functions written by Erik Selberg . *** pub/sgnus/lisp/gnus-vis.el Thu Dec 21 04:09:41 1995 --- sgnus/lisp/gnus-vis.el Fri Jan 12 12:59:36 1996 *************** *** 1,5 **** ;;; gnus-vis.el --- display-oriented parts of Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Per Abrahamsen --- 1,5 ---- ;;; gnus-vis.el --- display-oriented parts of Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Per Abrahamsen *************** *** 41,52 **** (defvar gnus-article-menu-hook nil "*Hook run after the creation of the article mode menu.") - (defvar gnus-server-menu-hook nil - "*Hook run after the creation of the server mode menu.") - - (defvar gnus-browse-menu-hook nil - "*Hook run after the creation of the browse mode menu.") - ;;; Summary highlights. ;(defvar gnus-summary-highlight-properties --- 41,46 ---- *************** *** 217,226 **** (defvar gnus-button-alist `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 ! (let ((lines (count-lines (point-min) (match-end 0)))) ! (or (assq lines gnus-cite-attribution-alist) ! (assq (1+ lines) gnus-cite-attribution-alist))) ! gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. --- 211,217 ---- (defvar gnus-button-alist `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 ! t gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. *************** *** 228,235 **** (,gnus-button-url-regexp 0 t gnus-button-url 0) ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t gnus-button-message-id 3) ! ("\\(?" 0 t gnus-button-reply 2) ! ) "Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where --- 219,225 ---- (,gnus-button-url-regexp 0 t gnus-button-url 0) ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t gnus-button-message-id 3) ! ("\\(?" 0 t gnus-button-reply 2)) "Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where *************** *** 264,269 **** --- 254,263 ---- ;(eval-when-compile ; (defvar browse-url-browser-function)) + ;;; Internal variables. + + (defvar gnus-button-marker-list nil) + (eval-and-compile *************** *** 290,296 **** '("Group" ["Read" gnus-group-read-group t] ["Select" gnus-group-select-group t] ! ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC" ] ["Catch up" gnus-group-catchup-current t] ["Catch up all articles" gnus-group-catchup-current-all t] ["Check for new articles" gnus-group-get-new-news-this-group t] --- 284,290 ---- '("Group" ["Read" gnus-group-read-group t] ["Select" gnus-group-select-group t] ! ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC"] ["Catch up" gnus-group-catchup-current t] ["Catch up all articles" gnus-group-catchup-current-all t] ["Check for new articles" gnus-group-get-new-news-this-group t] *************** *** 314,332 **** ["List groups matching..." gnus-group-list-matching t] ["List killed groups" gnus-group-list-killed t] ["List zombie groups" gnus-group-list-zombies t] ["Describe all groups" gnus-group-describe-all-groups t] ["Group apropos" gnus-group-apropos t] ["Group and description apropos" gnus-group-description-apropos t] ["List groups matching..." gnus-group-list-matching t] ["List active file" gnus-group-list-active t]) ("Mark" ["Mark group" gnus-group-mark-group t] ["Unmark group" gnus-group-unmark-group t] ! ["Mark region" gnus-group-mark-region t]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ! ["Kill all zombie groups" gnus-group-kill-all-zombies t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] ["Add a directory group" gnus-group-make-directory-group t] --- 308,340 ---- ["List groups matching..." gnus-group-list-matching t] ["List killed groups" gnus-group-list-killed t] ["List zombie groups" gnus-group-list-zombies t] + ["List level" gnus-group-list-level t] ["Describe all groups" gnus-group-describe-all-groups t] ["Group apropos" gnus-group-apropos t] ["Group and description apropos" gnus-group-description-apropos t] ["List groups matching..." gnus-group-list-matching t] + ["List all groups matching..." gnus-group-list-all-matching t] ["List active file" gnus-group-list-active t]) + ("Sort" + ["Default sort" gnus-group-sort-groups t] + ["Sort by method" gnus-group-sort-by-method t] + ["Sort by rank" gnus-group-sort-by-rank t] + ["Sort by score" gnus-group-sort-by-score t] + ["Sort by level" gnus-group-sort-by-level t] + ["Sort by unread" gnus-group-sort-by-unread t] + ["Sort by name" gnus-group-sort-by-alphabet t]) ("Mark" ["Mark group" gnus-group-mark-group t] ["Unmark group" gnus-group-unmark-group t] ! ["Unmark all" gnus-group-unmark-all-groups t] ! ["Mark regexp" gnus-group-mark-regexp t] ! ["Mark region" gnus-group-mark-region t] ! ["Execute command" gnus-group-universal-argument t]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ! ["Kill all zombie groups" gnus-group-kill-all-zombies t] ! ["Kill all groups on level..." gnus-group-kill-level t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] ["Add a directory group" gnus-group-make-directory-group t] *************** *** 344,352 **** ["Info" gnus-group-edit-group t]) ("Score file" ["Flush cache" gnus-score-flush-cache t]) ["Read a directory as a group" gnus-group-enter-directory t] - ["Jump to group" gnus-group-jump-to-group t] - ["Best unread group" gnus-group-best-unread-group t] )) (easy-menu-define --- 352,370 ---- ["Info" gnus-group-edit-group t]) ("Score file" ["Flush cache" gnus-score-flush-cache t]) + ("Move" + ["Next" gnus-group-next-group t] + ["Previous" gnus-group-prev-group t] + ["Next unread" gnus-group-next-unread-group t] + ["Previous unread" gnus-group-prev-unread-group t] + ["Next unread same level" gnus-group-next-unread-group-same-level t] + ["Previous unread same level" + gnus-group-previous-unread-group-same-level t] + ["Jump to group" gnus-group-jump-to-group t] + ["First unread group" gnus-group-first-unread-group t] + ["Best unread group" gnus-group-best-unread-group t]) + ["Transpose" gnus-group-transpose-groups t] ["Read a directory as a group" gnus-group-enter-directory t] )) (easy-menu-define *************** *** 358,363 **** --- 376,382 ---- ["Customize score file" gnus-score-customize (not (string-match "XEmacs" emacs-version)) ] ["Check for new news" gnus-group-get-new-news t] + ["Activate all groups" gnus-activate-all-groups t] ["Delete bogus groups" gnus-group-check-bogus-groups t] ["Find new newsgroups" gnus-find-new-newsgroups t] ["Restart Gnus" gnus-group-restart t] *************** *** 373,752 **** ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] ["Edit global kill file" gnus-group-edit-global-kill t] ! ["Sort group buffer" gnus-group-sort-groups t] )) (run-hooks 'gnus-group-menu-hook) ))) - (defvar gnus-server-mode-map) - - ;; Server mode - (defun gnus-server-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'server) - (or - (boundp 'gnus-server-menu) - (progn - (easy-menu-define - gnus-server-menu gnus-server-mode-map "" - '("Server" - ["Add" gnus-server-add-server t] - ["Browse" gnus-server-read-server t] - ["List" gnus-server-list-servers t] - ["Kill" gnus-server-kill-server t] - ["Yank" gnus-server-yank-server t] - ["Copy" gnus-server-copy-server t] - ["Edit" gnus-server-edit-server t] - ["Exit" gnus-server-exit t] - )) - - (easy-menu-define - gnus-server-menu gnus-server-mode-map "" - '("Connections" - ["Open" gnus-server-open-server t] - ["Close" gnus-server-close-server t] - ["Deny" gnus-server-deny-servers t] - ["Reset" gnus-server-remove-denials t] - )) - - (run-hooks 'gnus-server-menu-hook)))) - - ;; Browse mode - (defun gnus-browse-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'browse) - (or - (boundp 'gnus-browse-menu) - (progn - (easy-menu-define - gnus-browse-menu gnus-browse-mode-map "" - '("Browse" - ["Subscribe" gnus-browse-unsubscribe-current-group t] - ["Read" gnus-group-read-group t] - ["Exit" gnus-browse-exit t] - )) - (run-hooks 'gnus-browse-menu-hook)))) - - ;; Summary buffer (defun gnus-summary-make-menu-bar () (gnus-visual-turn-off-edit-menu 'summary) ! (or ! (boundp 'gnus-summary-misc-menu) ! (progn ! (easy-menu-define ! gnus-summary-misc-menu gnus-summary-mode-map "" ! '("Misc" ! ("Mark" ! ("Read" ! ["Mark as read" gnus-summary-mark-as-read-forward t] ! ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ! ["Mark same subject" gnus-summary-kill-same-subject t] ! ["Catchup" gnus-summary-catchup t] ! ["Catchup all" gnus-summary-catchup-all t] ! ["Catchup to here" gnus-summary-catchup-to-here t] ! ["Catchup region" gnus-summary-mark-region-as-read t]) ! ("Various" ! ["Tick" gnus-summary-tick-article-forward t] ! ["Mark as dormant" gnus-summary-mark-as-dormant t] ! ["Remove marks" gnus-summary-clear-mark-forward t] ! ["Set expirable mark" gnus-summary-mark-as-expirable t] ! ["Set bookmark" gnus-summary-set-bookmark t] ! ["Remove bookmark" gnus-summary-remove-bookmark t]) ! ("Limit" ! ["Unread" gnus-summary-limit-to-unread t] ! ["Marks" gnus-summary-limit-to-marks t] ! ["Score" gnus-summary-limit-to-score t] ! ["Subject" gnus-summary-limit-to-subject t] ! ["Non-dormant" gnus-summary-limit-exclude-dormant t] ! ["Articles" gnus-summary-limit-to-articles t] ! ["Pop limit" gnus-summary-pop-limit t] ! ["Show dormant" gnus-summary-limit-include-dormant t] ! ["Show expunged" gnus-summary-show-all-expunged t]) ! ("Process mark" ! ["Set mark" gnus-summary-mark-as-processable t] ! ["Remove mark" gnus-summary-unmark-as-processable t] ! ["Remove all marks" gnus-summary-unmark-all-processable t] ! ["Mark series" gnus-uu-mark-series t] ! ["Mark region" gnus-uu-mark-region t] ! ["Mark by regexp" gnus-uu-mark-by-regexp t] ! ["Mark all" gnus-uu-mark-all t] ! ["Mark buffer" gnus-uu-mark-buffer t] ! ["Mark sparse" gnus-uu-mark-sparse t] ! ["Mark thread" gnus-uu-mark-thread t] ! ["Unmark thread" gnus-uu-unmark-thread t])) ! ("Move" ! ["Scroll article forwards" gnus-summary-next-page t] ! ["Next unread article" gnus-summary-next-unread-article t] ! ["Previous unread article" gnus-summary-prev-unread-article t] ! ["Next article" gnus-summary-next-article t] ! ["Previous article" gnus-summary-prev-article t] ! ["Next article same subject" gnus-summary-next-same-subject t] ! ["Previous article same subject" gnus-summary-prev-same-subject t] ! ["First unread article" gnus-summary-first-unread-article t] ! ["Go to subject number..." gnus-summary-goto-subject t] ! ["Go to the last article" gnus-summary-goto-last-article t] ! ["Pop article off history" gnus-summary-pop-article t]) ! ("Sort" ! ["Sort by number" gnus-summary-sort-by-number t] ! ["Sort by author" gnus-summary-sort-by-author t] ! ["Sort by subject" gnus-summary-sort-by-subject t] ! ["Sort by date" gnus-summary-sort-by-date t] ! ["Sort by score" gnus-summary-sort-by-score t]) ! ("Exit" ! ["Catchup and exit" gnus-summary-catchup-and-exit t] ! ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ! ["Exit group" gnus-summary-exit t] ! ["Exit group without updating" gnus-summary-exit-no-update t] ! ["Reselect group" gnus-summary-reselect-current-group t] ! ["Rescan group" gnus-summary-rescan-group t]) ["Fetch group FAQ" gnus-summary-fetch-faq t] - ["Filter articles" gnus-summary-execute-command t] - ["Toggle line truncation" gnus-summary-toggle-truncation t] - ["Expire expirable articles" gnus-summary-expire-articles t] ["Describe group" gnus-summary-describe-group t] ! ["Edit local kill file" gnus-summary-edit-local-kill t] ! )) ! ! (easy-menu-define ! gnus-summary-kill-menu gnus-summary-mode-map "" ! (cons ! "Score" ! (nconc ! (list ! ["Enter score" gnus-summary-score-entry t]) ! (gnus-visual-score-map 'increase) ! (gnus-visual-score-map 'lower) ! '(["Current score" gnus-summary-current-score t] ! ["Set score" gnus-summary-set-score t] ! ["Customize score file" gnus-score-customize t] ! ["Switch current score file" gnus-score-change-score-file t] ! ["Set mark below" gnus-score-set-mark-below t] ! ["Set expunge below" gnus-score-set-expunge-below t] ! ["Edit current score file" gnus-score-edit-alist t] ! ["Edit score file" gnus-score-edit-file t] ! ["Trace score" gnus-score-find-trace t] ! ["Increase score" gnus-summary-increase-score t] ! ["Lower score" gnus-summary-lower-score t])))) ! ! (and nil ! '(("Default header" ! ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) ! :style radio ! :selected (null gnus-score-default-header)] ! ["From" (gnus-score-set-default 'gnus-score-default-header 'a) ! :style radio ! :selected (eq gnus-score-default-header 'a )] ! ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) ! :style radio ! :selected (eq gnus-score-default-header 's )] ! ["Article body" ! (gnus-score-set-default 'gnus-score-default-header 'b) ! :style radio ! :selected (eq gnus-score-default-header 'b )] ! ["All headers" ! (gnus-score-set-default 'gnus-score-default-header 'h) ! :style radio ! :selected (eq gnus-score-default-header 'h )] ! ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i) ! :style radio ! :selected (eq gnus-score-default-header 'i )] ! ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) ! :style radio ! :selected (eq gnus-score-default-header 't )] ! ["Crossposting" ! (gnus-score-set-default 'gnus-score-default-header 'x) ! :style radio ! :selected (eq gnus-score-default-header 'x )] ! ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) ! :style radio ! :selected (eq gnus-score-default-header 'l )] ! ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) ! :style radio ! :selected (eq gnus-score-default-header 'd )] ! ["Followups to author" ! (gnus-score-set-default 'gnus-score-default-header 'f) ! :style radio ! :selected (eq gnus-score-default-header 'f )]) ! ("Default type" ! ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) ! :style radio ! :selected (null gnus-score-default-type)] ! ;; The `:active' key is commented out in the following, ! ;; because the GNU Emacs hack to support radio buttons use ! ;; active to indicate which button is selected. ! ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 's)] ! ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'r)] ! ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'e)] ! ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'f)] ! ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) ! :style radio ! ;; :active (eq (gnus-score-default-header 'd)) ! :selected (eq gnus-score-default-type 'b)] ! ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) ! :style radio ! ;; :active (eq (gnus-score-default-header 'd)) ! :selected (eq gnus-score-default-type 'n)] ! ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) ! :style radio ! ;; :active (eq (gnus-score-default-header 'd)) ! :selected (eq gnus-score-default-type 'a)] ! ["Less than number" ! (gnus-score-set-default 'gnus-score-default-type '<) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '<)] ! ["Equal to number" ! (gnus-score-set-default 'gnus-score-default-type '=) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '=)] ! ["Greater than number" ! (gnus-score-set-default 'gnus-score-default-type '>) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '>)]) ! ["Default fold" gnus-score-default-fold-toggle ! :style toggle ! :selected gnus-score-default-fold] ! ("Default duration" ! ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) ! :style radio ! :selected (null gnus-score-default-duration)] ! ["Permanent" ! (gnus-score-set-default 'gnus-score-default-duration 'p) ! :style radio ! :selected (eq gnus-score-default-duration 'p)] ! ["Temporary" ! (gnus-score-set-default 'gnus-score-default-duration 't) ! :style radio ! :selected (eq gnus-score-default-duration 't)] ! ["Immediate" ! (gnus-score-set-default 'gnus-score-default-duration 'i) ! :style radio ! :selected (eq gnus-score-default-duration 'i)]) ! )) ! ! (easy-menu-define ! gnus-summary-article-menu gnus-summary-mode-map "" ! '("Article" ! ("Hide" ! ["All" gnus-article-hide t] ! ["Headers" gnus-article-hide-headers t] ! ["Signature" gnus-article-hide-signature t] ! ["Citation" gnus-article-hide-citation t] ! ["PGP" gnus-article-hide-pgp t]) ! ("Highlight" ! ["All" gnus-article-highlight t] ! ["Headers" gnus-article-highlight-headers t] ! ["Signature" gnus-article-highlight-signature t] ! ["Citation" gnus-article-highlight-citation t]) ! ("Date" ! ["Local" gnus-article-date-local t] ! ["UT" gnus-article-date-ut t] ! ["Original" gnus-article-date-original t] ! ["Lapsed" gnus-article-date-lapsed t]) ! ("Filter" ! ["Overstrike" gnus-article-treat-overstrike t] ! ["Word wrap" gnus-article-word-wrap t] ! ["CR" gnus-article-remove-cr t] ! ["Show X-Face" gnus-article-display-x-face t] ! ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ! ["Rot 13" gnus-summary-caesar-message t] ! ["Add buttons" gnus-article-add-buttons t] ! ["Add buttons to head" gnus-article-add-buttons-to-head t] ! ["Stop page breaking" gnus-summary-stop-page-breaking t] ! ["Toggle MIME" gnus-summary-toggle-mime t] ! ["Toggle header" gnus-summary-toggle-header t]) ! ("Output" ! ["Save in default format" gnus-summary-save-article t] ! ["Save in file" gnus-summary-save-article-file t] ! ["Save in Unix mail format" gnus-summary-save-article-mail t] ! ["Save in MH folder" gnus-summary-save-article-folder t] ! ["Save in VM folder" gnus-summary-save-article-vm t] ! ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] ! ["Save body in file" gnus-summary-save-article-body-file t] ! ["Pipe through a filter" gnus-summary-pipe-output t]) ! ("Backend" ! ["Respool article" gnus-summary-respool-article t] ! ["Move article" gnus-summary-move-article t] ! ["Copy article" gnus-summary-copy-article t] ! ["Import file" gnus-summary-import-article t] ! ["Edit article" gnus-summary-edit-article t] ! ["Delete article" gnus-summary-delete-article t]) ! ("Extract" ! ["Uudecode" gnus-uu-decode-uu t] ! ["Uudecode and save" gnus-uu-decode-uu-and-save t] ! ["Unshar" gnus-uu-decode-unshar t] ! ["Unshar and save" gnus-uu-decode-unshar-and-save t] ! ["Save" gnus-uu-decode-save t] ! ["Binhex" gnus-uu-decode-binhex t]) ! ["Enter digest buffer" gnus-summary-enter-digest-group t] ! ["Isearch article" gnus-summary-isearch-article t] ! ["Search all articles" gnus-summary-search-article-forward t] ! ["Beginning of the article" gnus-summary-beginning-of-article t] ! ["End of the article" gnus-summary-end-of-article t] ! ["Fetch parent of article" gnus-summary-refer-parent-article t] ! ["Fetch referenced articles" gnus-summary-refer-references t] ! ["Fetch article with id..." gnus-summary-refer-article t] ! ["Redisplay" gnus-summary-show-article t])) ! (easy-menu-define ! gnus-summary-thread-menu gnus-summary-mode-map "" ! '("Threads" ! ["Toggle threading" gnus-summary-toggle-threads t] ! ["Display hidden thread" gnus-summary-show-thread t] ! ["Hide thread" gnus-summary-hide-thread t] ! ["Go to next thread" gnus-summary-next-thread t] ! ["Go to previous thread" gnus-summary-prev-thread t] ! ["Go down thread" gnus-summary-down-thread t] ! ["Go up thread" gnus-summary-up-thread t] ! ["Mark thread as read" gnus-summary-kill-thread t] ! ["Lower thread score" gnus-summary-lower-thread t] ! ["Raise thread score" gnus-summary-raise-thread t] ! )) ! ! (easy-menu-define ! gnus-summary-post-menu gnus-summary-mode-map "" ! '("Post" ! ["Post an article" gnus-summary-post-news t] ! ["Followup" gnus-summary-followup t] ! ["Followup and yank" gnus-summary-followup-with-original t] ! ["Supersede article" gnus-summary-supersede-article t] ! ["Cancel article" gnus-summary-cancel-article t] ! ["Reply" gnus-summary-reply t] ! ["Reply and yank" gnus-summary-reply-with-original t] ! ["Mail forward" gnus-summary-mail-forward t] ! ["Post forward" gnus-summary-post-forward t] ! ["Digest and mail" gnus-uu-digest-mail-forward t] ! ["Digest and post" gnus-uu-digest-post-forward t] ! ["Send a mail" gnus-summary-mail-other-window t] ! ["Reply & followup" gnus-summary-followup-and-reply t] ! ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] ! ["Uuencode and post" gnus-uu-post-news t] ! ("Draft" ! ["Send" gnus-summary-send-draft t] ! ["Send bounced" gnus-resend-bounced-mail t]) ! )) ! (run-hooks 'gnus-summary-menu-hook) ! ))) (defun gnus-score-set-default (var value) ! ;; A version of set that updates the GNU Emacs menu-bar. (set var value) ;; It is the message that forces the active status to be updated. (message "")) --- 392,774 ---- ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] ["Edit global kill file" gnus-group-edit-global-kill t] ! ["Read manual" gnus-info-find-node t] ! ["Toggle topics" gnus-topic-mode t] ! ("SOUP" ! ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] ! ["Send replies" gnus-soup-send-replies ! (fboundp 'gnus-soup-pack-packet)] ! ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] ! ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] ! ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) )) (run-hooks 'gnus-group-menu-hook) ))) ;; Summary buffer (defun gnus-summary-make-menu-bar () (gnus-visual-turn-off-edit-menu 'summary) ! (unless (boundp 'gnus-summary-misc-menu) ! (easy-menu-define ! gnus-summary-misc-menu gnus-summary-mode-map "" ! '("Misc" ! ("Mark" ! ("Read" ! ["Mark as read" gnus-summary-mark-as-read-forward t] ! ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ! ["Mark same subject" gnus-summary-kill-same-subject t] ! ["Catchup" gnus-summary-catchup t] ! ["Catchup all" gnus-summary-catchup-all t] ! ["Catchup to here" gnus-summary-catchup-to-here t] ! ["Catchup region" gnus-summary-mark-region-as-read t] ! ["Mark excluded" gnus-summary-limit-mark-exlcuded-as-read t]) ! ("Various" ! ["Tick" gnus-summary-tick-article-forward t] ! ["Mark as dormant" gnus-summary-mark-as-dormant t] ! ["Remove marks" gnus-summary-clear-mark-forward t] ! ["Set expirable mark" gnus-summary-mark-as-expirable t] ! ["Set bookmark" gnus-summary-set-bookmark t] ! ["Remove bookmark" gnus-summary-remove-bookmark t]) ! ("Limit" ! ["Unread" gnus-summary-limit-to-unread t] ! ["Marks" gnus-summary-limit-to-marks t] ! ["Score" gnus-summary-limit-to-score t] ! ["Subject" gnus-summary-limit-to-subject t] ! ["Author" gnus-summary-limit-to-author t] ! ["Non-dormant" gnus-summary-limit-exclude-dormant t] ! ["Articles" gnus-summary-limit-to-articles t] ! ["Pop limit" gnus-summary-pop-limit t] ! ["Show dormant" gnus-summary-limit-include-dormant t] ! ["Hide childless dormant" ! gnus-summary-limit-exclude-childless-dormant t] ! ["Hide thread" gnus-summary-limit-exclude-thread t] ! ["Show expunged" gnus-summary-show-all-expunged t]) ! ("Process mark" ! ["Set mark" gnus-summary-mark-as-processable t] ! ["Remove mark" gnus-summary-unmark-as-processable t] ! ["Remove all marks" gnus-summary-unmark-all-processable t] ! ["Mark series" gnus-uu-mark-series t] ! ["Mark region" gnus-uu-mark-region t] ! ["Mark by regexp" gnus-uu-mark-by-regexp t] ! ["Mark all" gnus-uu-mark-all t] ! ["Mark buffer" gnus-uu-mark-buffer t] ! ["Mark sparse" gnus-uu-mark-sparse t] ! ["Mark thread" gnus-uu-mark-thread t] ! ["Unmark thread" gnus-uu-unmark-thread t])) ! ("Scroll article" ! ["Page forward" gnus-summary-next-page t] ! ["Page backward" gnus-summary-prev-page t] ! ["Line forward" gnus-summary-scroll-up t]) ! ("Move" ! ["Next unread article" gnus-summary-next-unread-article t] ! ["Previous unread article" gnus-summary-prev-unread-article t] ! ["Next article" gnus-summary-next-article t] ! ["Previous article" gnus-summary-prev-article t] ! ["Next unread subject" gnus-summary-next-unread-subject t] ! ["Previous unread subject" gnus-summary-prev-unread-subject t] ! ["Next article same subject" gnus-summary-next-same-subject t] ! ["Previous article same subject" gnus-summary-prev-same-subject t] ! ["First unread article" gnus-summary-first-unread-article t] ! ["Best unread article" gnus-summary-best-unread-article t] ! ["Go to subject number..." gnus-summary-goto-subject t] ! ["Go to article number..." gnus-summary-goto-article t] ! ["Go to the last article" gnus-summary-goto-last-article t] ! ["Pop article off history" gnus-summary-pop-article t]) ! ("Sort" ! ["Sort by number" gnus-summary-sort-by-number t] ! ["Sort by author" gnus-summary-sort-by-author t] ! ["Sort by subject" gnus-summary-sort-by-subject t] ! ["Sort by date" gnus-summary-sort-by-date t] ! ["Sort by score" gnus-summary-sort-by-score t]) ! ("Exit" ! ["Catchup and exit" gnus-summary-catchup-and-exit t] ! ["Catchup all and exit" gnus-summary-catchup-and-exit t] ! ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ! ["Exit group" gnus-summary-exit t] ! ["Exit group without updating" gnus-summary-exit-no-update t] ! ["Exit and goto next group" gnus-summary-next-group t] ! ["Exit and goto prev group" gnus-summary-prev-group t] ! ["Reselect group" gnus-summary-reselect-current-group t] ! ["Rescan group" gnus-summary-rescan-group t]) ! ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] ! ["Read manual" gnus-info-find-node t]) ! ("Cache" ! ["Enter article" gnus-cache-enter-article t] ! ["Remove article" gnus-cache-remove-article t]) ! ("Modes" ! ["Pick and read" gnus-pick-mode t] ! ["Binary" gnus-binary-mode t]) ! ["Filter articles" gnus-summary-execute-command t] ! ["Run command on subjects" gnus-summary-universal-argument t] ! ["Toggle line truncation" gnus-summary-toggle-truncation t] ! ["Expand window" gnus-summary-expand-window t] ! ["Expire expirable articles" gnus-summary-expire-articles t] ! ["Edit local kill file" gnus-summary-edit-local-kill t] ! ["Edit main kill file" gnus-summary-edit-global-kill t] ! )) ! ! (easy-menu-define ! gnus-summary-kill-menu gnus-summary-mode-map "" ! (cons ! "Score" ! (nconc ! (list ! ["Enter score" gnus-summary-score-entry t]) ! (gnus-visual-score-map 'increase) ! (gnus-visual-score-map 'lower) ! '(("Mark" ! ["Kill below" gnus-summary-kill-below t] ! ["Mark above" gnus-summary-mark-above t] ! ["Tick above" gnus-summary-tick-above t] ! ["Clear above" gnus-summary-clear-above t]) ! ["Current score" gnus-summary-current-score t] ! ["Set score" gnus-summary-set-score t] ! ["Customize score file" gnus-score-customize t] ! ["Switch current score file" gnus-score-change-score-file t] ! ["Set mark below" gnus-score-set-mark-below t] ! ["Set expunge below" gnus-score-set-expunge-below t] ! ["Edit current score file" gnus-score-edit-alist t] ! ["Edit score file" gnus-score-edit-file t] ! ["Trace score" gnus-score-find-trace t] ! ["Rescore buffer" gnus-summary-rescore t] ! ["Increase score" gnus-summary-increase-score t] ! ["Lower score" gnus-summary-lower-score t])))) ! ! '(("Default header" ! ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) ! :style radio ! :selected (null gnus-score-default-header)] ! ["From" (gnus-score-set-default 'gnus-score-default-header 'a) ! :style radio ! :selected (eq gnus-score-default-header 'a )] ! ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) ! :style radio ! :selected (eq gnus-score-default-header 's )] ! ["Article body" ! (gnus-score-set-default 'gnus-score-default-header 'b) ! :style radio ! :selected (eq gnus-score-default-header 'b )] ! ["All headers" ! (gnus-score-set-default 'gnus-score-default-header 'h) ! :style radio ! :selected (eq gnus-score-default-header 'h )] ! ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i) ! :style radio ! :selected (eq gnus-score-default-header 'i )] ! ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) ! :style radio ! :selected (eq gnus-score-default-header 't )] ! ["Crossposting" ! (gnus-score-set-default 'gnus-score-default-header 'x) ! :style radio ! :selected (eq gnus-score-default-header 'x )] ! ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) ! :style radio ! :selected (eq gnus-score-default-header 'l )] ! ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) ! :style radio ! :selected (eq gnus-score-default-header 'd )] ! ["Followups to author" ! (gnus-score-set-default 'gnus-score-default-header 'f) ! :style radio ! :selected (eq gnus-score-default-header 'f )]) ! ("Default type" ! ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) ! :style radio ! :selected (null gnus-score-default-type)] ! ;; The `:active' key is commented out in the following, ! ;; because the GNU Emacs hack to support radio buttons use ! ;; active to indicate which button is selected. ! ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 's)] ! ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'r)] ! ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'e)] ! ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'f)] ! ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) ! :style radio ! ;; :active (eq (gnus-score-default-header 'd)) ! :selected (eq gnus-score-default-type 'b)] ! ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) ! :style radio ! ;; :active (eq (gnus-score-default-header 'd)) ! :selected (eq gnus-score-default-type 'n)] ! ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) ! :style radio ! ;; :active (eq (gnus-score-default-header 'd)) ! :selected (eq gnus-score-default-type 'a)] ! ["Less than number" ! (gnus-score-set-default 'gnus-score-default-type '<) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '<)] ! ["Equal to number" ! (gnus-score-set-default 'gnus-score-default-type '=) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '=)] ! ["Greater than number" ! (gnus-score-set-default 'gnus-score-default-type '>) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '>)]) ! ["Default fold" gnus-score-default-fold-toggle ! :style toggle ! :selected gnus-score-default-fold] ! ("Default duration" ! ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) ! :style radio ! :selected (null gnus-score-default-duration)] ! ["Permanent" ! (gnus-score-set-default 'gnus-score-default-duration 'p) ! :style radio ! :selected (eq gnus-score-default-duration 'p)] ! ["Temporary" ! (gnus-score-set-default 'gnus-score-default-duration 't) ! :style radio ! :selected (eq gnus-score-default-duration 't)] ! ["Immediate" ! (gnus-score-set-default 'gnus-score-default-duration 'i) ! :style radio ! :selected (eq gnus-score-default-duration 'i)])) ! ! (easy-menu-define ! gnus-summary-article-menu gnus-summary-mode-map "" ! '("Article" ! ("Hide" ! ["All" gnus-article-hide t] ! ["Headers" gnus-article-hide-headers t] ! ["Signature" gnus-article-hide-signature t] ! ["Citation" gnus-article-hide-citation t] ! ["PGP" gnus-article-hide-pgp t] ! ["Boring headers" gnus-article-hide-boring-headers t]) ! ("Highlight" ! ["All" gnus-article-highlight t] ! ["Headers" gnus-article-highlight-headers t] ! ["Signature" gnus-article-highlight-signature t] ! ["Citation" gnus-article-highlight-citation t]) ! ("Date" ! ["Local" gnus-article-date-local t] ! ["UT" gnus-article-date-ut t] ! ["Original" gnus-article-date-original t] ! ["Lapsed" gnus-article-date-lapsed t]) ! ("Filter" ! ["Overstrike" gnus-article-treat-overstrike t] ! ["Word wrap" gnus-article-fill-cited-article t] ! ["CR" gnus-article-remove-cr t] ! ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t] ! ["Show X-Face" gnus-article-display-x-face t] ! ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ! ["Rot 13" gnus-summary-caesar-message t] ! ["Add buttons" gnus-article-add-buttons t] ! ["Add buttons to head" gnus-article-add-buttons-to-head t] ! ["Stop page breaking" gnus-summary-stop-page-breaking t] ! ["Toggle MIME" gnus-summary-toggle-mime t] ! ["Verbose header" gnus-summary-verbose-headers t] ! ["Toggle header" gnus-summary-toggle-header t]) ! ("Output" ! ["Save in default format" gnus-summary-save-article t] ! ["Save in file" gnus-summary-save-article-file t] ! ["Save in Unix mail format" gnus-summary-save-article-mail t] ! ["Save in MH folder" gnus-summary-save-article-folder t] ! ["Save in VM folder" gnus-summary-save-article-vm t] ! ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] ! ["Save body in file" gnus-summary-save-article-body-file t] ! ["Pipe through a filter" gnus-summary-pipe-output t] ! ["Add to SOUP packet" gnus-soup-add-article t]) ! ("Backend" ! ["Respool article" gnus-summary-respool-article t] ! ["Move article" gnus-summary-move-article t] ! ["Copy article" gnus-summary-copy-article t] ! ["Crosspost article" gnus-summary-crosspost-article t] ! ["Import file" gnus-summary-import-article t] ! ["Edit article" gnus-summary-edit-article t] ! ["Delete article" gnus-summary-delete-article t] ! ["Query respool" gnus-summary-respool-query t] ! ["Delete expirable articles" gnus-summary-expire-articles-now t]) ! ("Extract" ! ["Uudecode" gnus-uu-decode-uu t] ! ["Uudecode and save" gnus-uu-decode-uu-and-save t] ! ["Unshar" gnus-uu-decode-unshar t] ! ["Unshar and save" gnus-uu-decode-unshar-and-save t] ! ["Save" gnus-uu-decode-save t] ! ["Binhex" gnus-uu-decode-binhex t] ! ["Postscript" gnus-uu-decode-postscript t]) ! ["Enter digest buffer" gnus-summary-enter-digest-group t] ! ["Isearch article" gnus-summary-isearch-article t] ! ["Search articles forward" gnus-summary-search-article-forward t] ! ["Search articles backward" gnus-summary-search-article-backward t] ! ["Beginning of the article" gnus-summary-beginning-of-article t] ! ["End of the article" gnus-summary-end-of-article t] ! ["Fetch parent of article" gnus-summary-refer-parent-article t] ! ["Fetch referenced articles" gnus-summary-refer-references t] ! ["Fetch article with id..." gnus-summary-refer-article t] ! ["Redisplay" gnus-summary-show-article t])) ! (easy-menu-define ! gnus-summary-thread-menu gnus-summary-mode-map "" ! '("Threads" ! ["Toggle threading" gnus-summary-toggle-threads t] ! ["Hide threads" gnus-summary-hide-all-threads t] ! ["Show threads" gnus-summary-show-all-threads t] ! ["Hide thread" gnus-summary-hide-thread t] ! ["Show thread" gnus-summary-show-thread t] ! ["Go to next thread" gnus-summary-next-thread t] ! ["Go to previous thread" gnus-summary-prev-thread t] ! ["Go down thread" gnus-summary-down-thread t] ! ["Go up thread" gnus-summary-up-thread t] ! ["Top of thread" gnus-summary-top-thread t] ! ["Mark thread as read" gnus-summary-kill-thread t] ! ["Lower thread score" gnus-summary-lower-thread t] ! ["Raise thread score" gnus-summary-raise-thread t] ! ["Rethread current" gnus-summary-rethread-current t] ! )) ! ! (easy-menu-define ! gnus-summary-post-menu gnus-summary-mode-map "" ! '("Post" ! ["Post an article" gnus-summary-post-news t] ! ["Followup" gnus-summary-followup t] ! ["Followup and yank" gnus-summary-followup-with-original t] ! ["Supersede article" gnus-summary-supersede-article t] ! ["Cancel article" gnus-summary-cancel-article t] ! ["Reply" gnus-summary-reply t] ! ["Reply and yank" gnus-summary-reply-with-original t] ! ["Mail forward" gnus-summary-mail-forward t] ! ["Post forward" gnus-summary-post-forward t] ! ["Digest and mail" gnus-uu-digest-mail-forward t] ! ["Digest and post" gnus-uu-digest-post-forward t] ! ["Resend message" gnus-summary-resend-message t] ! ["Send bounced mail" gnus-summary-resend-bounced-mail t] ! ["Send a mail" gnus-summary-mail-other-window t] ! ["Reply & followup" gnus-summary-followup-and-reply t] ! ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] ! ["Uuencode and post" gnus-uu-post-news t] ! ("Draft" ! ["Send" gnus-summary-send-draft t] ! ["Send bounced" gnus-resend-bounced-mail t]) ! )) ! (run-hooks 'gnus-summary-menu-hook) ! )) (defun gnus-score-set-default (var value) ! "A version of set that updates the GNU Emacs menu-bar." (set var value) ;; It is the message that forces the active status to be updated. (message "")) *************** *** 895,902 **** (easy-menu-define gnus-article-article-menu gnus-article-mode-map "" '("Article" ! ["Scroll forwards" gnus-article-next-page t] ! ["Scroll backwards" gnus-article-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] ["Mail to address at point" gnus-article-mail t] --- 917,924 ---- (easy-menu-define gnus-article-article-menu gnus-article-mode-map "" '("Article" ! ["Scroll forwards" gnus-article-goto-next-page t] ! ["Scroll backwards" gnus-article-goto-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] ["Mail to address at point" gnus-article-mail t] *************** *** 963,975 **** (default gnus-summary-default-score) (mark (or (gnus-summary-article-mark) gnus-unread-mark)) (inhibit-read-only t)) ! (while (and list (not (eval (car (car list))))) (setq list (cdr list))) ! (let ((face (and list (cdr (car list))))) ! (or (null mark) ! (eq face (get-text-property beg 'face)) ! (put-text-property beg end 'face ! (if (boundp face) (symbol-value face) face)))) (goto-char p))) ;;; --- 985,1001 ---- (default gnus-summary-default-score) (mark (or (gnus-summary-article-mark) gnus-unread-mark)) (inhibit-read-only t)) ! ;; Eval the cars of the lists until we find a match. ! (while (and list ! (not (eval (caar list)))) (setq list (cdr list))) ! (let ((face (cdar list))) ! (unless (eq face (get-text-property beg 'face)) ! (put-text-property ! beg end 'face ! (setq face (if (boundp face) (symbol-value face) face))) ! (when gnus-summary-highlight-line-function ! (funcall gnus-summary-highlight-line-function article face)))) (goto-char p))) ;;; *************** *** 1233,1276 **** (interactive) (save-excursion (set-buffer gnus-article-buffer) ! (goto-char (point-min)) ! (if (not (search-forward "\n\n" nil t)) ! () ! (beginning-of-line 0) ! (while (not (bobp)) (let ((alist gnus-header-face-alist) (buffer-read-only nil) (case-fold-search t) - (end (point)) (inhibit-point-motion-hooks t) ! begin entry regexp header-face field-face ! header-found field-found) ! (re-search-backward "^[^ \t]" nil t) ! (setq begin (point)) ! (while alist ! (setq entry (car alist) ! regexp (nth 0 entry) header-face (nth 1 entry) ! field-face (nth 2 entry) ! alist (cdr alist)) ! (if (looking-at regexp) ! (let ((from (point))) ! (skip-chars-forward "^:\n") ! (and (not header-found) ! header-face ! (progn ! (put-text-property from (point) 'face header-face) ! (setq header-found t))) ! (and (not field-found) ! field-face ! (progn ! (skip-chars-forward ": \t") ! (let ((from (point))) ! (goto-char end) ! (skip-chars-backward " \t\n") ! (put-text-property from (point) 'face field-face) ! (setq field-found t)))))) ! (goto-char begin))))))) (defun gnus-article-highlight-signature () "Highlight the signature in an article. --- 1259,1294 ---- (interactive) (save-excursion (set-buffer gnus-article-buffer) ! (save-restriction ! (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (narrow-to-region (1- (point)) (point-min)) (let ((alist gnus-header-face-alist) (buffer-read-only nil) (case-fold-search t) (inhibit-point-motion-hooks t) ! entry regexp header-face field-face from hpoints fpoints) ! (while (setq entry (pop alist)) ! (goto-char (point-min)) ! (setq regexp (concat "^" (nth 0 entry)) header-face (nth 1 entry) ! field-face (nth 2 entry)) ! (while (and (re-search-forward regexp nil t) ! (not (eobp))) ! (beginning-of-line) ! (setq from (point)) ! (search-forward ":" nil t) ! (when (and header-face ! (not (memq (point) hpoints))) ! (push (point) hpoints) ! (put-text-property from (point) 'face header-face)) ! (when (and field-face ! (not (memq (setq from (point)) fpoints))) ! (push from fpoints) ! (if (re-search-forward "^[^ \t]" nil t) ! (forward-char -1) ! (goto-char (point-max))) ! (put-text-property from (point) 'face field-face))))))))) (defun gnus-article-highlight-signature () "Highlight the signature in an article. *************** *** 1295,1305 **** --- 1313,1361 ---- \"External references\" are things like Message-IDs and URLs, as specified by `gnus-button-alist'." (interactive (list 'force)) + (save-excursion + (set-buffer gnus-article-buffer) + ;; Remove all old markers. + (while gnus-button-marker-list + (set-marker (pop gnus-button-marker-list) nil)) + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (case-fold-search t) + (alist gnus-button-alist) + beg entry regexp) + (goto-char (point-min)) + ;; We skip the headers. + (unless (search-forward "\n\n" nil t) + (goto-char (point-max))) + (setq beg (point)) + (while (setq entry (pop alist)) + (setq regexp (car entry)) + (while (re-search-forward regexp nil t) + (let* ((start (and entry (match-beginning (nth 1 entry)))) + (end (and entry (match-end (nth 1 entry)))) + (from (match-beginning 0))) + (when (or (eq t (nth 1 entry)) + (eval (nth 1 entry))) + ;; That optional form returned non-nil, so we add the + ;; button. + (gnus-article-add-button + start end 'gnus-button-push + (car (push (set-marker (make-marker) from) + gnus-button-marker-list)))))))))) + + (defun gnus-article-add-buttons-old (&optional force) + "Find external references in the article and make buttons of them. + \"External references\" are things like Message-IDs and URLs, as + specified by `gnus-button-alist'." + (interactive (list 'force)) (unless (eq gnus-button-last gnus-button-alist) (setq gnus-button-regexp (mapconcat 'car gnus-button-alist "\\|") gnus-button-last gnus-button-alist)) (save-excursion (set-buffer gnus-article-buffer) + ;; Remove all old markers. + (while gnus-button-marker-list + (set-marker (pop gnus-button-marker-list) nil)) ;; We parse citations first to be able to match attributions. (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) *************** *** 1326,1332 **** ;; button. (gnus-article-add-button start end 'gnus-button-push ! (set-marker (make-marker) from))))))))) ;; Add buttons to the head of an article. (defun gnus-article-add-buttons-to-head () --- 1382,1389 ---- ;; button. (gnus-article-add-button start end 'gnus-button-push ! (car (push (set-marker (make-marker) from) ! gnus-button-marker-list)))))))))) ;; Add buttons to the head of an article. (defun gnus-article-add-buttons-to-head () *************** *** 1339,1345 **** (case-fold-search t) (alist gnus-header-button-alist) entry beg end) ! (gnus-narrow-to-headers) (while alist ;; Each alist entry. (setq entry (car alist) --- 1396,1402 ---- (case-fold-search t) (alist gnus-header-button-alist) entry beg end) ! (nnheader-narrow-to-headers) (while alist ;; Each alist entry. (setq entry (car alist) *** pub/sgnus/lisp/gnus-vm.el Thu Dec 21 04:09:41 1995 --- sgnus/lisp/gnus-vm.el Wed Jan 3 13:33:02 1996 *************** *** 1,5 **** ;;; gnus-vm.el --- vm interface for Gnus ! ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Per Persson ;; Keywords: news, mail --- 1,5 ---- ;;; gnus-vm.el --- vm interface for Gnus ! ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ;; Author: Per Persson ;; Keywords: news, mail *** pub/sgnus/lisp/gnus-xmas.el Thu Dec 21 04:09:42 1995 --- sgnus/lisp/gnus-xmas.el Sun Jan 7 10:04:36 1996 *************** *** 1,5 **** ;;; gnus-xmas.el --- Gnus functions for XEmacs ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; gnus-xmas.el --- Gnus functions for XEmacs ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 228,240 **** "Get the next event." (let ((event (next-event))) ;; We junk all non-key events. Is this naughty? ! (while (not (key-press-even-p event)) (setq event (next-event))) (cons (and (key-press-event-p event) (numberp (event-key event)) (event-to-character event)) event))) (defun gnus-xmas-define () (setq gnus-mouse-2 [button2]) --- 228,258 ---- "Get the next event." (let ((event (next-event))) ;; We junk all non-key events. Is this naughty? ! (while (not (key-press-event-p event)) (setq event (next-event))) (cons (and (key-press-event-p event) (numberp (event-key event)) (event-to-character event)) event))) + (defun gnus-xmas-seconds-since-epoch (date) + "Return a floating point number that says how many seconds have lapsed between Jan 1 12:00:00 1970 and DATE." + (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) + (timezone-parse-date date))) + (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) + (timezone-parse-time + (aref (timezone-parse-date date) 3)))) + (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) + (timezone-parse-date "Jan 1 12:00:00 1970"))) + (tday (- (timezone-absolute-from-gregorian + (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) + (timezone-absolute-from-gregorian + (nth 1 edate) (nth 2 edate) (nth 0 edate))))) + (+ (nth 2 ttime) + (* (nth 1 ttime) 60) + (* (float (nth 0 ttime)) 60 60) + (* (float tday) 60 60 24)))) + (defun gnus-xmas-define () (setq gnus-mouse-2 [button2]) *************** *** 257,262 **** --- 275,290 ---- (defvar gnus-mouse-face-prop 'highlight) + (unless (fboundp 'encode-time) + (defun encode-time (sec minute hour day month year &optional zone) + (let ((seconds + (gnus-xmas-seconds-since-epoch + (timezone-make-arpa-date + year month day (timezone-make-time-string hour minute sec) + zone)))) + (list (floor (/ seconds (expt 2 16))) + (round (mod seconds (expt 2 16))))))) + (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (symbol-function func))) *** pub/sgnus/lisp/gnus.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/gnus.el Tue Jan 16 21:20:54 1996 *************** *** 1,5 **** ;;; gnus.el --- a newsreader for GNU Emacs ! ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; gnus.el --- a newsreader for GNU Emacs ! ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *************** *** 14,24 **** ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: --- 14,24 ---- ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: *************** *** 43,49 **** If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable.") ! (defconst gnus-backup-default-subscribed-newsgroups '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") "Default default new newsgroups the first time Gnus is run. Should be set in paths.el, and shouldn't be touched by the user.") --- 43,49 ---- If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable.") ! (defvar gnus-backup-default-subscribed-newsgroups '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") "Default default new newsgroups the first time Gnus is run. Should be set in paths.el, and shouldn't be touched by the user.") *************** *** 106,113 **** nil name) (kill-buffer (current-buffer)))))))) ! ! (defvar gnus-select-method (nconc (list 'nntp (or (condition-case () (gnus-getenv-nntpserver) --- 106,113 ---- nil name) (kill-buffer (current-buffer)))))))) ! ! (defvar gnus-select-method (nconc (list 'nntp (or (condition-case () (gnus-getenv-nntpserver) *************** *** 118,128 **** (system-name))) (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) ! nil (list gnus-nntp-service))) "*Default method for selecting a newsgroup. This variable should be a list, where the first element is how the ! news is to be fetched, the second is the address. For instance, if you want to get your news via NNTP from \"flab.flab.edu\", you could say: --- 118,128 ---- (system-name))) (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) ! nil (list gnus-nntp-service))) "*Default method for selecting a newsgroup. This variable should be a list, where the first element is how the ! news is to be fetched, the second is the address. For instance, if you want to get your news via NNTP from \"flab.flab.edu\", you could say: *************** *** 138,153 **** There is a lot more to know about select methods and virtual servers - see the manual for details.") ! ;; Added by Sudish Joseph . ! (defvar gnus-post-method nil ! "*Preferred method for posting USENET news. ! If this variable is nil, Gnus will use the current method to decide ! which method to use when posting. If it is non-nil, it will override ! the current method. This method will not be used in mail groups and ! the like, only in \"real\" newsgroups. ! ! The value must be a valid method as discussed in the documentation of ! `gnus-select-method'.") (defvar gnus-refer-article-method nil "*Preferred method for fetching an article by Message-ID. --- 138,150 ---- There is a lot more to know about select methods and virtual servers - see the manual for details.") ! (defvar gnus-message-archive-method ! '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/") ! (nnfolder-active-file "~/Mail/archive/active") ! (nnfolder-get-new-mail nil) ! (nnfolder-inhibit-expiry t)) ! "*Method used for archiving messages you've sent. ! This should be a mail method.") (defvar gnus-refer-article-method nil "*Preferred method for fetching an article by Message-ID. *************** *** 161,167 **** (defvar gnus-secondary-select-methods nil "*A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see ! `gnus-select-method'). If, for instance, you want to read your mail with the nnml backend, you could set this variable: --- 158,164 ---- (defvar gnus-secondary-select-methods nil "*A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see ! `gnus-select-method'). If, for instance, you want to read your mail with the nnml backend, you could set this variable: *************** *** 175,181 **** (defvar gnus-nntp-server nil "*The name of the host running the NNTP server. ! This variable is semi-obsolete. Use the `gnus-select-method' variable instead.") (defvar gnus-startup-file "~/.newsrc" --- 172,178 ---- (defvar gnus-nntp-server nil "*The name of the host running the NNTP server. ! This variable is semi-obsolete. Use the `gnus-select-method' variable instead.") (defvar gnus-startup-file "~/.newsrc" *************** *** 185,191 **** (defvar gnus-init-file "~/.gnus" "*Your Gnus elisp startup file. If a file with the .el or .elc suffixes exist, it will be read ! instead.") (defvar gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" --- 182,188 ---- (defvar gnus-init-file "~/.gnus" "*Your Gnus elisp startup file. If a file with the .el or .elc suffixes exist, it will be read ! instead.") (defvar gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" *************** *** 212,228 **** If the default site is too slow, try one of these: ! North America: mirrors.aol.com /pub/rtfm/usenet ! ftp.seas.gwu.edu /pub/rtfm ! rtfm.mit.edu /pub/usenet/news.answers ! Europe: ftp.uni-paderborn.de /pub/FAQ ! ftp.sunet.se /pub/usenet ! Asia: nctuccca.edu.tw /USENET/FAQ ! hwarang.postech.ac.kr /pub/usenet/news.answers ! ftp.hk.super.net /mirror/faqs") (defvar gnus-group-archive-directory ! "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives.") (defvar gnus-group-recent-archive-directory --- 209,225 ---- If the default site is too slow, try one of these: ! North America: mirrors.aol.com /pub/rtfm/usenet ! ftp.seas.gwu.edu /pub/rtfm ! rtfm.mit.edu /pub/usenet/news.answers ! Europe: ftp.uni-paderborn.de /pub/FAQ ! ftp.sunet.se /pub/usenet ! Asia: nctuccca.edu.tw /USENET/FAQ ! hwarang.postech.ac.kr /pub/usenet/news.answers ! ftp.hk.super.net /mirror/faqs") (defvar gnus-group-archive-directory ! "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives.") (defvar gnus-group-recent-archive-directory *************** *** 238,245 **** (defvar gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in ! subscribed newsgroups. If neither t nor nil, mark as read in all ! newsgroups.") (defvar gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. --- 235,242 ---- (defvar gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in ! subscribed newsgroups. If neither t nor nil, mark as read in all ! newsgroups.") (defvar gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. *************** *** 329,335 **** The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") ! (defvar gnus-split-methods '((gnus-article-archive-name)) "*Variable used to suggest where articles are to be saved. For instance, if you would like to save articles related to Gnus in --- 326,332 ---- The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") ! (defvar gnus-split-methods '((gnus-article-archive-name)) "*Variable used to suggest where articles are to be saved. For instance, if you would like to save articles related to Gnus in *************** *** 343,349 **** value is a list of possible files to save in if the match is non-nil. If the match is a string, it is used as a regexp match on the ! article. If the match is a symbol, that symbol will be funcalled from the buffer of the article to be saved with the newsgroup as the parameter. If it is a list, it will be evaled in the same buffer. --- 340,346 ---- value is a list of possible files to save in if the match is non-nil. If the match is a string, it is used as a regexp match on the ! article. If the match is a symbol, that symbol will be funcalled from the buffer of the article to be saved with the newsgroup as the parameter. If it is a list, it will be evaled in the same buffer. *************** *** 367,372 **** --- 364,372 ---- explicitly entered into the cache. If anything else, use the cache to the full extent of the law.") + (defvar gnus-use-trees nil + "*If non-nil, display a thread tree buffer.") + (defvar gnus-keep-backlog nil "*If non-nil, Gnus will keep read articles for later re-retrieval. If it is a number N, then Gnus will only keep the last N articles *************** *** 382,388 **** (defvar gnus-use-scoring t "*If non-nil, enable scoring.") ! (defvar gnus-use-picon nil "*If non-nil, display picons.") (defvar gnus-fetch-old-headers nil --- 382,388 ---- (defvar gnus-use-scoring t "*If non-nil, enable scoring.") ! (defvar gnus-use-picons nil "*If non-nil, display picons.") (defvar gnus-fetch-old-headers nil *************** *** 391,400 **** just marked as read) article, the old article will not normally be displayed in the Summary buffer. If this variable is non-nil, Gnus will attempt to grab the headers to the old articles, and thereby ! build complete threads. If it has the value `some', only enough headers to connect otherwise loose threads will be displayed. This variable can also be a number. In that case, no more than that ! number of old headers will be fetched. The server has to support NOV for any of this to work.") --- 391,400 ---- just marked as read) article, the old article will not normally be displayed in the Summary buffer. If this variable is non-nil, Gnus will attempt to grab the headers to the old articles, and thereby ! build complete threads. If it has the value `some', only enough headers to connect otherwise loose threads will be displayed. This variable can also be a number. In that case, no more than that ! number of old headers will be fetched. The server has to support NOV for any of this to work.") *************** *** 426,432 **** When you type, for instance, `n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group ! buffer. If this variable is non-nil, Gnus will either put you in the next newsgroup with the same level, or, if no such newsgroup is available, the next newsgroup with the lowest possible level higher --- 426,432 ---- When you type, for instance, `n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group ! buffer. If this variable is non-nil, Gnus will either put you in the next newsgroup with the same level, or, if no such newsgroup is available, the next newsgroup with the lowest possible level higher *************** *** 439,445 **** If the root of a thread has expired or been read in a previous session, the information necessary to build a complete thread has been lost. Instead of having many small sub-threads from this original thread ! scattered all over the summary buffer, Gnus can gather them. If non-nil, Gnus will try to gather all loose sub-threads from an original thread into one large thread. --- 439,445 ---- If the root of a thread has expired or been read in a previous session, the information necessary to build a complete thread has been lost. Instead of having many small sub-threads from this original thread ! scattered all over the summary buffer, Gnus can gather them. If non-nil, Gnus will try to gather all loose sub-threads from an original thread into one large thread. *************** *** 454,460 **** If this variable is `adopt', Gnus will make one of the \"children\" the parent and mark all the step-children as such. If this variable is `empty', the \"children\" are printed with empty ! subject fields. (Or rather, they will be printed with a string given by the `gnus-summary-same-subject' variable.)") (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" --- 454,460 ---- If this variable is `adopt', Gnus will make one of the \"children\" the parent and mark all the step-children as such. If this variable is `empty', the \"children\" are printed with empty ! subject fields. (Or rather, they will be printed with a string given by the `gnus-summary-same-subject' variable.)") (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" *************** *** 474,479 **** --- 474,495 ---- If this variable is `fuzzy', Gnus will use a fuzzy algorithm when comparing subjects.") + (defvar gnus-simplify-ignored-prefixes nil + "*Regexp, matches for which are removed from subject lines when simplifying.") + + (defvar gnus-build-sparse-threads nil + "*If non-nil, fill in the gaps in threads. + If `some', only fill in the gaps that are needed to tie loose threads + together. If non-nil and non-`some', fill in all gaps that Gnus + manages to guess.") + + (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject + "Function used for gathering loose threads. + There are two pre-defined functions: `gnus-gather-threads-by-subject', + which only takes Subjects into consideration; and + `gnus-gather-threads-by-references', which compared the References + headers of the articles to find matches.") + ;; Added by Per Abrahamsen . (defvar gnus-summary-same-subject "" "*String indicating that the current article has the same subject as the previous. *************** *** 481,505 **** `gnus-summary-make-false-root' is `empty'.") (defvar gnus-summary-goto-unread t ! "*If non-nil, marking commands will go to the next unread article.") (defvar gnus-group-goto-unread t "*If non-nil, movement commands will go to the next unread and subscribed group.") (defvar gnus-check-new-newsgroups t "*Non-nil means that Gnus will add new newsgroups at startup. If this variable is `ask-server', Gnus will ask the server for new ! groups since the last time it checked. This means that the killed list is no longer necessary, so you could set `gnus-save-killed-list' to ! nil. ! A variant is to have this variable be a list of select methods. Gnus will then use the `ask-server' method on all these select methods to query for new groups from all those servers. Eg. ! (setq gnus-check-new-newsgroups ! '((nntp \"some.server\") (nntp \"other.server\"))) If this variable is nil, then you have to tell Gnus explicitly to check for new newsgroups with \\\\[gnus-find-new-newsgroups].") --- 497,526 ---- `gnus-summary-make-false-root' is `empty'.") (defvar gnus-summary-goto-unread t ! "*If non-nil, marking commands will go to the next unread article. ! If `never', \\\\[gnus-summary-next-page] will go to the next article, ! whether it is read or not.") (defvar gnus-group-goto-unread t "*If non-nil, movement commands will go to the next unread and subscribed group.") + (defvar gnus-goto-next-group-when-activating t + "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group.") + (defvar gnus-check-new-newsgroups t "*Non-nil means that Gnus will add new newsgroups at startup. If this variable is `ask-server', Gnus will ask the server for new ! groups since the last time it checked. This means that the killed list is no longer necessary, so you could set `gnus-save-killed-list' to ! nil. ! A variant is to have this variable be a list of select methods. Gnus will then use the `ask-server' method on all these select methods to query for new groups from all those servers. Eg. ! (setq gnus-check-new-newsgroups ! '((nntp \"some.server\") (nntp \"other.server\"))) If this variable is nil, then you have to tell Gnus explicitly to check for new newsgroups with \\\\[gnus-find-new-newsgroups].") *************** *** 554,560 **** If it is non-nil, it should be a number between one and nine. Foreign newsgroups that have a level lower or equal to this number will be activated on startup. For instance, if you want to active all ! subscribed newsgroups, but not the rest, you'd set this variable to `gnus-level-subscribed'. If you subscribe to lots of newsgroups from different servers, startup --- 575,581 ---- If it is non-nil, it should be a number between one and nine. Foreign newsgroups that have a level lower or equal to this number will be activated on startup. For instance, if you want to active all ! subscribed newsgroups, but not the rest, you'd set this variable to `gnus-level-subscribed'. If you subscribe to lots of newsgroups from different servers, startup *************** *** 623,629 **** articles in the groups.") (defvar gnus-group-default-list-level gnus-level-subscribed ! "*Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil.") (defvar gnus-group-use-permanent-levels nil --- 644,650 ---- articles in the groups.") (defvar gnus-group-default-list-level gnus-level-subscribed ! "*Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil.") (defvar gnus-group-use-permanent-levels nil *************** *** 638,645 **** `gnus-show-mime-method'.") (defvar gnus-strict-mime t ! "*If nil, decode MIME header even if there is not Mime-Version field.") ! (defvar gnus-show-mime-method 'metamail-buffer "*Function to process a MIME message. The function is called from the article buffer.") --- 659,666 ---- `gnus-show-mime-method'.") (defvar gnus-strict-mime t ! "*If nil, MIME-decode even if there is no Mime-Version header in the article.") ! (defvar gnus-show-mime-method 'metamail-buffer "*Function to process a MIME message. The function is called from the article buffer.") *************** *** 647,653 **** (defvar gnus-decode-encoded-word-method (lambda ()) "*Function to decode a MIME encoded-words. The function is called from the article buffer.") ! (defvar gnus-show-threads t "*If non-nil, display threads in summary mode.") --- 668,674 ---- (defvar gnus-decode-encoded-word-method (lambda ()) "*Function to decode a MIME encoded-words. The function is called from the article buffer.") ! (defvar gnus-show-threads t "*If non-nil, display threads in summary mode.") *************** *** 668,674 **** (defvar gnus-thread-operation-ignore-subject t "*If non-nil, subjects will be ignored when doing thread commands. This affects commands like `gnus-summary-kill-thread' and ! `gnus-summary-lower-thread'. If this variable is nil, articles in the same thread with different subjects will not be included in the operation in question. If this --- 689,695 ---- (defvar gnus-thread-operation-ignore-subject t "*If non-nil, subjects will be ignored when doing thread commands. This affects commands like `gnus-summary-kill-thread' and ! `gnus-summary-lower-thread'. If this variable is nil, articles in the same thread with different subjects will not be included in the operation in question. If this *************** *** 678,690 **** (defvar gnus-thread-indent-level 4 "*Number that says how much each sub-thread should be indented.") ! (defvar gnus-ignored-newsgroups (purecopy (mapconcat 'identity ! '("^to\\." ; not "real" groups ! "^[0-9. \t]+ " ; all digits in name ! "[][\"#'()]" ; bogus characters ! ) ! "\\|")) "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, --- 699,711 ---- (defvar gnus-thread-indent-level 4 "*Number that says how much each sub-thread should be indented.") ! (defvar gnus-ignored-newsgroups (purecopy (mapconcat 'identity ! '("^to\\." ; not "real" groups ! "^[0-9. \t]+ " ; all digits in name ! "[][\"#'()]" ; bogus characters ! ) ! "\\|")) "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, *************** *** 696,714 **** This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored.") ! (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Resent-" "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored.") (defvar gnus-sorted-header-list ! '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" "^Cc:" "^Date:" "^Organization:") "*This variable is a list of regular expressions. If it is non-nil, headers that match the regular expressions will be placed first in the article buffer in the sequence specified by this list.") (defvar gnus-show-all-headers nil "*If non-nil, don't hide any headers.") --- 717,741 ---- This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored.") ! (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-" "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored.") (defvar gnus-sorted-header-list ! '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" "^Cc:" "^Date:" "^Organization:") "*This variable is a list of regular expressions. If it is non-nil, headers that match the regular expressions will be placed first in the article buffer in the sequence specified by this list.") + (defvar gnus-boring-article-headers + '(empty followup-to reply-to) + "*Headers that are only to be displayed if they have interesting data. + Possible values in this list are `empty', `newsgroups', `followup-to', + `reply-to', and `date'.") + (defvar gnus-show-all-headers nil "*If non-nil, don't hide any headers.") *************** *** 738,750 **** If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in ! `gnus-select-group-hook'.") (defvar gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit ! summary mode and go back to group mode. If the value is neither nil ! nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmation, and if it is `almost-quietly', the next group will be selected without any --- 765,777 ---- If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in ! `gnus-select-group-hook'.") (defvar gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit ! summary mode and go back to group mode. If the value is neither nil ! nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmation, and if it is `almost-quietly', the next group will be selected without any *************** *** 777,812 **** (defvar gnus-window-configuration nil "Obsolete variable. See `gnus-buffer-configuration'.") (defvar gnus-buffer-configuration '((group ! (vertical 1.0 ! (group 1.0 point) ! (if gnus-carpal (group-carpal 4)))) (summary (vertical 1.0 (summary 1.0 point) ! (if gnus-carpal (summary-carpal 4)))) (article ! (if gnus-use-picon ! '(frame 1.0 ! (vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal (summary-carpal 4)) ! (article 1.0)) ! (vertical 1.0 ! (picon 1.0))) '(vertical 1.0 (summary 0.25 point) ! (if gnus-carpal (summary-carpal 4)) ! (article 1.0)))) (server (vertical 1.0 (server 1.0 point) ! (if gnus-carpal (server-carpal 2)))) (browse (vertical 1.0 (browse 1.0 point) ! (if gnus-carpal (browse-carpal 2)))) (group-mail (vertical 1.0 (mail 1.0 point))) --- 804,855 ---- (defvar gnus-window-configuration nil "Obsolete variable. See `gnus-buffer-configuration'.") + (defvar gnus-window-min-width 2 + "*Minimum width of Gnus buffers.") + + (defvar gnus-window-min-height 1 + "*Minimum height of Gnus buffers.") + (defvar gnus-buffer-configuration '((group ! (vertical 1.0 ! (group 1.0 point) ! (if gnus-carpal '(group-carpal 4)))) (summary (vertical 1.0 (summary 1.0 point) ! (if gnus-carpal '(summary-carpal 4)))) (article ! (cond ! (gnus-use-picons ! '(frame 1.0 ! (vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal '(summary-carpal 4)) ! (article 1.0)) ! (vertical '((height . 5) (width . 15) ! (user-position . t) ! (left . -1) (top . 1)) ! (picons 1.0)))) ! (gnus-use-trees ! '(vertical 1.0 ! (summary 0.25 point) ! (tree 0.25) ! (article 1.0))) ! (t '(vertical 1.0 (summary 0.25 point) ! (if gnus-carpal '(summary-carpal 4)) ! (if gnus-use-trees '(tree 0.25)) ! (article 1.0))))) (server (vertical 1.0 (server 1.0 point) ! (if gnus-carpal '(server-carpal 2)))) (browse (vertical 1.0 (browse 1.0 point) ! (if gnus-carpal '(browse-carpal 2)))) (group-mail (vertical 1.0 (mail 1.0 point))) *************** *** 817,822 **** --- 860,868 ---- (vertical 1.0 (article 0.5) (mail 1.0 point))) + (pick + (vertical 1.0 + (article 1.0 point))) (info (vertical 1.0 (nil 1.0 point))) *************** *** 861,868 **** (draft 1.0 point))) (pipe (vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal (summary-carpal 4)) ("*Shell Command Output*" 1.0))) (followup (vertical 1.0 --- 907,914 ---- (draft 1.0 point))) (pipe (vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal '(summary-carpal 4)) ("*Shell Command Output*" 1.0))) (followup (vertical 1.0 *************** *** 873,885 **** (post 1.0 point)))) "Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and ! a RULE. The NAMEs are commonsense names like `group', which names a rule used when displaying the group buffer; `summary', which names a rule for what happens when you enter a group and do not display an article buffer; and so on. See the value of this variable for a complete list of NAMEs. ! Each RULE is a list of vectors. The first element in this vector is the name of the buffer to be displayed; the second element is the percentage of the screen this buffer is to occupy (a number in the 0.0-0.99 range); the optional third element is `point', which should --- 919,931 ---- (post 1.0 point)))) "Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and ! a RULE. The NAMEs are commonsense names like `group', which names a rule used when displaying the group buffer; `summary', which names a rule for what happens when you enter a group and do not display an article buffer; and so on. See the value of this variable for a complete list of NAMEs. ! Each RULE is a list of vectors. The first element in this vector is the name of the buffer to be displayed; the second element is the percentage of the screen this buffer is to occupy (a number in the 0.0-0.99 range); the optional third element is `point', which should *************** *** 902,908 **** (mail . gnus-mail-buffer) (post . gnus-post-news-buffer) (faq . gnus-faq-buffer) ! (picon . gnus-picon-buffer) (draft . gnus-draft-buffer)) "Mapping from short symbols to buffer names or buffer variables.") --- 948,955 ---- (mail . gnus-mail-buffer) (post . gnus-post-news-buffer) (faq . gnus-faq-buffer) ! (picons . "*Picons*") ! (tree . gnus-tree-buffer) (draft . gnus-draft-buffer)) "Mapping from short symbols to buffer names or buffer variables.") *************** *** 919,925 **** for your decision; `gnus-subscribe-killed' kills all new groups.") ;; Suggested by a bug report by Hallvard B Furuseth. ! ;; . (defvar gnus-subscribe-options-newsgroup-method (function gnus-subscribe-alphabetically) "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. --- 966,972 ---- for your decision; `gnus-subscribe-killed' kills all new groups.") ;; Suggested by a bug report by Hallvard B Furuseth. ! ;; . (defvar gnus-subscribe-options-newsgroup-method (function gnus-subscribe-alphabetically) "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. *************** *** 948,961 **** for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread', `gnus-group-sort-by-level', `gnus-group-sort-by-score', and ! `gnus-group-sort-by-rank'. ! This variable can also be a list of sorting functions. In that case, the most significant sort function should be the last function in the list.") ;; Mark variables suggested by Thomas Michanek ! ;; . (defvar gnus-unread-mark ? "*Mark used for unread articles.") (defvar gnus-ticked-mark ?! --- 995,1008 ---- for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread', `gnus-group-sort-by-level', `gnus-group-sort-by-score', and ! `gnus-group-sort-by-rank'. ! This variable can also be a list of sorting functions. In that case, the most significant sort function should be the last function in the list.") ;; Mark variables suggested by Thomas Michanek ! ;; . (defvar gnus-unread-mark ? "*Mark used for unread articles.") (defvar gnus-ticked-mark ?! *************** *** 984,993 **** "*Mark used for articles that are in the cache.") (defvar gnus-saved-mark ?S "*Mark used for articles that have been saved to.") ! (defvar gnus-process-mark ?# "*Process mark.") (defvar gnus-ancient-mark ?O "*Mark used for ancient articles.") (defvar gnus-canceled-mark ?G "*Mark used for canceled articles.") (defvar gnus-score-over-mark ?+ --- 1031,1042 ---- "*Mark used for articles that are in the cache.") (defvar gnus-saved-mark ?S "*Mark used for articles that have been saved to.") ! (defvar gnus-process-mark ?# "*Process mark.") (defvar gnus-ancient-mark ?O "*Mark used for ancient articles.") + (defvar gnus-sparse-mark ?Q + "*Mark used for sparsely reffed articles.") (defvar gnus-canceled-mark ?G "*Mark used for canceled articles.") (defvar gnus-score-over-mark ?+ *************** *** 1052,1058 **** Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification ! is ignored altogether. If the spec is changed considerably, your output may end up looking strange when listing both alive and killed groups. --- 1101,1107 ---- Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification ! is ignored altogether. If the spec is changed considerably, your output may end up looking strange when listing both alive and killed groups. *************** *** 1060,1066 **** a bit of extra memory will be used. %D will also worsen performance. Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into ! effect.") (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" "*The format specification of the lines in the summary buffer. --- 1109,1115 ---- a bit of extra memory will be used. %D will also worsen performance. Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into ! effect.") (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" "*The format specification of the lines in the summary buffer. *************** *** 1103,1125 **** summary specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' ! when the mouse point is placed inside the area. There can only be one such area. The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and \"hard-code\" that. This means that ! it is illegal to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. The smart choice is to have these specs as for to the left as ! possible. This restriction may disappear in later versions of Gnus.") ! (defvar gnus-summary-dummy-line-format ! "* %(: :%) %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. --- 1152,1174 ---- summary specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' ! when the mouse point is placed inside the area. There can only be one such area. The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and \"hard-code\" that. This means that ! it is illegal to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. The smart choice is to have these specs as for to the left as ! possible. This restriction may disappear in later versions of Gnus.") ! (defvar gnus-summary-dummy-line-format ! "* %(: :%) %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. *************** *** 1161,1175 **** (defvar gnus-valid-select-methods '(("nntp" post address prompt-address) ("nnspool" post) ! ("nnvirtual" post-mail virtual prompt-address) ! ("nnmbox" mail respool) ("nnml" mail respool) ! ("nnmh" mail respool) ("nndir" post-mail prompt-address address) ("nneething" none prompt-address) ! ("nndoc" none prompt-address) ! ("nnbabyl" mail respool) ! ("nnkiboze" post virtual) ("nnsoup" post-mail) ("nnfolder" mail respool)) "An alist of valid select methods. --- 1210,1224 ---- (defvar gnus-valid-select-methods '(("nntp" post address prompt-address) ("nnspool" post) ! ("nnvirtual" post-mail virtual prompt-address) ! ("nnmbox" mail respool) ("nnml" mail respool) ! ("nnmh" mail respool) ("nndir" post-mail prompt-address address) ("nneething" none prompt-address) ! ("nndoc" none prompt-address) ! ("nnbabyl" mail respool) ! ("nnkiboze" post virtual) ("nnsoup" post-mail) ("nnfolder" mail respool)) "An alist of valid select methods. *************** *** 1178,1190 **** this method (ie. `post', `mail', `none' or whatever) or other properties that this method has (like being respoolable). If you implement a new select method, all you should have to change is ! this variable. I think.") ! (defvar gnus-updated-mode-lines '(group article summary) "*List of buffers that should update their mode lines. The list may contain the symbols `group', `article' and `summary'. If the corresponding symbol is present, Gnus will keep that mode line ! updated with information that may be pertinent. If this variable is nil, screen refresh may be quicker.") ;; Added by Keinonen Kari . --- 1227,1239 ---- this method (ie. `post', `mail', `none' or whatever) or other properties that this method has (like being respoolable). If you implement a new select method, all you should have to change is ! this variable. I think.") ! (defvar gnus-updated-mode-lines '(group article summary tree) "*List of buffers that should update their mode lines. The list may contain the symbols `group', `article' and `summary'. If the corresponding symbol is present, Gnus will keep that mode line ! updated with information that may be pertinent. If this variable is nil, screen refresh may be quicker.") ;; Added by Keinonen Kari . *************** *** 1201,1210 **** (defvar gnus-summary-mark-below nil "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the ! score file.") (defvar gnus-article-sort-functions '(gnus-article-sort-by-number) ! "*List of functions used for sorting articles in the summary buffer.") (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) "*List of functions used for sorting threads in the summary buffer. --- 1250,1260 ---- (defvar gnus-summary-mark-below nil "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the ! score file.") (defvar gnus-article-sort-functions '(gnus-article-sort-by-number) ! "*List of functions used for sorting articles in the summary buffer. ! This variable is only used when not using a threaded display.") (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) "*List of functions used for sorting threads in the summary buffer. *************** *** 1212,1218 **** Each function takes two threads and return non-nil if the first thread should be sorted before the other. If you use more than one function, ! the primary sort function should be the last. Ready-mady functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', --- 1262,1270 ---- Each function takes two threads and return non-nil if the first thread should be sorted before the other. If you use more than one function, ! the primary sort function should be the last. You should probably ! always include `gnus-thread-sort-by-number' in the list of sorting ! functions -- preferably first. Ready-mady functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', *************** *** 1232,1241 **** (defvar gnus-thread-expunge-below nil "All threads that have a total score less than this variable will be expunged. ! See `gnus-thread-score-function' for en explanation of what a \"thread score\" is.") ! (defvar gnus-auto-subscribed-groups "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" "*All new groups that match this regexp will be subscribed automatically. Note that this variable only deals with new groups. It has no effect --- 1284,1293 ---- (defvar gnus-thread-expunge-below nil "All threads that have a total score less than this variable will be expunged. ! See `gnus-thread-score-function' for en explanation of what a \"thread score\" is.") ! (defvar gnus-auto-subscribed-groups "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" "*All new groups that match this regexp will be subscribed automatically. Note that this variable only deals with new groups. It has no effect *************** *** 1243,1254 **** (defvar gnus-options-subscribe nil "*All new groups matching this regexp will be subscribed unconditionally. ! Note that this variable deals only with new newsgroups. This variable does not affect old newsgroups.") (defvar gnus-options-not-subscribe nil "*All new groups matching this regexp will be ignored. ! Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups.") (defvar gnus-auto-expirable-newsgroups nil --- 1295,1306 ---- (defvar gnus-options-subscribe nil "*All new groups matching this regexp will be subscribed unconditionally. ! Note that this variable deals only with new newsgroups. This variable does not affect old newsgroups.") (defvar gnus-options-not-subscribe nil "*All new groups matching this regexp will be ignored. ! Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups.") (defvar gnus-auto-expirable-newsgroups nil *************** *** 1260,1266 **** "*Groups in which to perform expiry of all read articles. Use with extreme caution. All groups that match this regexp will be expiring - which means that all read articles will be deleted after ! (say) one week. (This only goes for mail groups and the like, of course.)") (defvar gnus-hidden-properties '(invisible t intangible t) --- 1312,1318 ---- "*Groups in which to perform expiry of all read articles. Use with extreme caution. All groups that match this regexp will be expiring - which means that all read articles will be deleted after ! (say) one week. (This only goes for mail groups and the like, of course.)") (defvar gnus-hidden-properties '(invisible t intangible t) *************** *** 1282,1293 **** (defvar gnus-article-mode-hook nil "*A hook for Gnus article mode.") ! (defun gnus-summary-prepare-exit-hook nil "*A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default.") (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) ! (defun gnus-summary-exit-hook nil "*A hook called on exit from the summary buffer.") (defvar gnus-open-server-hook nil --- 1334,1345 ---- (defvar gnus-article-mode-hook nil "*A hook for Gnus article mode.") ! (defvar gnus-summary-prepare-exit-hook nil "*A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default.") (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) ! (defvar gnus-summary-exit-hook nil "*A hook called on exit from the summary buffer.") (defvar gnus-open-server-hook nil *************** *** 1335,1341 **** ;The hook is designed to change the contents of the article ;buffer. Typical functions that this hook may contain are ;`gnus-article-hide-headers' (hide selected headers), ! ;`gnus-article-maybe-highlight' (perform fancy article highlighting), ;`gnus-article-hide-signature' (hide signature) and ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted) --- 1387,1393 ---- ;The hook is designed to change the contents of the article ;buffer. Typical functions that this hook may contain are ;`gnus-article-hide-headers' (hide selected headers), ! ;`gnus-article-maybe-highlight' (perform fancy article highlighting), ;`gnus-article-hide-signature' (hide signature) and ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted) *************** *** 1346,1352 **** "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" "String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell ! asynchronously. The compressed face will be piped to this command.") (defvar gnus-article-x-face-too-ugly nil "Regexp matching posters whose face shouldn't be shown automatically.") --- 1398,1404 ---- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" "String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell ! asynchronously. The compressed face will be piped to this command.") (defvar gnus-article-x-face-too-ugly nil "Regexp matching posters whose face shouldn't be shown automatically.") *************** *** 1368,1378 **** (mail-header-subject header) 're-only))) gnus-newsgroup-headers))))") ! (defvar gnus-select-article-hook ! '(gnus-summary-show-thread) ! "*A hook called when an article is selected. ! The default hook shows conversation thread subtrees of the selected ! article automatically using `gnus-summary-show-thread'.") (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) "*A hook called to apply kill files to a group. --- 1420,1427 ---- (mail-header-subject header) 're-only))) gnus-newsgroup-headers))))") ! (defvar gnus-select-article-hook nil ! "*A hook called when an article is selected.") (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) "*A hook called to apply kill files to a group. *************** *** 1392,1404 **** (gnus-kill \"Subject\" \"rmgroup\") (gnus-expunge \"X\"))))))") ! (defvar gnus-visual-mark-article-hook (list 'gnus-highlight-selected-summary) "*Hook run after selecting an article in the summary buffer. It is meant to be used for highlighting the article in some way. It is not run if `gnus-visual' is nil.") ! (defun gnus-parse-headers-hook nil "*A hook called before parsing the headers.") (defvar gnus-exit-group-hook nil --- 1441,1453 ---- (gnus-kill \"Subject\" \"rmgroup\") (gnus-expunge \"X\"))))))") ! (defvar gnus-visual-mark-article-hook (list 'gnus-highlight-selected-summary) "*Hook run after selecting an article in the summary buffer. It is meant to be used for highlighting the article in some way. It is not run if `gnus-visual' is nil.") ! (defvar gnus-parse-headers-hook nil "*A hook called before parsing the headers.") (defvar gnus-exit-group-hook nil *************** *** 1421,1427 **** "*A hook called just before saving the standard newsrc file. Can be used to turn version control on or off.") ! (defvar gnus-summary-update-hook (list 'gnus-summary-highlight-line) "*A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. --- 1470,1476 ---- "*A hook called just before saving the standard newsrc file. Can be used to turn version control on or off.") ! (defvar gnus-summary-update-hook (list 'gnus-summary-highlight-line) "*A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. *************** *** 1435,1440 **** --- 1484,1493 ---- The hook is intended to mark an article as read (or unread) automatically when it is selected.") + (defvar gnus-group-change-level-function nil + "Function run when a group level is changed. + It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.") + ;; Remove any hilit infestation. (add-hook 'gnus-startup-hook (lambda () *************** *** 1449,1459 **** ;; Internal variables ! (defconst gnus-article-mark-lists ! '((marked . tick) (replied . reply) (expirable . expire) (killed . killed) (bookmarks . bookmark) (dormant . dormant) ! (scored . score) (saved . save))) ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) --- 1502,1515 ---- ;; Internal variables ! (defvar gnus-override-subscribe-method nil) ! ! (defconst gnus-article-mark-lists ! '((marked . tick) (replied . reply) (expirable . expire) (killed . killed) (bookmarks . bookmark) (dormant . dormant) ! (scored . score) (saved . save) ! (cached . cache))) ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) *************** *** 1487,1494 **** (defvar gnus-newsgroup-adaptive nil) (defvar gnus-summary-display-table nil) ! (defconst gnus-group-line-format-alist `((?M gnus-tmp-marked-mark ?c) (?S gnus-tmp-subscribed ?c) (?L gnus-tmp-level ?d) --- 1543,1554 ---- (defvar gnus-newsgroup-adaptive nil) (defvar gnus-summary-display-table nil) + (defvar gnus-summary-display-article-function nil) + + (defvar gnus-summary-highlight-line-function nil + "Function called after highlighting a summary line.") ! (defvar gnus-group-line-format-alist `((?M gnus-tmp-marked-mark ?c) (?S gnus-tmp-subscribed ?c) (?L gnus-tmp-level ?d) *************** *** 1513,1526 **** (?z gnus-tmp-news-method-string ?s) (?u gnus-tmp-user-defined ?s))) ! (defconst gnus-summary-line-format-alist `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) ?s) ! (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) --- 1573,1586 ---- (?z gnus-tmp-news-method-string ?s) (?u gnus-tmp-user-defined ?s))) ! (defvar gnus-summary-line-format-alist `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) ?s) ! (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) *************** *** 1539,1549 **** (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) (?i gnus-tmp-score ?d) (?z gnus-tmp-score-char ?c) (?U gnus-tmp-unread ?c) ! (?t (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level) ?d) ! (?e (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level t) ?c) (?u gnus-tmp-user-defined ?s)) --- 1599,1610 ---- (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) (?i gnus-tmp-score ?d) (?z gnus-tmp-score-char ?c) + (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) (?U gnus-tmp-unread ?c) ! (?t (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level) ?d) ! (?e (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level t) ?c) (?u gnus-tmp-user-defined ?s)) *************** *** 1551,1562 **** and what variables they correspond with, along with the type of the variable (string, integer, character, etc).") ! (defconst gnus-summary-dummy-line-format-alist (` ((?S gnus-tmp-subject ?s) (?N gnus-tmp-number ?d) (?u gnus-tmp-user-defined ?s)))) ! (defconst gnus-summary-mode-line-format-alist (` ((?G gnus-tmp-group-name ?s) (?g (gnus-short-group-name gnus-tmp-group-name) ?s) (?p (gnus-group-real-name gnus-tmp-group-name) ?s) --- 1612,1623 ---- and what variables they correspond with, along with the type of the variable (string, integer, character, etc).") ! (defvar gnus-summary-dummy-line-format-alist (` ((?S gnus-tmp-subject ?s) (?N gnus-tmp-number ?d) (?u gnus-tmp-user-defined ?s)))) ! (defvar gnus-summary-mode-line-format-alist (` ((?G gnus-tmp-group-name ?s) (?g (gnus-short-group-name gnus-tmp-group-name) ?s) (?p (gnus-group-real-name gnus-tmp-group-name) ?s) *************** *** 1573,1582 **** (?E gnus-newsgroup-expunged-tally ?d) (?s (gnus-current-score-file-nondirectory) ?s)))) ! (defconst gnus-article-mode-line-format-alist gnus-summary-mode-line-format-alist) ! (defconst gnus-group-mode-line-format-alist (` ((?S gnus-tmp-news-server ?s) (?M gnus-tmp-news-method ?s) (?u gnus-tmp-user-defined ?s)))) --- 1634,1643 ---- (?E gnus-newsgroup-expunged-tally ?d) (?s (gnus-current-score-file-nondirectory) ?s)))) ! (defvar gnus-article-mode-line-format-alist gnus-summary-mode-line-format-alist) ! (defvar gnus-group-mode-line-format-alist (` ((?S gnus-tmp-news-server ?s) (?M gnus-tmp-news-method ?s) (?u gnus-tmp-user-defined ?s)))) *************** *** 1587,1593 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.26" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1648,1654 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.27" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1617,1623 **** (defvar gnus-variable-list '(gnus-newsrc-options gnus-newsrc-options-n ! gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list gnus-topic-topology gnus-topic-alist --- 1678,1684 ---- (defvar gnus-variable-list '(gnus-newsrc-options gnus-newsrc-options-n ! gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list gnus-topic-topology gnus-topic-alist *************** *** 1628,1634 **** "Options line in the .newsrc file.") (defvar gnus-newsrc-options-n nil ! "List of regexps representing groups to be subscribed/ignored unconditionally.") (defvar gnus-newsrc-last-checked-date nil "Date Gnus last asked server for new newsgroups.") --- 1689,1695 ---- "Options line in the .newsrc file.") (defvar gnus-newsrc-options-n nil ! "List of regexps representing groups to be subscribed/ignored unconditionally.") (defvar gnus-newsrc-last-checked-date nil "Date Gnus last asked server for new newsgroups.") *************** *** 1754,1759 **** --- 1815,1822 ---- (defvar gnus-newsgroup-ancient nil "List of `gnus-fetch-old-headers' articles in the current newsgroup.") + (defvar gnus-newsgroup-sparse nil) + (defvar gnus-current-article nil) (defvar gnus-article-current nil) (defvar gnus-current-headers nil) *************** *** 1777,1803 **** (defvar gnus-dead-summary nil) ! (defconst gnus-summary-local-variables ! '(gnus-newsgroup-name ! gnus-newsgroup-begin gnus-newsgroup-end ! gnus-newsgroup-last-rmail gnus-newsgroup-last-mail ! gnus-newsgroup-last-folder gnus-newsgroup-last-file ! gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-threads ! gnus-newsgroup-prepared gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers ! gnus-newsgroup-async ! gnus-score-alist gnus-current-score-file gnus-summary-expunge-below gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) gnus-newsgroup-adaptive-score-file (gnus-newsgroup-expunged-tally . 0) --- 1840,1867 ---- (defvar gnus-dead-summary nil) ! (defconst gnus-summary-local-variables ! '(gnus-newsgroup-name ! gnus-newsgroup-begin gnus-newsgroup-end ! gnus-newsgroup-last-rmail gnus-newsgroup-last-mail ! gnus-newsgroup-last-folder gnus-newsgroup-last-file ! gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-threads ! gnus-newsgroup-prepared gnus-summary-highlight-line-function gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers ! gnus-newsgroup-async ! gnus-score-alist gnus-current-score-file gnus-summary-expunge-below gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient + gnus-newsgroup-sparse (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) gnus-newsgroup-adaptive-score-file (gnus-newsgroup-expunged-tally . 0) *************** *** 1811,1824 **** ======================================== The buffer below is a mail buffer. When you press `C-c C-c', it will ! be sent to the Gnus Bug Exterminators. At the bottom of the buffer you'll see lots of variable settings. Please do not delete those. They will tell the Bug People what your environment is, so that it will be easier to locate the bugs. If you have found a bug that makes Emacs go \"beep\", set ! debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') and include the backtrace in your bug report. Please describe the bug in annoying, painstaking detail. --- 1875,1888 ---- ======================================== The buffer below is a mail buffer. When you press `C-c C-c', it will ! be sent to the Gnus Bug Exterminators. At the bottom of the buffer you'll see lots of variable settings. Please do not delete those. They will tell the Bug People what your environment is, so that it will be easier to locate the bugs. If you have found a bug that makes Emacs go \"beep\", set ! debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') and include the backtrace in your bug report. Please describe the bug in annoying, painstaking detail. *************** *** 1833,1842 **** ;; This little mapcar goes through the list below and marks the ;; symbols in question as autoloaded functions. ! (mapcar (lambda (package) (let ((interactive (nth 1 (memq ':interactive package)))) ! (mapcar (lambda (function) (let (keymap) (when (consp function) --- 1897,1906 ---- ;; This little mapcar goes through the list below and marks the ;; symbols in question as autoloaded functions. ! (mapcar (lambda (package) (let ((interactive (nth 1 (memq ':interactive package)))) ! (mapcar (lambda (function) (let (keymap) (when (consp function) *************** *** 1857,1871 **** timezone-make-sortable-date timezone-make-time-string) ("sendmail" mail-position-on-field mail-setup) ("rmailout" rmail-output) ! ("rnewspost" news-mail-other-window news-reply-yank-original news-caesar-buffer-body) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages rmail-show-message) ("gnus-soup" :interactive t ! gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) ("nnsoup" nnsoup-pack-replies) ! ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive t gnus-summary-save-in-folder) ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar --- 1921,1935 ---- timezone-make-sortable-date timezone-make-time-string) ("sendmail" mail-position-on-field mail-setup) ("rmailout" rmail-output) ! ("rnewspost" news-mail-other-window news-reply-yank-original news-caesar-buffer-body) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages rmail-show-message) ("gnus-soup" :interactive t ! gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) ("nnsoup" nnsoup-pack-replies) ! ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive t gnus-summary-save-in-folder) ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar *************** *** 1873,1897 **** gnus-browse-make-menu-bar gnus-highlight-selected-summary gnus-summary-highlight-line gnus-carpal-setup-buffer gnus-article-add-button gnus-insert-next-page-button ! gnus-insert-prev-page-button) ("gnus-vis" :interactive t ! gnus-article-push-button gnus-article-press-button ! gnus-article-highlight gnus-article-highlight-some ! gnus-article-highlight-headers gnus-article-highlight-signature ! gnus-article-add-buttons gnus-article-add-buttons-to-head gnus-article-next-button gnus-article-prev-button) ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail gnus-demon-add-disconnection gnus-demon-add-handler gnus-demon-remove-handler) ("gnus-demon" :interactive t gnus-demon-init gnus-demon-cancel) ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close) ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info) ("gnus-cite" :interactive t ! gnus-article-highlight-citation gnus-article-hide-citation-maybe ! gnus-article-hide-citation) ! ("gnus-kill" gnus-kill gnus-apply-kill-file-internal ! gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge) ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers gnus-cache-possibly-remove-articles gnus-cache-request-article --- 1937,1964 ---- gnus-browse-make-menu-bar gnus-highlight-selected-summary gnus-summary-highlight-line gnus-carpal-setup-buffer gnus-article-add-button gnus-insert-next-page-button ! gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu) ("gnus-vis" :interactive t ! gnus-article-push-button gnus-article-press-button ! gnus-article-highlight gnus-article-highlight-some ! gnus-article-highlight-headers gnus-article-highlight-signature ! gnus-article-add-buttons gnus-article-add-buttons-to-head gnus-article-next-button gnus-article-prev-button) ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail gnus-demon-add-disconnection gnus-demon-add-handler gnus-demon-remove-handler) ("gnus-demon" :interactive t gnus-demon-init gnus-demon-cancel) + ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree + gnus-tree-open gnus-tree-close) ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close) ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info) + ("gnus-srvr" gnus-browse-foreign-server) ("gnus-cite" :interactive t ! gnus-article-highlight-citation gnus-article-hide-citation-maybe ! gnus-article-hide-citation gnus-article-fill-cited-article) ! ("gnus-kill" gnus-kill gnus-apply-kill-file-internal ! gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge) ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers gnus-cache-possibly-remove-articles gnus-cache-request-article *************** *** 1902,1934 **** gnus-cache-remove-article) ("gnus-score" :interactive t gnus-summary-increase-score gnus-summary-lower-score ! gnus-score-flush-cache gnus-score-close ! gnus-score-raise-same-subject-and-select ! gnus-score-raise-same-subject gnus-score-default ! gnus-score-raise-thread gnus-score-lower-same-subject-and-select ! gnus-score-lower-same-subject gnus-score-lower-thread gnus-possibly-score-headers) ! ("gnus-score" (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers gnus-current-score-file-nondirectory gnus-score-adaptive gnus-score-find-trace gnus-score-file-name) ("gnus-edit" :interactive t gnus-score-customize) ("gnus-topic" :interactive t gnus-topic-mode) ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) ("gnus-uu" :interactive t ! gnus-uu-digest-mail-forward gnus-uu-digest-post-forward ! gnus-uu-mark-series gnus-uu-mark-region ! gnus-uu-mark-by-regexp gnus-uu-mark-all ! gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu ! gnus-uu-decode-uu-and-save gnus-uu-decode-unshar ! gnus-uu-decode-unshar-and-save gnus-uu-decode-save ! gnus-uu-decode-binhex gnus-uu-decode-uu-view ! gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view ! gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view) ("gnus-msg" (gnus-summary-send-map keymap) gnus-mail-yank-original gnus-mail-send-and-exit ! gnus-sendmail-setup-mail gnus-article-mail gnus-inews-message-id gnus-new-mail gnus-mail-reply) ("gnus-msg" :interactive t gnus-group-post-news gnus-group-mail gnus-summary-post-news --- 1969,2003 ---- gnus-cache-remove-article) ("gnus-score" :interactive t gnus-summary-increase-score gnus-summary-lower-score ! gnus-score-flush-cache gnus-score-close ! gnus-score-raise-same-subject-and-select ! gnus-score-raise-same-subject gnus-score-default ! gnus-score-raise-thread gnus-score-lower-same-subject-and-select ! gnus-score-lower-same-subject gnus-score-lower-thread gnus-possibly-score-headers) ! ("gnus-score" (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers gnus-current-score-file-nondirectory gnus-score-adaptive gnus-score-find-trace gnus-score-file-name) ("gnus-edit" :interactive t gnus-score-customize) ("gnus-topic" :interactive t gnus-topic-mode) + ("gnus-topic" gnus-topic-remove-group) + ("gnus-salt" :interactive t gnus-pick-mode) ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) ("gnus-uu" :interactive t ! gnus-uu-digest-mail-forward gnus-uu-digest-post-forward ! gnus-uu-mark-series gnus-uu-mark-region ! gnus-uu-mark-by-regexp gnus-uu-mark-all ! gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu ! gnus-uu-decode-uu-and-save gnus-uu-decode-unshar ! gnus-uu-decode-unshar-and-save gnus-uu-decode-save ! gnus-uu-decode-binhex gnus-uu-decode-uu-view ! gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view ! gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view) ("gnus-msg" (gnus-summary-send-map keymap) gnus-mail-yank-original gnus-mail-send-and-exit ! gnus-sendmail-setup-mail gnus-article-mail gnus-inews-message-id gnus-new-mail gnus-mail-reply) ("gnus-msg" :interactive t gnus-group-post-news gnus-group-mail gnus-summary-post-news *************** *** 2052,2063 **** (setq gnus-init-inhibit nil) (setq gnus-init-inhibit inhibit-next) (and gnus-init-file ! (or (and (file-exists-p gnus-init-file) ;; Don't try to load a directory. (not (file-directory-p gnus-init-file))) (file-exists-p (concat gnus-init-file ".el")) (file-exists-p (concat gnus-init-file ".elc"))) ! (load gnus-init-file nil t)))) ;; Info access macros. --- 2121,2135 ---- (setq gnus-init-inhibit nil) (setq gnus-init-inhibit inhibit-next) (and gnus-init-file ! (or (and (file-exists-p gnus-init-file) ;; Don't try to load a directory. (not (file-directory-p gnus-init-file))) (file-exists-p (concat gnus-init-file ".el")) (file-exists-p (concat gnus-init-file ".elc"))) ! (condition-case var ! (load gnus-init-file nil t) ! (error ! (error "Error in %s: %s" gnus-init-file var)))))) ;; Info access macros. *************** *** 2119,2128 **** flist) (cons 'progn (cdr (cdr fval)))))) ! ;;; Load the user startup file. ! ;; (eval '(gnus-read-init-file 'inhibit)) ! ! ;;; Load the compatability functions. (require 'gnus-cus) (require 'gnus-ems) --- 2191,2197 ---- flist) (cons 'progn (cdr (cdr fval)))))) ! ;;; Load the compatability functions. (require 'gnus-cus) (require 'gnus-ems) *************** *** 2133,2139 **** ;; that are to be evaled as the result of the default format strings. ;; We write them in here to get them byte-compiled. That way the ;; default actions will be quite fast, while still retaining the full ! ;; flexibility of the user-defined format specs. ;; First we have lots of dummy defvars to let the compiler know these ;; are really dynamic variables. --- 2202,2208 ---- ;; that are to be evaled as the result of the default format strings. ;; We write them in here to get them byte-compiled. That way the ;; default actions will be quite fast, while still retaining the full ! ;; flexibility of the user-defined format specs. ;; First we have lots of dummy defvars to let the compiler know these ;; are really dynamic variables. *************** *** 2164,2187 **** (defvar gnus-mouse-face-prop) (defun gnus-summary-line-format-spec () ! (insert gnus-tmp-unread gnus-tmp-replied gnus-tmp-score-char gnus-tmp-indentation) (put-text-property (point) (progn ! (insert ! gnus-tmp-opening-bracket ! (format "%4d: %-20s" ! gnus-tmp-lines ! (if (> (length gnus-tmp-name) 20) ! (substring gnus-tmp-name 0 20) gnus-tmp-name)) gnus-tmp-closing-bracket) (point)) gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject-or-nil "\n")) ! (defvar gnus-summary-line-format-spec (gnus-byte-code 'gnus-summary-line-format-spec)) (defun gnus-summary-dummy-line-format-spec () --- 2233,2256 ---- (defvar gnus-mouse-face-prop) (defun gnus-summary-line-format-spec () ! (insert gnus-tmp-unread gnus-tmp-replied gnus-tmp-score-char gnus-tmp-indentation) (put-text-property (point) (progn ! (insert ! gnus-tmp-opening-bracket ! (format "%4d: %-20s" ! gnus-tmp-lines ! (if (> (length gnus-tmp-name) 20) ! (substring gnus-tmp-name 0 20) gnus-tmp-name)) gnus-tmp-closing-bracket) (point)) gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject-or-nil "\n")) ! (defvar gnus-summary-line-format-spec (gnus-byte-code 'gnus-summary-line-format-spec)) (defun gnus-summary-dummy-line-format-spec () *************** *** 2189,2217 **** (put-text-property (point) (progn ! (insert ": :") (point)) gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject "\n")) ! (defvar gnus-summary-dummy-line-format-spec (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) (defun gnus-group-line-format-spec () ! (insert gnus-tmp-marked-mark gnus-tmp-subscribed gnus-tmp-process-marked gnus-topic-indentation (format "%5s: " gnus-tmp-number-of-unread)) ! (put-text-property (point) (progn (insert gnus-tmp-group "\n") (1- (point))) gnus-mouse-face-prop gnus-mouse-face)) ! (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) ! (defvar gnus-format-specs `((version . ,emacs-version) (group ,gnus-group-line-format ,gnus-group-line-format-spec) (summary-dummy ,gnus-summary-dummy-line-format --- 2258,2286 ---- (put-text-property (point) (progn ! (insert ": :") (point)) gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject "\n")) ! (defvar gnus-summary-dummy-line-format-spec (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) (defun gnus-group-line-format-spec () ! (insert gnus-tmp-marked-mark gnus-tmp-subscribed gnus-tmp-process-marked gnus-topic-indentation (format "%5s: " gnus-tmp-number-of-unread)) ! (put-text-property (point) (progn (insert gnus-tmp-group "\n") (1- (point))) gnus-mouse-face-prop gnus-mouse-face)) ! (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) ! (defvar gnus-format-specs `((version . ,emacs-version) (group ,gnus-group-line-format ,gnus-group-line-format-spec) (summary-dummy ,gnus-summary-dummy-line-format *************** *** 2222,2228 **** (defvar gnus-summary-mode-line-format-spec nil) (defvar gnus-group-mode-line-format-spec nil) ! ;;; Phew. All that gruft is over, fortunately. ;;; --- 2291,2297 ---- (defvar gnus-summary-mode-line-format-spec nil) (defvar gnus-group-mode-line-format-spec nil) ! ;;; Phew. All that gruft is over, fortunately. ;;; *************** *** 2238,2261 **** (setq address (substring from (match-beginning 0) (match-end 0)))) ;; Then we check whether the "name
" format is used. (and address ! ;; Fix by MORIOKA Tomohiko ! ;; Linear white space is not required. ! (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) ! (and (setq name (substring from 0 (match-beginning 0))) ;; Strip any quotes from the name. (string-match "\".*\"" name) (setq name (substring name 1 (1- (match-end 0)))))) ;; If not, then "address (name)" is used. (or name (and (string-match "(.+)" from) ! (setq name (substring from (1+ (match-beginning 0)) (1- (match-end 0))))) (and (string-match "()" from) (setq name address)) ;; Fix by MORIOKA Tomohiko . ;; XOVER might not support folded From headers. (and (string-match "(.*" from) ! (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) ;; Fix by Hallvard B Furuseth . (list (or name from) (or address from)))) --- 2307,2330 ---- (setq address (substring from (match-beginning 0) (match-end 0)))) ;; Then we check whether the "name
" format is used. (and address ! ;; Fix by MORIOKA Tomohiko ! ;; Linear white space is not required. ! (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) ! (and (setq name (substring from 0 (match-beginning 0))) ;; Strip any quotes from the name. (string-match "\".*\"" name) (setq name (substring name 1 (1- (match-end 0)))))) ;; If not, then "address (name)" is used. (or name (and (string-match "(.+)" from) ! (setq name (substring from (1+ (match-beginning 0)) (1- (match-end 0))))) (and (string-match "()" from) (setq name address)) ;; Fix by MORIOKA Tomohiko . ;; XOVER might not support folded From headers. (and (string-match "(.*" from) ! (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) ;; Fix by Hallvard B Furuseth . (list (or name from) (or address from)))) *************** *** 2265,2287 **** (save-excursion (save-restriction (let ((case-fold-search t)) ! (gnus-narrow-to-headers) (mail-fetch-field field))))) (defun gnus-goto-colon () (beginning-of-line) (search-forward ":" (gnus-point-at-eol) t)) - (defun gnus-narrow-to-headers () - "Narrow to the head of an article." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (goto-char (point-min))) - ;;;###autoload (defun gnus-update-format (var) "Update the format specification near point." --- 2334,2346 ---- (save-excursion (save-restriction (let ((case-fold-search t)) ! (nnheader-narrow-to-headers) (mail-fetch-field field))))) (defun gnus-goto-colon () (beginning-of-line) (search-forward ":" (gnus-point-at-eol) t)) ;;;###autoload (defun gnus-update-format (var) "Update the format specification near point." *************** *** 2298,2304 **** (match-string 1 var)))) (entry (assq type gnus-format-specs)) value spec) ! (when entry (setq gnus-format-specs (delq entry gnus-format-specs))) (set (intern (format "%s-spec" var)) --- 2357,2363 ---- (match-string 1 var)))) (entry (assq type gnus-format-specs)) value spec) ! (when entry (setq gnus-format-specs (delq entry gnus-format-specs))) (set (intern (format "%s-spec" var)) *************** *** 2325,2331 **** (cdr (assq 'version gnus-format-specs)))))) (setq gnus-format-specs nil)) ! (let ((types '(summary summary-dummy group summary-mode group-mode article-mode)) old-format new-format entry type val) (while types --- 2384,2390 ---- (cdr (assq 'version gnus-format-specs)))))) (setq gnus-format-specs nil)) ! (let ((types '(summary summary-dummy group summary-mode group-mode article-mode)) old-format new-format entry type val) (while types *************** *** 2335,2359 **** (setq entry (cdr (assq type gnus-format-specs))) (if (and entry (equal (car entry) new-format)) ! (set (intern (format "gnus-%s-line-format-spec" type)) (car (cdr entry))) (setq val ! (if (not (stringp new-format)) ;; This is a function call or something. new-format ;; This is a "real" format. (gnus-parse-format new-format ! (symbol-value (intern (format "gnus-%s-line-format-alist" (if (eq type 'article-mode) 'summary-mode type)))) (not (string-match "mode$" (symbol-name type)))))) (set (intern (format "gnus-%s-line-format-spec" type)) val) ! (if entry (setcar (cdr entry) val) (push (list type new-format val) gnus-format-specs))))) ! (gnus-update-group-mark-positions) (gnus-update-summary-mark-positions) --- 2394,2418 ---- (setq entry (cdr (assq type gnus-format-specs))) (if (and entry (equal (car entry) new-format)) ! (set (intern (format "gnus-%s-line-format-spec" type)) (car (cdr entry))) (setq val ! (if (not (stringp new-format)) ;; This is a function call or something. new-format ;; This is a "real" format. (gnus-parse-format new-format ! (symbol-value (intern (format "gnus-%s-line-format-alist" (if (eq type 'article-mode) 'summary-mode type)))) (not (string-match "mode$" (symbol-name type)))))) (set (intern (format "gnus-%s-line-format-spec" type)) val) ! (if entry (setcar (cdr entry) val) (push (list type new-format val) gnus-format-specs))))) ! (gnus-update-group-mark-positions) (gnus-update-summary-mark-positions) *************** *** 2371,2377 **** (gnus-visual nil) pos) (gnus-set-work-buffer) ! (gnus-summary-insert-line [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) --- 2430,2436 ---- (gnus-visual nil) pos) (gnus-set-work-buffer) ! (gnus-summary-insert-line [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) *************** *** 2405,2411 **** (defun gnus-mouse-face-function (form type) `(put-text-property (point) (progn ,@form (point)) ! gnus-mouse-face-prop ,(if (equal type 0) 'gnus-mouse-face `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) --- 2464,2470 ---- (defun gnus-mouse-face-function (form type) `(put-text-property (point) (progn ,@form (point)) ! gnus-mouse-face-prop ,(if (equal type 0) 'gnus-mouse-face `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) *************** *** 2439,2445 **** ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. If the FORMAT string contains the specifiers %( and %) ;; the text between them will have the mouse-face text property. ! (if (string-match "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" format) (gnus-parse-complex-format format spec-alist) --- 2498,2504 ---- ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. If the FORMAT string contains the specifiers %( and %) ;; the text between them will have the mouse-face text property. ! (if (string-match "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" format) (gnus-parse-complex-format format spec-alist) *************** *** 2477,2491 **** (gnus-parse-simple-format sform spec-alist t) (funcall (intern (format "gnus-%s-face-function" (car sform))) ! (gnus-complex-form-to-spec (cdr (cdr sform)) spec-alist) (nth 1 sform)))) form))) ! (defun gnus-parse-simple-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return a ! ;; string. (let ((max-width 0) spec flist fstring newspec elem beg result dontinsert) (save-excursion --- 2536,2550 ---- (gnus-parse-simple-format sform spec-alist t) (funcall (intern (format "gnus-%s-face-function" (car sform))) ! (gnus-complex-form-to-spec (cdr (cdr sform)) spec-alist) (nth 1 sform)))) form))) ! (defun gnus-parse-simple-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return a ! ;; string. (let ((max-width 0) spec flist fstring newspec elem beg result dontinsert) (save-excursion *************** *** 2501,2509 **** ;; "%12,12A", ie. with a "max width specification". These have ;; to be treated specially. (if (setq beg (match-beginning 1)) ! (setq max-width ! (string-to-int ! (buffer-substring (1+ (match-beginning 1)) (match-end 1)))) (setq max-width 0) (setq beg (match-beginning 2))) --- 2560,2568 ---- ;; "%12,12A", ie. with a "max width specification". These have ;; to be treated specially. (if (setq beg (match-beginning 1)) ! (setq max-width ! (string-to-int ! (buffer-substring (1+ (match-beginning 1)) (match-end 1)))) (setq max-width 0) (setq beg (match-beginning 2))) *************** *** 2513,2535 **** ;; Treat user defined format specifiers specially. (when (eq (car elem) 'gnus-tmp-user-defined) (setq elem ! (list (list (intern (concat "gnus-user-format-function-" (match-string 3))) 'gnus-tmp-header) ?s)) (delete-region (match-beginning 3) (match-end 3))) (if (not (zerop max-width)) (let ((el (car elem))) ! (cond ((= (car (cdr elem)) ?c) (setq el (list 'char-to-string el))) ((= (car (cdr elem)) ?d) ! (numberp el) (setq el (list 'int-to-string el)))) (setq flist (cons (gnus-max-width-function el max-width) flist)) (setq newspec ?s)) ! (progn ! (setq flist (cons (car elem) flist)) ! (setq newspec (car (cdr elem)))))) ;; Remove the old specification (and possibly a ",12" string). (delete-region beg (match-end 2)) ;; Insert the new specification. --- 2572,2594 ---- ;; Treat user defined format specifiers specially. (when (eq (car elem) 'gnus-tmp-user-defined) (setq elem ! (list (list (intern (concat "gnus-user-format-function-" (match-string 3))) 'gnus-tmp-header) ?s)) (delete-region (match-beginning 3) (match-end 3))) (if (not (zerop max-width)) (let ((el (car elem))) ! (cond ((= (car (cdr elem)) ?c) (setq el (list 'char-to-string el))) ((= (car (cdr elem)) ?d) ! (setq el (list 'int-to-string el)))) (setq flist (cons (gnus-max-width-function el max-width) flist)) (setq newspec ?s)) ! (progn ! (setq flist (cons (car elem) flist)) ! (setq newspec (car (cdr elem)))))) ;; Remove the old specification (and possibly a ",12" string). (delete-region beg (match-end 2)) ;; Insert the new specification. *************** *** 2537,2545 **** (insert newspec)) (setq fstring (buffer-substring 1 (point-max)))) ;; Do some postprocessing to increase efficiency. ! (setq result ! (cond ;; Emptyness. ((string= fstring "") nil) --- 2596,2604 ---- (insert newspec)) (setq fstring (buffer-substring 1 (point-max)))) ;; Do some postprocessing to increase efficiency. ! (setq result ! (cond ;; Emptyness. ((string= fstring "") nil) *************** *** 2635,2641 **** (defun gnus-numeric-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ! ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." (let ((default (expand-file-name (concat (if (gnus-use-long-file-name 'not-save) --- 2694,2700 ---- (defun gnus-numeric-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ! ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." (let ((default (expand-file-name (concat (if (gnus-use-long-file-name 'not-save) *************** *** 2686,2711 **** (setq start (1- (length prefix))) (if (and (string-match "[^\\.]\\." (car groups) start) (cdr groups) ! (setq prefix (concat "^" (substring (car groups) 0 (match-end 0)))) (string-match prefix (car (cdr groups)))) (progn (setq prefixes (cons prefix prefixes)) ! (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix)))) (setq ans (read-char)) (cond ((= ans ?n) ! (while (and groups ! (string-match prefix (setq group (car groups)))) ! (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups))) (setq starts (cdr starts))) ((= ans ?s) ! (while (and groups ! (string-match prefix (setq group (car groups)))) (gnus-sethash group group gnus-killed-hashtb) (gnus-subscribe-alphabetically (car groups)) --- 2745,2770 ---- (setq start (1- (length prefix))) (if (and (string-match "[^\\.]\\." (car groups) start) (cdr groups) ! (setq prefix (concat "^" (substring (car groups) 0 (match-end 0)))) (string-match prefix (car (cdr groups)))) (progn (setq prefixes (cons prefix prefixes)) ! (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix)))) (setq ans (read-char)) (cond ((= ans ?n) ! (while (and groups ! (string-match prefix (setq group (car groups)))) ! (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups))) (setq starts (cdr starts))) ((= ans ?s) ! (while (and groups ! (string-match prefix (setq group (car groups)))) (gnus-sethash group group gnus-killed-hashtb) (gnus-subscribe-alphabetically (car groups)) *************** *** 2730,2736 **** (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) ! (t (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb))) (setq groups (cdr groups))))))) --- 2789,2795 ---- (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) ! (t (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb))) (setq groups (cdr groups))))))) *************** *** 2741,2747 **** (defun gnus-subscribe-alphabetically (newgroup) "Subscribe new NEWSGROUP and insert it in alphabetical order." - ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (let ((groups (cdr gnus-newsrc-alist)) before) (while (and (not before) groups) --- 2800,2805 ---- *************** *** 2789,2798 **** (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. ! If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. ! (gnus-group-change-level newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)) --- 2847,2856 ---- (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. ! If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. ! (gnus-group-change-level newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)) *************** *** 2805,2811 **** (len (length newsgroup)) idx) ;; If this is a foreign group, we don't want to translate the ! ;; entire name. (if (setq idx (string-match ":" newsgroup)) (aset newsgroup idx ?/) (setq idx 0)) --- 2863,2869 ---- (len (length newsgroup)) idx) ;; If this is a foreign group, we don't want to translate the ! ;; entire name. (if (setq idx (string-match ":" newsgroup)) (aset newsgroup idx ?/) (setq idx 0)) *************** *** 2819,2829 **** (defun gnus-newsgroup-saveable-name (group) ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) ;; with dots. ! (gnus-replace-chars-in-string group ?/ ?.)) (defun gnus-make-directory (dir) "Make DIRECTORY recursively." ! ;; Why don't we use `(make-directory dir 'parents)'? That's just one ;; of the many mysteries of the universe. (let* ((dir (expand-file-name dir default-directory)) dirs err) --- 2877,2887 ---- (defun gnus-newsgroup-saveable-name (group) ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) ;; with dots. ! (nnheader-replace-chars-in-string group ?/ ?.)) (defun gnus-make-directory (dir) "Make DIRECTORY recursively." ! ;; Why don't we use `(make-directory dir 'parents)'? That's just one ;; of the many mysteries of the universe. (let* ((dir (expand-file-name dir default-directory)) dirs err) *************** *** 2840,2846 **** (make-directory (car dirs)) (error (setq err t))) (setq dirs (cdr dirs))) ! ;; We return whether we were successful or not. (not dirs))) (defun gnus-capitalize-newsgroup (newsgroup) --- 2898,2904 ---- (make-directory (car dirs)) (error (setq err t))) (setq dirs (cdr dirs))) ! ;; We return whether we were successful or not. (not dirs))) (defun gnus-capitalize-newsgroup (newsgroup) *************** *** 2849,2867 **** (concat (char-to-string (upcase (aref newsgroup 0))) (substring newsgroup 1)))) ! ;; Var (defun gnus-simplify-subject (subject &optional re-only) "Remove `Re:' and words in parentheses. ! If optional argument RE-ONLY is non-nil, strip `Re:' only." (let ((case-fold-search t)) ;Ignore case. ! ;; Remove `Re:' and `Re^N:'. ! (if (string-match "^re:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) ;; Remove words in parentheses from end. ! (or re-only ! (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) ! (setq subject (substring subject 0 (match-beginning 0))))) ;; Return subject string. subject)) --- 2907,2930 ---- (concat (char-to-string (upcase (aref newsgroup 0))) (substring newsgroup 1)))) ! ;; Various... things. (defun gnus-simplify-subject (subject &optional re-only) "Remove `Re:' and words in parentheses. ! If RE-ONLY is non-nil, strip leading `Re:'s only." (let ((case-fold-search t)) ;Ignore case. ! ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. ! (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) ! (setq subject (substring subject (match-end 0)))) ! ;; Remove uninteresting prefixes. ! (if (and (not re-only) ! gnus-simplify-ignored-prefixes ! (string-match gnus-simplify-ignored-prefixes subject)) (setq subject (substring subject (match-end 0)))) ;; Remove words in parentheses from end. ! (unless re-only ! (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) ! (setq subject (substring subject 0 (match-beginning 0))))) ;; Return subject string. subject)) *************** *** 2881,2887 **** (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t) (goto-char (match-end 0)) (delete-char -1) ! (delete-region (progn (goto-char (match-beginning 0))) (re-search-forward ":")))) (goto-char (point-min)) --- 2944,2950 ---- (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t) (goto-char (match-end 0)) (delete-char -1) ! (delete-region (progn (goto-char (match-beginning 0))) (re-search-forward ":")))) (goto-char (point-min)) *************** *** 2917,2923 **** (inline (gnus-simplify-buffer-fuzzy)) (buffer-string)))) ! ;; Add the current buffer to the list of buffers to be killed on exit. (defun gnus-add-current-to-buffer-list () (or (memq (current-buffer) gnus-buffer-list) (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))) --- 2980,2986 ---- (inline (gnus-simplify-buffer-fuzzy)) (buffer-string)))) ! ;; Add the current buffer to the list of buffers to be killed on exit. (defun gnus-add-current-to-buffer-list () (or (memq (current-buffer) gnus-buffer-list) (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))) *************** *** 2926,2964 **** (not (or (string< s1 s2) (string= s1 s2)))) - ;; Functions accessing headers. - ;; Functions are more convenient than macros in some cases. - - (defun gnus-header-number (header) - (mail-header-number header)) - - (defun gnus-header-subject (header) - (mail-header-subject header)) - - (defun gnus-header-from (header) - (mail-header-from header)) - - (defun gnus-header-xref (header) - (mail-header-xref header)) - - (defun gnus-header-lines (header) - (mail-header-lines header)) - - (defun gnus-header-date (header) - (mail-header-date header)) - - (defun gnus-header-id (header) - (mail-header-id header)) - - (defun gnus-header-message-id (header) - (mail-header-id header)) - - (defun gnus-header-chars (header) - (mail-header-chars header)) - - (defun gnus-header-references (header) - (mail-header-references header)) - ;;; General various misc type functions. (defun gnus-clear-system () --- 2989,2994 ---- *************** *** 3012,3018 **** (defun gnus-windows-old-to-new (setting) ;; First we take care of the really, really old Gnus 3 actions. (if (symbolp setting) ! (setq setting (cond ((memq setting '(SelectArticle)) 'article) ((memq setting '(SelectSubject ExpandSubject)) --- 3042,3048 ---- (defun gnus-windows-old-to-new (setting) ;; First we take care of the really, really old Gnus 3 actions. (if (symbolp setting) ! (setq setting (cond ((memq setting '(SelectArticle)) 'article) ((memq setting '(SelectSubject ExpandSubject)) *************** *** 3024,3030 **** (not (and gnus-window-configuration (memq setting '(group summary article))))) setting ! (let* ((setting (if (eq setting 'group) (if (assq 'newsgroup gnus-window-configuration) 'newsgroup 'newsgroups) setting)) --- 3054,3060 ---- (not (and gnus-window-configuration (memq setting '(group summary article))))) setting ! (let* ((setting (if (eq setting 'group) (if (assq 'newsgroup gnus-window-configuration) 'newsgroup 'newsgroups) setting)) *************** *** 3039,3057 **** (or (not (numberp (nth i elem))) (zerop (nth i elem)) (progn ! (setq perc (/ (* 1.0 (nth 0 elem)) total)) (setq out (cons (if (eq pbuf (nth i types)) (vector (nth i types) perc 'point) (vector (nth i types) perc)) out)))) (setq i (1+ i))) (list (nreverse out))))) ! (defun gnus-add-configuration (conf) ! (setq gnus-buffer-configuration (cons conf (delq (assq (car conf) gnus-buffer-configuration) gnus-buffer-configuration)))) (defun gnus-configure-frame (split &optional window) "Split WINDOW according to SPLIT." (unless window --- 3069,3090 ---- (or (not (numberp (nth i elem))) (zerop (nth i elem)) (progn ! (setq perc (/ (float (nth 0 elem)) total)) (setq out (cons (if (eq pbuf (nth i types)) (vector (nth i types) perc 'point) (vector (nth i types) perc)) out)))) (setq i (1+ i))) (list (nreverse out))))) ! (defun gnus-add-configuration (conf) ! "Add the window configuration CONF to `gnus-buffer-configuration'." ! (setq gnus-buffer-configuration (cons conf (delq (assq (car conf) gnus-buffer-configuration) gnus-buffer-configuration)))) + (defvar gnus-frame-list nil) + (defun gnus-configure-frame (split &optional window) "Split WINDOW according to SPLIT." (unless window *************** *** 3064,3084 **** (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 (car split)) ! (subs (cdr (cdr split))) ! (len (if (eq type 'horizontal) (window-width) (window-height) )) (total 0) s result new-win rest comp-subs size sub) (cond ;; Nothing to do here. ((null split)) ;; This is a buffer to be selected. ! ((not (or (eq type 'horizontal) (eq type 'vertical))) (let ((buffer (cond ((stringp type) type) (t (cdr (assq type gnus-window-to-buffer))))) buf) --- 3097,3122 ---- (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 (car split)) ! (subs (cddr split)) ! (len (if (eq type 'horizontal) (window-width) (window-height))) (total 0) + (window-min-width (or gnus-window-min-width window-min-width)) + (window-min-height (or gnus-window-min-height window-min-height)) s result new-win rest comp-subs size sub) (cond ;; Nothing to do here. ((null split)) + ;; Don't switch buffers. + ((null type) + (and (memq 'point split) window)) ;; This is a buffer to be selected. ! ((not (memq type '(frame horizontal vertical))) (let ((buffer (cond ((stringp type) type) (t (cdr (assq type gnus-window-to-buffer))))) buf) *************** *** 3091,3096 **** --- 3129,3161 ---- (switch-to-buffer buf) ;; We return the window if it has the `point' spec. (and (memq 'point split) window))) + ;; This is a frame split. + ((eq type 'frame) + (unless gnus-frame-list + (setq gnus-frame-list (list (window-frame + (get-buffer-window (current-buffer)))))) + (let ((i 0) + params frame fresult) + (while (< i (length subs)) + ;; Frame parameter is gotten from the sub-split. + (setq params (cadr (elt subs i))) + ;; It should be a list. + (unless (listp params) + (setq params nil)) + ;; Create a new frame? + (unless (setq frame (elt gnus-frame-list i)) + (nconc gnus-frame-list (list (setq frame (make-frame params))))) + ;; Is the old frame still alive? + (unless (frame-live-p frame) + (setcar (nthcdr i gnus-frame-list) + (setq frame (make-frame params)))) + ;; Select the frame in question and do more splits there. + (select-frame frame) + (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) + (incf i)) + ;; Select the frame that has the selected buffer. + (when fresult + (select-frame (window-frame fresult))))) ;; This is a normal split. (t (when (> (length subs) 0) *************** *** 3114,3125 **** (error "Illegal size: %s" size))) ;; Try to make sure that we are inside the safe limits. (cond ((zerop s)) ! ((and (eq type 'horizontal) ! (< s 10)) ! (setq s 10)) ! ((and (eq type 'vertical) ! (< s 4)) ! (setq s 4))) (setcar (cdar comp-subs) s) (incf total s))) ;; Take care of the "1.0" spec. --- 3179,3188 ---- (error "Illegal size: %s" size))) ;; Try to make sure that we are inside the safe limits. (cond ((zerop s)) ! ((eq type 'horizontal) ! (setq s (max s window-min-width))) ! ((eq type 'vertical) ! (setq s (max s window-min-height)))) (setcar (cdar comp-subs) s) (incf total s))) ;; Take care of the "1.0" spec. *************** *** 3135,3141 **** (setq new-win (split-window window (cadar comp-subs) (eq type 'horizontal)))) ! (setq result (or (gnus-configure-frame (car comp-subs) window) result)) (select-window new-win) (setq window new-win) --- 3198,3204 ---- (setq new-win (split-window window (cadar comp-subs) (eq type 'horizontal)))) ! (setq result (or (gnus-configure-frame (car comp-subs) window) result)) (select-window new-win) (setq window new-win) *************** *** 3159,3165 **** (if (and (not force) (setq all-visible (gnus-all-windows-visible-p split))) ;; All the windows mentioned are already visible, so we just ;; put point in the assigned buffer, and do not touch the ! ;; winconf. (select-window all-visible) ;; Either remove all windows or just remove all Gnus windows. --- 3222,3228 ---- (if (and (not force) (setq all-visible (gnus-all-windows-visible-p split))) ;; All the windows mentioned are already visible, so we just ;; put point in the assigned buffer, and do not touch the ! ;; winconf. (select-window all-visible) ;; Either remove all windows or just remove all Gnus windows. *************** *** 3178,3184 **** (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))) --- 3241,3247 ---- (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))) *************** *** 3193,3199 **** win buf) (unless buffer (error "Illegal buffer type: %s" type)) ! (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer) buffer))) (setq win (get-buffer-window buf))) (when win --- 3256,3262 ---- win buf) (unless buffer (error "Illegal buffer type: %s" type)) ! (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer) buffer))) (setq win (get-buffer-window buf))) (when win *************** *** 3224,3230 **** (setq buf (cdr (car buffers))) (if (symbolp buf) (setq buf (and (boundp buf) (symbol-value buf)))) ! (and buf (get-buffer-window buf) (progn (setq bufs (cons buf bufs)) --- 3287,3293 ---- (setq buf (cdr (car buffers))) (if (symbolp buf) (setq buf (and (boundp buf) (symbol-value buf)))) ! (and buf (get-buffer-window buf) (progn (setq bufs (cons buf bufs)) *************** *** 3240,3246 **** (walk-windows (lambda (win) (let ((buf (window-buffer win))) ! (if (string-match "^\\*Summary" (buffer-name buf)) (progn (setq bufs (cons buf bufs)) (pop-to-buffer buf) --- 3303,3309 ---- (walk-windows (lambda (win) (let ((buf (window-buffer win))) ! (if (string-match "^\\*Summary" (buffer-name buf)) (progn (setq bufs (cons buf bufs)) (pop-to-buffer buf) *************** *** 3249,3255 **** (progn (setq lowest-buf buf) (setq lowest (gnus-window-top-edge)))))))))) ! (and lowest-buf (progn (pop-to-buffer lowest-buf) (switch-to-buffer nntp-server-buffer))) --- 3312,3318 ---- (progn (setq lowest-buf buf) (setq lowest (gnus-window-top-edge)))))))))) ! (and lowest-buf (progn (pop-to-buffer lowest-buf) (switch-to-buffer nntp-server-buffer))) *************** *** 3257,3263 **** (and (not (eq (car bufs) lowest-buf)) (delete-windows-on (car bufs))) (setq bufs (cdr bufs)))))) ! (defun gnus-version () "Version numbers of this version of Gnus." (interactive) --- 3320,3326 ---- (and (not (eq (car bufs) lowest-buf)) (delete-windows-on (car bufs))) (setq bufs (cdr bufs)))))) ! (defun gnus-version () "Version numbers of this version of Gnus." (interactive) *************** *** 3267,3273 **** ;; Go through all the legal select methods and add their version ;; numbers to the total version string. Only the backends that are ;; currently in use will have their message numbers taken into ! ;; consideration. (while methods (setq meth (intern (concat (car (car methods)) "-version"))) (and (boundp meth) --- 3330,3336 ---- ;; Go through all the legal select methods and add their version ;; numbers to the total version string. Only the backends that are ;; currently in use will have their message numbers taken into ! ;; consideration. (while methods (setq meth (intern (concat (car (car methods)) "-version"))) (and (boundp meth) *************** *** 3284,3305 **** (gnus-configure-windows 'info) (Info-goto-node (car (cdr (assq mode gnus-info-nodes)))))) - (defun gnus-replace-chars-in-string (string &rest pairs) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0) - sym to) - (or (zerop (% (length pairs) 2)) - (error "Odd number of translation pairs")) - (setplist 'sym pairs) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (if (setq to (get 'sym (aref string idx))) - (aset string idx to)) - (setq idx (1+ idx))) - string)) - (defun gnus-days-between (date1 date2) ;; Return the number of days between date1 and date2. (- (gnus-day-number date1) (gnus-day-number date2))) --- 3347,3352 ---- *************** *** 3307,3333 **** (defun gnus-day-number (date) (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) (timezone-parse-date date)))) ! (timezone-absolute-from-gregorian (nth 1 dat) (nth 2 dat) (car dat)))) ! ;; Returns a floating point number that says how many seconds have ! ;; lapsed between Jan 1 12:00:00 1970 and DATE. ! (defun gnus-seconds-since-epoch (date) ! (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) ! (timezone-parse-date date))) ! (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) ! (timezone-parse-time ! (aref (timezone-parse-date date) 3)))) ! (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) ! (timezone-parse-date "Jan 1 12:00:00 1970"))) ! (tday (- (timezone-absolute-from-gregorian ! (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) ! (timezone-absolute-from-gregorian ! (nth 1 edate) (nth 2 edate) (nth 0 edate))))) ! (+ (nth 2 ttime) ! (* (nth 1 ttime) 60) ! (* 1.0 (nth 0 ttime) 60 60) ! (* 1.0 tday 60 60 24)))) (defun gnus-file-newer-than (file date) (let ((fdate (nth 5 (file-attributes file)))) --- 3354,3375 ---- (defun gnus-day-number (date) (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) (timezone-parse-date date)))) ! (timezone-absolute-from-gregorian (nth 1 dat) (nth 2 dat) (car dat)))) ! (defun gnus-encode-date (date) ! "Convert DATE to internal time." ! (let* ((parse (timezone-parse-date date)) ! (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) ! (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) ! (encode-time (caddr time) (cadr time) (car time) ! (caddr date) (cadr date) (car date) (nth 4 date)))) ! ! (defun gnus-time-minus (t1 t2) ! "Subtract two internal times." ! (let ((borrow (< (cadr t1) (cadr t2)))) ! (list (- (car t1) (car t2) (if borrow 1 0)) ! (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) (defun gnus-file-newer-than (file date) (let ((fdate (nth 5 (file-attributes file)))) *************** *** 3335,3343 **** (and (= (car fdate) (car date)) (> (nth 1 fdate) (nth 1 date)))))) (defun gnus-group-read-only-p (&optional group) "Check whether GROUP supports editing or not. ! If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note that that variable is buffer-local to the summary buffers." (let ((group (or group gnus-newsgroup-name))) (not (gnus-check-backend-function 'request-replace-article group)))) --- 3377,3405 ---- (and (= (car fdate) (car date)) (> (nth 1 fdate) (nth 1 date)))))) + (defmacro gnus-define-keys (keymap &rest plist) + "Define all keys in PLIST in KEYMAP." + `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) + + (defun gnus-define-keys-1 (keymap plist) + (when (null keymap) + (error "Can't set keys in a null keymap")) + (cond ((symbolp keymap) + (setq keymap (symbol-value keymap))) + ((listp keymap) + (set (car keymap) nil) + (define-prefix-command (car keymap)) + (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) + (setq keymap (symbol-value (car keymap))))) + (let (key) + (while plist + (when (symbolp (setq key (pop plist))) + (setq key (symbol-value key))) + (define-key keymap key (pop plist))))) + (defun gnus-group-read-only-p (&optional group) "Check whether GROUP supports editing or not. ! If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note that that variable is buffer-local to the summary buffers." (let ((group (or group gnus-newsgroup-name))) (not (gnus-check-backend-function 'request-replace-article group)))) *************** *** 3345,3351 **** (defun gnus-group-total-expirable-p (group) "Check whether GROUP is total-expirable or not." (let ((params (gnus-info-params (gnus-get-info group)))) ! (or (memq 'total-expire params) (cdr (assq 'total-expire params)) ; (total-expire . t) (and gnus-total-expirable-newsgroups ; Check var. (string-match gnus-total-expirable-newsgroups group))))) --- 3407,3413 ---- (defun gnus-group-total-expirable-p (group) "Check whether GROUP is total-expirable or not." (let ((params (gnus-info-params (gnus-get-info group)))) ! (or (memq 'total-expire params) (cdr (assq 'total-expire params)) ; (total-expire . t) (and gnus-total-expirable-newsgroups ; Check var. (string-match gnus-total-expirable-newsgroups group))))) *************** *** 3353,3363 **** (defun gnus-group-auto-expirable-p (group) "Check whether GROUP is total-expirable or not." (let ((params (gnus-info-params (gnus-get-info group)))) ! (or (memq 'auto-expire params) (cdr (assq 'auto-expire params)) ; (auto-expire . t) (and gnus-auto-expirable-newsgroups ; Check var. (string-match gnus-auto-expirable-newsgroups group))))) (defsubst gnus-simplify-subject-fully (subject) "Simplify a subject string according to the user's wishes." (cond --- 3415,3430 ---- (defun gnus-group-auto-expirable-p (group) "Check whether GROUP is total-expirable or not." (let ((params (gnus-info-params (gnus-get-info group)))) ! (or (memq 'auto-expire params) (cdr (assq 'auto-expire params)) ; (auto-expire . t) (and gnus-auto-expirable-newsgroups ; Check var. (string-match gnus-auto-expirable-newsgroups group))))) + (defun gnus-virtual-group-p (group) + "Say whether GROUP is virtual or not." + (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) + gnus-valid-select-methods))) + (defsubst gnus-simplify-subject-fully (subject) "Simplify a subject string according to the user's wishes." (cond *************** *** 3366,3376 **** ((eq gnus-summary-gather-subject-limit 'fuzzy) (gnus-simplify-subject-fuzzy subject)) ((numberp gnus-summary-gather-subject-limit) ! (gnus-limit-string subject gnus-summary-gather-subject-limit)) (t subject))) ! (defsubst gnus-subject-equal (s1 s2 &optional simple-first) "Check whether two subjects are equal. If optional argument simple-first is t, first argument is already simplified." (cond --- 3433,3444 ---- ((eq gnus-summary-gather-subject-limit 'fuzzy) (gnus-simplify-subject-fuzzy subject)) ((numberp gnus-summary-gather-subject-limit) ! (gnus-limit-string (gnus-simplify-subject-re subject) ! gnus-summary-gather-subject-limit)) (t subject))) ! (defsubst gnus-subject-equal (s1 s2 &optional simple-first) "Check whether two subjects are equal. If optional argument simple-first is t, first argument is already simplified." (cond *************** *** 3410,3416 **** ;; If it isn't a list, then we return t. (or (not (listp gnus-use-long-file-name)) ;; If it is a list, and the list contains `symbol', we ! ;; return nil. (not (memq symbol gnus-use-long-file-name))))) ;; I suspect there's a better way, but I haven't taken the time to do --- 3478,3484 ---- ;; If it isn't a list, then we return t. (or (not (listp gnus-use-long-file-name)) ;; If it is a list, and the list contains `symbol', we ! ;; return nil. (not (memq symbol gnus-use-long-file-name))))) ;; I suspect there's a better way, but I haven't taken the time to do *************** *** 3421,3427 **** (format "%2s-%s" (or (aref datevec 2) "??") (capitalize ! (or (car (nth (1- (string-to-number (aref datevec 1))) timezone-months-assoc)) "???"))))) --- 3489,3495 ---- (format "%2s-%s" (or (aref datevec 2) "??") (capitalize ! (or (car (nth (1- (string-to-number (aref datevec 1))) timezone-months-assoc)) "???"))))) *************** *** 3439,3446 **** (setq i (* 2 i))) (1- i))) ! ;; Show message if message has a lower level than `gnus-verbose'. ! ;; Guide-line for numbers: ;; 1 - error messages, 3 - non-serious error messages, 5 - messages ;; for things that take a long time, 7 - not very important messages ;; on stuff, 9 - messages inside loops. --- 3507,3514 ---- (setq i (* 2 i))) (1- i))) ! ;; Show message if message has a lower level than `gnus-verbose'. ! ;; Guideline for numbers: ;; 1 - error messages, 3 - non-serious error messages, 5 - messages ;; for things that take a long time, 7 - not very important messages ;; on stuff, 9 - messages inside loops. *************** *** 3477,3485 **** (defun gnus-parent-id (references) "Return the last Message-ID in REFERENCES." ! (and references ! (string-match "\\(<[^<>]+>\\) *$" references) ! (substring references (match-beginning 1) (match-end 1)))) (defun gnus-ephemeral-group-p (group) "Say whether GROUP is ephemeral or not." --- 3545,3562 ---- (defun gnus-parent-id (references) "Return the last Message-ID in REFERENCES." ! (when (and references ! (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references)) ! (substring references (match-beginning 1) (match-end 1)))) ! ! (defun gnus-split-references (references) ! "Return a list of Message-IDs in REFERENCES." ! (let ((beg 0) ! ids) ! (while (string-match "<[^>]+>" references beg) ! (push (substring references (match-beginning 0) (setq beg (match-end 0))) ! ids)) ! (nreverse ids))) (defun gnus-ephemeral-group-p (group) "Say whether GROUP is ephemeral or not." *************** *** 3495,3502 **** (when (listp mode-line-format) (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) ! (and (equal (nth 3 mode-line-format) " ") ! (setcar (nthcdr 3 mode-line-format) " ")))) ;;; List and range functions --- 3572,3579 ---- (when (listp mode-line-format) (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) ! (when (equal (nth 3 mode-line-format) " ") ! (setcar (nthcdr 3 mode-line-format) " ")))) ;;; List and range functions *************** *** 3510,3516 **** "Do a complete, total copy of a list." (if (and (consp list) (not (consp (cdr list)))) (cons (car list) (cdr list)) ! (mapcar (lambda (elem) (if (consp elem) (if (consp (cdr elem)) (gnus-copy-sequence elem) (cons (car elem) (cdr elem))) --- 3587,3593 ---- "Do a complete, total copy of a list." (if (and (consp list) (not (consp (cdr list)))) (cons (car list) (cdr list)) ! (mapcar (lambda (elem) (if (consp elem) (if (consp (cdr elem)) (gnus-copy-sequence elem) (cons (car elem) (cdr elem))) *************** *** 3543,3549 **** (setq list2 (cdr list2))))) (nconc (nreverse out) (or list1 list2))))) ! (defun gnus-intersection (list1 list2) (let ((result nil)) (while list2 (if (memq (car list2) list1) --- 3620,3626 ---- (setq list2 (cdr list2))))) (nconc (nreverse out) (or list1 list2))))) ! (defun gnus-intersection (list1 list2) (let ((result nil)) (while list2 (if (memq (car list2) list1) *************** *** 3599,3605 **** ((= (1+ last) (car numbers)) ;Still in sequence (setq last (car numbers))) (t ;End of one sequence ! (setq result (cons (if (= first last) first (cons first last)) result)) (setq first (car numbers)) --- 3676,3682 ---- ((= (1+ last) (car numbers)) ;Still in sequence (setq last (car numbers))) (t ;End of one sequence ! (setq result (cons (if (= first last) first (cons first last)) result)) (setq first (car numbers)) *************** *** 3616,3622 **** RANGES is either a single range on the form `(num . num)' or a list of these ranges." (let (first last result) ! (cond ((null ranges) nil) ((not (listp (cdr ranges))) --- 3693,3699 ---- RANGES is either a single range on the form `(num . num)' or a list of these ranges." (let (first last result) ! (cond ((null ranges) nil) ((not (listp (cdr ranges))) *************** *** 3668,3674 **** (setq ranges (cdr ranges))) (if list (setq out (nconc (gnus-compress-sequence list t) out))) ! (setq out (sort out (lambda (r1 r2) (< (or (and (atom r1) r1) (car r1)) (or (and (atom r2) r2) (car r2)))))) (setq ranges out) --- 3745,3751 ---- (setq ranges (cdr ranges))) (if list (setq out (nconc (gnus-compress-sequence list t) out))) ! (setq out (sort out (lambda (r1 r2) (< (or (and (atom r1) r1) (car r1)) (or (and (atom r2) r2) (car r2)))))) (setq ranges out) *************** *** 3678,3684 **** (if (atom (car (cdr ranges))) (if (= (1+ (car ranges)) (car (cdr ranges))) (progn ! (setcar ranges (cons (car ranges) (car (cdr ranges)))) (setcdr ranges (cdr (cdr ranges))))) (if (= (1+ (car ranges)) (car (car (cdr ranges)))) --- 3755,3761 ---- (if (atom (car (cdr ranges))) (if (= (1+ (car ranges)) (car (cdr ranges))) (progn ! (setcar ranges (cons (car ranges) (car (cdr ranges)))) (setcdr ranges (cdr (cdr ranges))))) (if (= (1+ (car ranges)) (car (car (cdr ranges)))) *************** *** 3703,3718 **** "Return a list of ranges that has all articles from LIST removed from RANGES. Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. ! (gnus-compress-sequence (gnus-sorted-complement (gnus-uncompress-range ranges) list))) (defun gnus-member-of-range (number ranges) (if (not (listp (cdr ranges))) ! (and (>= number (car ranges)) (<= number (cdr ranges))) (let ((not-stop t)) ! (while (and ranges (if (numberp (car ranges)) (>= number (car ranges)) (>= number (car (car ranges)))) --- 3780,3795 ---- "Return a list of ranges that has all articles from LIST removed from RANGES. Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. ! (gnus-compress-sequence (gnus-sorted-complement (gnus-uncompress-range ranges) list))) (defun gnus-member-of-range (number ranges) (if (not (listp (cdr ranges))) ! (and (>= number (car ranges)) (<= number (cdr ranges))) (let ((not-stop t)) ! (while (and ranges (if (numberp (car ranges)) (>= number (car ranges)) (>= number (car (car ranges)))) *************** *** 3744,3915 **** ;;; (defvar gnus-group-mode-map nil) - (defvar gnus-group-group-map nil) - (defvar gnus-group-mark-map nil) - (defvar gnus-group-list-map nil) - (defvar gnus-group-sort-map nil) - (defvar gnus-group-soup-map nil) - (defvar gnus-group-sub-map nil) - (defvar gnus-group-help-map nil) - (defvar gnus-group-score-map nil) (put 'gnus-group-mode 'mode-class 'special) ! (if gnus-group-mode-map ! nil (setq gnus-group-mode-map (make-keymap)) (suppress-keymap gnus-group-mode-map) ! (define-key gnus-group-mode-map " " 'gnus-group-read-group) ! (define-key gnus-group-mode-map "=" 'gnus-group-select-group) ! (define-key gnus-group-mode-map "\M- " 'gnus-group-unhidden-select-group) ! (define-key gnus-group-mode-map "\r" 'gnus-group-select-group) ! (define-key gnus-group-mode-map "\M-\r" 'gnus-group-quick-select-group) ! (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group) ! (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group) ! (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group) ! (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group) ! (define-key gnus-group-mode-map "N" 'gnus-group-next-group) ! (define-key gnus-group-mode-map "P" 'gnus-group-prev-group) ! (define-key gnus-group-mode-map ! "\M-n" 'gnus-group-next-unread-group-same-level) ! (define-key gnus-group-mode-map ! "\M-p" 'gnus-group-prev-unread-group-same-level) ! (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group) ! (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group) ! (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group) ! (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group) ! (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current) ! (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all) ! (define-key gnus-group-mode-map "l" 'gnus-group-list-groups) ! (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups) ! (define-key gnus-group-mode-map "m" 'gnus-group-mail) ! (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news) ! (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group) ! (define-key gnus-group-mode-map "R" 'gnus-group-restart) ! (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file) ! (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server) ! (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups) ! (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups) ! (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group) ! (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups) ! (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos) ! (define-key gnus-group-mode-map "\C-c\M-\C-a" 'gnus-group-description-apropos) ! (define-key gnus-group-mode-map "a" 'gnus-group-post-news) ! (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill) ! (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill) ! (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group) ! (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group) ! (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region) ! (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups) ! (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed) ! (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles) ! (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups) ! (define-key gnus-group-mode-map "V" 'gnus-version) ! (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc) ! (define-key gnus-group-mode-map "z" 'gnus-group-suspend) ! (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble) ! (define-key gnus-group-mode-map "q" 'gnus-group-exit) ! (define-key gnus-group-mode-map "Q" 'gnus-group-quit) ! (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly) ! (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node) ! (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method) ! (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode) ! (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group) ! (define-key gnus-group-mode-map "<" 'beginning-of-buffer) ! (define-key gnus-group-mode-map ">" 'end-of-buffer) ! (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug) ! (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups) ! (define-key gnus-group-mode-map "t" 'gnus-topic-mode) ! (define-key gnus-group-mode-map "\C-c\M-g" 'gnus-activate-all-groups) ! ! (define-key gnus-group-mode-map "#" 'gnus-group-mark-group) ! (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group) ! (define-prefix-command 'gnus-group-mark-map) ! (define-key gnus-group-mode-map "M" 'gnus-group-mark-map) ! (define-key gnus-group-mark-map "m" 'gnus-group-mark-group) ! (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group) ! (define-key gnus-group-mark-map "w" 'gnus-group-mark-region) ! (define-key gnus-group-mark-map "r" 'gnus-group-mark-regexp) ! ! (define-prefix-command 'gnus-group-group-map) ! (define-key gnus-group-mode-map "G" 'gnus-group-group-map) ! (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group) ! (define-key gnus-group-group-map "h" 'gnus-group-make-help-group) ! (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group) ! (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group) ! (define-key gnus-group-group-map "m" 'gnus-group-make-group) ! (define-key gnus-group-group-map "E" 'gnus-group-edit-group) ! (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method) ! (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters) ! (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual) ! (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual) ! (define-key gnus-group-group-map "D" 'gnus-group-enter-directory) ! (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group) ! (define-key gnus-group-group-map "r" 'gnus-group-rename-group) ! (define-key gnus-group-group-map "\177" 'gnus-group-delete-group) ! ! (define-prefix-command 'gnus-group-soup-map) ! (define-key gnus-group-group-map "s" 'gnus-group-soup-map) ! (define-key gnus-group-soup-map "b" 'gnus-group-brew-soup) ! (define-key gnus-group-soup-map "w" 'gnus-soup-save-areas) ! (define-key gnus-group-soup-map "s" 'gnus-soup-send-replies) ! (define-key gnus-group-soup-map "p" 'gnus-soup-pack-packet) ! (define-key gnus-group-soup-map "r" 'nnsoup-pack-replies) ! ! (define-prefix-command 'gnus-group-sort-map) ! (define-key gnus-group-group-map "S" 'gnus-group-sort-map) ! (define-key gnus-group-sort-map "s" 'gnus-group-sort-groups) ! (define-key gnus-group-sort-map "a" 'gnus-group-sort-groups-by-alphabet) ! (define-key gnus-group-sort-map "u" 'gnus-group-sort-groups-by-unread) ! (define-key gnus-group-sort-map "l" 'gnus-group-sort-groups-by-level) ! (define-key gnus-group-sort-map "v" 'gnus-group-sort-groups-by-score) ! (define-key gnus-group-sort-map "r" 'gnus-group-sort-groups-by-rank) ! (define-key gnus-group-sort-map "m" 'gnus-group-sort-groups-by-method) ! ! (define-prefix-command 'gnus-group-list-map) ! (define-key gnus-group-mode-map "A" 'gnus-group-list-map) ! (define-key gnus-group-list-map "k" 'gnus-group-list-killed) ! (define-key gnus-group-list-map "z" 'gnus-group-list-zombies) ! (define-key gnus-group-list-map "s" 'gnus-group-list-groups) ! (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups) ! (define-key gnus-group-list-map "A" 'gnus-group-list-active) ! (define-key gnus-group-list-map "a" 'gnus-group-apropos) ! (define-key gnus-group-list-map "d" 'gnus-group-description-apropos) ! (define-key gnus-group-list-map "m" 'gnus-group-list-matching) ! (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching) ! (define-key gnus-group-list-map "l" 'gnus-group-list-level) ! ! (define-prefix-command 'gnus-group-score-map) ! (define-key gnus-group-mode-map "W" 'gnus-group-score-map) ! (define-key gnus-group-score-map "f" 'gnus-score-flush-cache) ! ! (define-prefix-command 'gnus-group-help-map) ! (define-key gnus-group-mode-map "H" 'gnus-group-help-map) ! (define-key gnus-group-help-map "f" 'gnus-group-fetch-faq) ! ! (define-prefix-command 'gnus-group-sub-map) ! (define-key gnus-group-mode-map "S" 'gnus-group-sub-map) ! (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level) ! (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group) ! (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group) ! (define-key gnus-group-sub-map "k" 'gnus-group-kill-group) ! (define-key gnus-group-sub-map "y" 'gnus-group-yank-group) ! (define-key gnus-group-sub-map "w" 'gnus-group-kill-region) ! (define-key gnus-group-sub-map "\C-k" 'gnus-group-kill-level) ! (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies)) (defun gnus-group-mode () "Major mode for reading news. All normal editing commands are switched off. \\ ! The group buffer lists (some of) the groups available. For instance, `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' ! lists all zombie groups. ! Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe ! to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. ! For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). The following commands are available: --- 3821,3986 ---- ;;; (defvar gnus-group-mode-map nil) (put 'gnus-group-mode 'mode-class 'special) ! (unless gnus-group-mode-map (setq gnus-group-mode-map (make-keymap)) (suppress-keymap gnus-group-mode-map) ! ! (gnus-define-keys ! gnus-group-mode-map ! " " gnus-group-read-group ! "=" gnus-group-select-group ! "\M- " gnus-group-unhidden-select-group ! "\r" gnus-group-select-group ! "\M-\r" gnus-group-quick-select-group ! "j" gnus-group-jump-to-group ! "n" gnus-group-next-unread-group ! "p" gnus-group-prev-unread-group ! "\177" gnus-group-prev-unread-group ! "N" gnus-group-next-group ! "P" gnus-group-prev-group ! "\M-n" gnus-group-next-unread-group-same-level ! "\M-p" gnus-group-prev-unread-group-same-level ! "," gnus-group-best-unread-group ! "." gnus-group-first-unread-group ! "u" gnus-group-unsubscribe-current-group ! "U" gnus-group-unsubscribe-group ! "c" gnus-group-catchup-current ! "C" gnus-group-catchup-current-all ! "l" gnus-group-list-groups ! "L" gnus-group-list-all-groups ! "m" gnus-group-mail ! "g" gnus-group-get-new-news ! "\M-g" gnus-group-get-new-news-this-group ! "R" gnus-group-restart ! "r" gnus-group-read-init-file ! "B" gnus-group-browse-foreign-server ! "b" gnus-group-check-bogus-groups ! "F" gnus-find-new-newsgroups ! "\C-c\C-d" gnus-group-describe-group ! "\M-d" gnus-group-describe-all-groups ! "\C-c\C-a" gnus-group-apropos ! "\C-c\M-\C-a" gnus-group-description-apropos ! "a" gnus-group-post-news ! "\ek" gnus-group-edit-local-kill ! "\eK" gnus-group-edit-global-kill ! "\C-k" gnus-group-kill-group ! "\C-y" gnus-group-yank-group ! "\C-w" gnus-group-kill-region ! "\C-x\C-t" gnus-group-transpose-groups ! "\C-c\C-l" gnus-group-list-killed ! "\C-c\C-x" gnus-group-expire-articles ! "\C-c\M-\C-x" gnus-group-expire-all-groups ! "V" gnus-version ! "s" gnus-group-save-newsrc ! "z" gnus-group-suspend ! "Z" gnus-group-clear-dribble ! "q" gnus-group-exit ! "Q" gnus-group-quit ! "?" gnus-group-describe-briefly ! "\C-c\C-i" gnus-info-find-node ! "\M-e" gnus-group-edit-group-method ! "^" gnus-group-enter-server-mode ! gnus-mouse-2 gnus-mouse-pick-group ! "<" beginning-of-buffer ! ">" end-of-buffer ! "\C-c\C-b" gnus-bug ! "\C-c\C-s" gnus-group-sort-groups ! "t" gnus-topic-mode ! "\C-c\M-g" gnus-activate-all-groups ! "\M-&" gnus-group-universal-argument ! "#" gnus-group-mark-group ! "\M-#" gnus-group-unmark-group) ! ! (gnus-define-keys ! (gnus-group-mark-map "M" gnus-group-mode-map) ! "m" gnus-group-mark-group ! "u" gnus-group-unmark-group ! "w" gnus-group-mark-region ! "r" gnus-group-mark-regexp ! "U" gnus-group-unmark-all-groups) ! ! (gnus-define-keys ! (gnus-group-group-map "G" gnus-group-mode-map) ! "d" gnus-group-make-directory-group ! "h" gnus-group-make-help-group ! "a" gnus-group-make-archive-group ! "k" gnus-group-make-kiboze-group ! "m" gnus-group-make-group ! "E" gnus-group-edit-group ! "e" gnus-group-edit-group-method ! "p" gnus-group-edit-group-parameters ! "v" gnus-group-add-to-virtual ! "V" gnus-group-make-empty-virtual ! "D" gnus-group-enter-directory ! "f" gnus-group-make-doc-group ! "r" gnus-group-rename-group ! "\177" gnus-group-delete-group) ! ! (gnus-define-keys ! (gnus-group-soup-map "s" gnus-group-group-map) ! "b" gnus-group-brew-soup ! "w" gnus-soup-save-areas ! "s" gnus-soup-send-replies ! "p" gnus-soup-pack-packet ! "r" nnsoup-pack-replies) ! ! (gnus-define-keys ! (gnus-group-sort-map "S" gnus-group-group-map) ! "s" gnus-group-sort-groups ! "a" gnus-group-sort-groups-by-alphabet ! "u" gnus-group-sort-groups-by-unread ! "l" gnus-group-sort-groups-by-level ! "v" gnus-group-sort-groups-by-score ! "r" gnus-group-sort-groups-by-rank ! "m" gnus-group-sort-groups-by-method) ! ! (gnus-define-keys ! (gnus-group-list-map "A" gnus-group-mode-map) ! "k" gnus-group-list-killed ! "z" gnus-group-list-zombies ! "s" gnus-group-list-groups ! "u" gnus-group-list-all-groups ! "A" gnus-group-list-active ! "a" gnus-group-apropos ! "d" gnus-group-description-apropos ! "m" gnus-group-list-matching ! "M" gnus-group-list-all-matching ! "l" gnus-group-list-level) ! ! (gnus-define-keys ! (gnus-group-score-map "W" gnus-group-mode-map) ! "f" gnus-score-flush-cache) ! ! (gnus-define-keys ! (gnus-group-help-map "H" gnus-group-mode-map) ! "f" gnus-group-fetch-faq) ! ! (gnus-define-keys ! (gnus-group-sub-map "S" gnus-group-mode-map) ! "l" gnus-group-set-current-level ! "t" gnus-group-unsubscribe-current-group ! "s" gnus-group-unsubscribe-group ! "k" gnus-group-kill-group ! "y" gnus-group-yank-group ! "w" gnus-group-kill-region ! "\C-k" gnus-group-kill-level ! "z" gnus-group-kill-all-zombies)) (defun gnus-group-mode () "Major mode for reading news. All normal editing commands are switched off. \\ ! The group buffer lists (some of) the groups available. For instance, `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' ! lists all zombie groups. ! Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe ! to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. ! For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). The following commands are available: *************** *** 3940,3955 **** ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens ;; will depend on whether `gnus-group-use-permanent-levels' is used. (defun gnus-group-default-level (&optional level number-or-nil) ! (cond (gnus-group-use-permanent-levels ! (setq gnus-group-default-list-level (or level gnus-group-default-list-level)) (or gnus-group-default-list-level gnus-level-subscribed)) (number-or-nil level) (t (or level gnus-group-default-list-level gnus-level-subscribed)))) ! ;;;###autoload (defun gnus-slave-no-server (&optional arg) "Read network news as a slave, without connecting to local server" --- 4011,4026 ---- ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens ;; will depend on whether `gnus-group-use-permanent-levels' is used. (defun gnus-group-default-level (&optional level number-or-nil) ! (cond (gnus-group-use-permanent-levels ! (setq gnus-group-default-list-level (or level gnus-group-default-list-level)) (or gnus-group-default-list-level gnus-level-subscribed)) (number-or-nil level) (t (or level gnus-group-default-list-level gnus-level-subscribed)))) ! ;;;###autoload (defun gnus-slave-no-server (&optional arg) "Read network news as a slave, without connecting to local server" *************** *** 3960,3966 **** (defun gnus-no-server (&optional arg slave) "Read network news. If ARG is a positive number, Gnus will use that as the ! startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." --- 4031,4037 ---- (defun gnus-no-server (&optional arg slave) "Read network news. If ARG is a positive number, Gnus will use that as the ! startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." *************** *** 3976,3985 **** (gnus arg nil 'slave)) ;;;###autoload (defun gnus (&optional arg dont-connect slave) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the ! startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") (if (get-buffer gnus-group-buffer) --- 4047,4066 ---- (gnus arg nil 'slave)) ;;;###autoload + (defun gnus-other-frame (&optional arg) + "Pop up a frame to read news." + (interactive "P") + (if (get-buffer gnus-group-buffer) + (let ((pop-up-frames t)) + (gnus arg)) + (select-frame (make-frame)) + (gnus arg))) + + ;;;###autoload (defun gnus (&optional arg dont-connect slave) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the ! startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") (if (get-buffer gnus-group-buffer) *************** *** 3999,4020 **** (progn (gnus-group-startup-message) (sit-for 0)))) ! ! (let ((level (and arg (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect (progn ! (or dont-connect (setq did-connect (gnus-start-news-server (and arg (not level)))))) ! (if (and (not dont-connect) (not did-connect)) (gnus-group-quit) (run-hooks 'gnus-startup-hook) ! ;; NNTP server is successfully open. ;; Find the current startup file name. ! (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file)) ;; Read the dribble file. --- 4080,4101 ---- (progn (gnus-group-startup-message) (sit-for 0)))) ! ! (let ((level (and (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect (progn ! (or dont-connect (setq did-connect (gnus-start-news-server (and arg (not level)))))) ! (if (and (not dont-connect) (not did-connect)) (gnus-group-quit) (run-hooks 'gnus-startup-hook) ! ;; NNTP server is successfully open. ;; Find the current startup file name. ! (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file)) ;; Read the dribble file. *************** *** 4055,4061 **** (setq gnus-format-specs (delq entry gnus-format-specs)) (when (and (listp (caddr entry)) (not (eq 'byte-code (caaddr entry)))) ! (fset 'gnus-tmp-func `(lambda () ,(caddr entry))) (byte-compile 'gnus-tmp-func) (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) --- 4136,4142 ---- (setq gnus-format-specs (delq entry gnus-format-specs)) (when (and (listp (caddr entry)) (not (eq 'byte-code (caaddr entry)))) ! (fset 'gnus-tmp-func `(lambda () ,(caddr entry))) (byte-compile 'gnus-tmp-func) (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) *************** *** 4072,4078 **** (indent-rigidly start end arg) (goto-char (point-min)) (while (search-forward "\t" nil t) ! (replace-match " " t t))))) (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." --- 4153,4159 ---- (indent-rigidly start end arg) (goto-char (point-min)) (while (search-forward "\t" nil t) ! (replace-match " " t t))))) (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." *************** *** 4080,4107 **** (erase-buffer) (insert (format " %s ! _ ___ _ _ ! _ ___ __ ___ __ _ ___ ! __ _ ___ __ ___ ! _ ___ _ ! _ _ __ _ ! ___ __ _ ! __ _ ! _ _ _ ! _ _ _ ! _ _ _ ! __ ___ ! _ _ _ _ ! _ _ ! _ _ ! _ _ ! _ ! __ ! " ! "")) ;; And then hack it. ! (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) (goto-char (point-min)) (forward-line 1) --- 4161,4188 ---- (erase-buffer) (insert (format " %s ! _ ___ _ _ ! _ ___ __ ___ __ _ ___ ! __ _ ___ __ ___ ! _ ___ _ ! _ _ __ _ ! ___ __ _ ! __ _ ! _ _ _ ! _ _ _ ! _ _ _ ! __ ___ ! _ _ _ _ ! _ _ ! _ _ ! _ _ ! _ ! __ ! " ! "")) ;; And then hack it. ! (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) (goto-char (point-min)) (forward-line 1) *************** *** 4115,4156 **** (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) (goto-char (point-min)) (let* ((mode-string (gnus-group-set-mode-line))) ! (setq mode-line-buffer-identification (list (concat gnus-version (substring (car mode-string) 4)))) (set-buffer-modified-p t))) - (defun gnus-group-startup-message-old (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (erase-buffer) - (insert - (format " - %s - A newsreader - for GNU Emacs - - Based on GNUS - written by - Masanobu UMEDA - - A Praxis Release - larsi@ifi.uio.no - " - gnus-version)) - ;; And then hack it. - ;; 18 is the longest line. - (indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 28)) 0) 2)) - (goto-char (point-min)) - ;; +4 is fuzzy factor. - (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)) - - ;; Fontify some. - (goto-char (point-min)) - (search-forward "Praxis") - (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) - (goto-char (point-min))) - (defun gnus-group-setup-buffer () (or (get-buffer gnus-group-buffer) (progn --- 4196,4205 ---- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) (goto-char (point-min)) (let* ((mode-string (gnus-group-set-mode-line))) ! (setq mode-line-buffer-identification (list (concat gnus-version (substring (car mode-string) 4)))) (set-buffer-modified-p t))) (defun gnus-group-setup-buffer () (or (get-buffer gnus-group-buffer) (progn *************** *** 4163,4169 **** "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. If argument UNREAD is non-nil, groups with no unread articles are also ! listed." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (or --- 4212,4218 ---- "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. If argument UNREAD is non-nil, groups with no unread articles are also ! listed." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (or *************** *** 4187,4204 **** (gnus-group-search-forward nil nil nil t) ;; Find the right group to put point on. If the current group ;; has disapeared in the new listing, try to find the next ! ;; one. If no next one can be found, just leave point at the ;; first newsgroup in the buffer. (if (not (gnus-goto-char (text-property-any ! (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb)))) (while (and newsrc ! (not (gnus-goto-char ! (text-property-any ! (point-min) (point-max) 'gnus-group ! (gnus-intern-safe (car (car newsrc)) gnus-active-hashtb))))) (setq newsrc (cdr newsrc))) (or newsrc (progn (goto-char (point-max)) --- 4236,4253 ---- (gnus-group-search-forward nil nil nil t) ;; Find the right group to put point on. If the current group ;; has disapeared in the new listing, try to find the next ! ;; one. If no next one can be found, just leave point at the ;; first newsgroup in the buffer. (if (not (gnus-goto-char (text-property-any ! (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb)))) (while (and newsrc ! (not (gnus-goto-char ! (text-property-any ! (point-min) (point-max) 'gnus-group ! (gnus-intern-safe (car (car newsrc)) gnus-active-hashtb))))) (setq newsrc (cdr newsrc))) (or newsrc (progn (goto-char (point-max)) *************** *** 4212,4218 **** (interactive "nList groups on level: \nP") (gnus-group-list-groups level all level)) ! (defun gnus-group-prepare-flat (level &optional all lowest regexp) "List all newsgroups with unread articles of level LEVEL or lower. If ALL is non-nil, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. --- 4261,4267 ---- (interactive "nList groups on level: \nP") (gnus-group-list-groups level all level)) ! (defun gnus-group-prepare-flat (level &optional all lowest regexp) "List all newsgroups with unread articles of level LEVEL or lower. If ALL is non-nil, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. *************** *** 4235,4241 **** (and unread ; This group might be bogus (or (not regexp) (string-match regexp group)) ! (<= (setq clevel (gnus-info-level info)) level) (>= clevel lowest) (or all ; We list all groups? (and gnus-group-list-inactive-groups --- 4284,4290 ---- (and unread ; This group might be bogus (or (not regexp) (string-match regexp group)) ! (<= (setq clevel (gnus-info-level info)) level) (>= clevel lowest) (or all ; We list all groups? (and gnus-group-list-inactive-groups *************** *** 4249,4267 **** group)) (memq 'visible params) (cdr (assq 'visible params))) ! (gnus-group-insert-group-line ! group (gnus-info-level info) (gnus-info-marks info) unread (gnus-info-method info))))) ! ;; List dead groups. (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) (gnus-group-set-mode-line) --- 4298,4316 ---- group)) (memq 'visible params) (cdr (assq 'visible params))) ! (gnus-group-insert-group-line ! group (gnus-info-level info) (gnus-info-marks info) unread (gnus-info-method info))))) ! ;; List dead groups. (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) (gnus-group-set-mode-line) *************** *** 4275,4285 **** (let (group beg) (if regexp ;; This loop is used when listing groups that match some ! ;; regexp. (while groups (setq group (pop groups)) (when (string-match regexp group) ! (add-text-properties (point) (prog1 (1+ (point)) (insert " " mark " *: " group "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) --- 4324,4334 ---- (let (group beg) (if regexp ;; This loop is used when listing groups that match some ! ;; regexp. (while groups (setq group (pop groups)) (when (string-match regexp group) ! (add-text-properties (point) (prog1 (1+ (point)) (insert " " mark " *: " group "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) *************** *** 4287,4295 **** 'gnus-level level)))) ;; This loop is used when listing all groups. (while groups ! (add-text-properties (point) (prog1 (1+ (point)) ! (insert " " mark " *: " (setq group (pop groups)) "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t --- 4336,4344 ---- 'gnus-level level)))) ;; This loop is used when listing all groups. (while groups ! (add-text-properties (point) (prog1 (1+ (point)) ! (insert " " mark " *: " (setq group (pop groups)) "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t *************** *** 4312,4318 **** (defsubst gnus-server-get-method (group method) ;; Input either a server name, and extended server name, or a ! ;; select method, and return a select method. (cond ((stringp method) (gnus-server-to-method method)) ((and (stringp (car method)) group) --- 4361,4367 ---- (defsubst gnus-server-get-method (group method) ;; Input either a server name, and extended server name, or a ! ;; select method, and return a select method. (cond ((stringp method) (gnus-server-to-method method)) ((and (stringp (car method)) group) *************** *** 4325,4335 **** (or (and (equal server "native") gnus-select-method) (cdr (assoc server gnus-server-alist)))) (defun gnus-group-prefixed-name (group method) "Return the whole name from GROUP and METHOD." (and (stringp method) (setq method (gnus-server-to-method method))) (concat (format "%s" (car method)) ! (if (and (assoc (format "%s" (car method)) (gnus-methods-using 'address)) (not (string= (nth 1 method) ""))) (concat "+" (nth 1 method))) --- 4374,4395 ---- (or (and (equal server "native") gnus-select-method) (cdr (assoc server gnus-server-alist)))) + (defmacro gnus-server-equal (ss1 ss2) + "Say whether two servers are equal." + `(let ((s1 ,ss1) + (s2 ,ss2)) + (or (equal s1 s2) + (and (= (length s1) (length s2)) + (progn + (while (and s1 (member (car s1) s2)) + (setq s1 (cdr s1))) + (null s1)))))) + (defun gnus-group-prefixed-name (group method) "Return the whole name from GROUP and METHOD." (and (stringp method) (setq method (gnus-server-to-method method))) (concat (format "%s" (car method)) ! (if (and (assoc (format "%s" (car method)) (gnus-methods-using 'address)) (not (string= (nth 1 method) ""))) (concat "+" (nth 1 method))) *************** *** 4356,4362 **** (let ((methods gnus-secondary-select-methods) (gmethod (gnus-server-get-method nil method))) (while (and methods ! (not (equal (gnus-server-get-method nil (car methods)) gmethod))) (setq methods (cdr methods))) methods)) --- 4416,4422 ---- (let ((methods gnus-secondary-select-methods) (gmethod (gnus-server-get-method nil method))) (while (and methods ! (not (equal (gnus-server-get-method nil (car methods)) gmethod))) (setq methods (cdr methods))) methods)) *************** *** 4393,4403 **** (if (not info) () ; This is a dead group. We just ignore it. ;; Cons the new param to the old one and update. ! (gnus-group-set-info (cons param (gnus-info-params info)) group 'params)))) (defun gnus-group-add-score (group &optional score) ! "Add SCORE to the GROUP score. If SCORE is nil, add 1 to the score of GROUP." (let ((info (gnus-get-info group))) (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))) --- 4453,4463 ---- (if (not info) () ; This is a dead group. We just ignore it. ;; Cons the new param to the old one and update. ! (gnus-group-set-info (cons param (gnus-info-params info)) group 'params)))) (defun gnus-group-add-score (group &optional score) ! "Add SCORE to the GROUP score. If SCORE is nil, add 1 to the score of GROUP." (let ((info (gnus-get-info group))) (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))) *************** *** 4418,4424 **** (unless entry (error "Trying to change non-existent group %s" method-only-group)) ;; We have recevied parts of the actual group info - either the ! ;; select method or the group parameters. We first check ;; whether we have to extend the info, and if so, do that. (let ((len (length info)) (total (if (eq part 'method) 5 6))) --- 4478,4484 ---- (unless entry (error "Trying to change non-existent group %s" method-only-group)) ;; We have recevied parts of the actual group info - either the ! ;; select method or the group parameters. We first check ;; whether we have to extend the info, and if so, do that. (let ((len (length info)) (total (if (eq part 'method) 5 6))) *************** *** 4433,4447 **** (set-buffer gnus-group-buffer) (if (gnus-info-method info) ;; It's a foreign group... ! (gnus-group-make-group (gnus-group-real-name (gnus-info-group info)) (prin1-to-string (car (gnus-info-method info))) (nth 1 (gnus-info-method info))) ;; It's a native group. (gnus-group-make-group (gnus-info-group info))) (gnus-message 6 "Note: New group created") ! (setq entry ! (gnus-gethash (gnus-group-prefixed-name (gnus-group-real-name (gnus-info-group info)) (or (gnus-info-method info) gnus-select-method)) gnus-newsrc-hashtb)))) --- 4493,4507 ---- (set-buffer gnus-group-buffer) (if (gnus-info-method info) ;; It's a foreign group... ! (gnus-group-make-group (gnus-group-real-name (gnus-info-group info)) (prin1-to-string (car (gnus-info-method info))) (nth 1 (gnus-info-method info))) ;; It's a native group. (gnus-group-make-group (gnus-info-group info))) (gnus-message 6 "Note: New group created") ! (setq entry ! (gnus-gethash (gnus-group-prefixed-name (gnus-group-real-name (gnus-info-group info)) (or (gnus-info-method info) gnus-select-method)) gnus-newsrc-hashtb)))) *************** *** 4450,4459 **** (if entry (progn (setcar (nthcdr 2 entry) info) ! (when (and (not (eq (car entry) t)) (gnus-active (gnus-info-group info))) (let ((marked (gnus-info-marks info))) ! (setcar entry (length (gnus-list-of-unread-articles (car info))))))) (error "No such group: %s" (gnus-info-group info))))) --- 4510,4519 ---- (if entry (progn (setcar (nthcdr 2 entry) info) ! (when (and (not (eq (car entry) t)) (gnus-active (gnus-info-group info))) (let ((marked (gnus-info-marks info))) ! (setcar entry (length (gnus-list-of-unread-articles (car info))))))) (error "No such group: %s" (gnus-info-group info))))) *************** *** 4468,4477 **** (let* ((buffer-read-only nil) (group (gnus-group-group-name)) (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))) ! (and entry (not (gnus-ephemeral-group-p group)) ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ")"))) (gnus-delete-line) (gnus-group-insert-group-line-info group) --- 4528,4537 ---- (let* ((buffer-read-only nil) (group (gnus-group-group-name)) (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))) ! (and entry (not (gnus-ephemeral-group-p group)) ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ")"))) (gnus-delete-line) (gnus-group-insert-group-line-info group) *************** *** 4480,4516 **** (defun gnus-group-insert-group-line-info (group) "Insert GROUP on the current line." ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) active info) (if entry (progn ;; (Un)subscribed group. (setq info (nth 2 entry)) ! (gnus-group-insert-group-line group (gnus-info-level info) (gnus-info-marks info) (or (car entry) t) (gnus-info-method info))) ;; This group is dead. ! (gnus-group-insert-group-line ! group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) ! nil (if (setq active (gnus-active group)) ! (- (1+ (cdr active)) (car active)) 0) nil)))) ;; Dummy function redefined when running under XEmacs. (defalias 'gnus-group-remove-excess-properties 'ignore) ! (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) ! (gnus-tmp-number-total ! (if gnus-tmp-active (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) 0)) ! (gnus-tmp-number-of-unread (if (numberp number) (int-to-string (max 0 number)) "*")) (gnus-tmp-number-of-read --- 4540,4576 ---- (defun gnus-group-insert-group-line-info (group) "Insert GROUP on the current line." ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) active info) (if entry (progn ;; (Un)subscribed group. (setq info (nth 2 entry)) ! (gnus-group-insert-group-line group (gnus-info-level info) (gnus-info-marks info) (or (car entry) t) (gnus-info-method info))) ;; This group is dead. ! (gnus-group-insert-group-line ! group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) ! nil (if (setq active (gnus-active group)) ! (- (1+ (cdr active)) (car active)) 0) nil)))) ;; Dummy function redefined when running under XEmacs. (defalias 'gnus-group-remove-excess-properties 'ignore) ! (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) ! (gnus-tmp-number-total ! (if gnus-tmp-active (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) 0)) ! (gnus-tmp-number-of-unread (if (numberp number) (int-to-string (max 0 number)) "*")) (gnus-tmp-number-of-read *************** *** 4523,4546 **** ((= gnus-tmp-level gnus-level-zombie) ?Z) (t ?K))) (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) ! (gnus-tmp-newsgroup-description (if gnus-description-hashtb (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") "")) (gnus-tmp-moderated (if (member gnus-tmp-group gnus-moderated-list) ?m ? )) ! (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-method (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) ! (gnus-tmp-news-method-string (if gnus-tmp-method (format "(%s:%s)" (car gnus-tmp-method) (car (cdr gnus-tmp-method))) "")) ! (gnus-tmp-marked-mark ! (if (and (numberp number) (zerop number) (cdr (assq 'tick gnus-tmp-marked))) ?* ? )) --- 4583,4606 ---- ((= gnus-tmp-level gnus-level-zombie) ?Z) (t ?K))) (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) ! (gnus-tmp-newsgroup-description (if gnus-description-hashtb (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") "")) (gnus-tmp-moderated (if (member gnus-tmp-group gnus-moderated-list) ?m ? )) ! (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-method (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) ! (gnus-tmp-news-method-string (if gnus-tmp-method (format "(%s:%s)" (car gnus-tmp-method) (car (cdr gnus-tmp-method))) "")) ! (gnus-tmp-marked-mark ! (if (and (numberp number) (zerop number) (cdr (assq 'tick gnus-tmp-marked))) ?* ? )) *************** *** 4552,4558 **** (if (member gnus-tmp-group gnus-group-marked) gnus-process-mark ? )) (buffer-read-only nil) ! header) ; passed as parameter to user-funcs. (beginning-of-line) (add-text-properties (point) --- 4612,4618 ---- (if (member gnus-tmp-group gnus-group-marked) gnus-process-mark ? )) (buffer-read-only nil) ! header) ; passed as parameter to user-funcs. (beginning-of-line) (add-text-properties (point) *************** *** 4571,4577 **** (defun gnus-group-update-group (group &optional visible-only) "Update all lines where GROUP appear. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't ! already." (save-excursion (set-buffer gnus-group-buffer) ;; The buffer may be narrowed. --- 4631,4637 ---- (defun gnus-group-update-group (group &optional visible-only) "Update all lines where GROUP appear. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't ! already." (save-excursion (set-buffer gnus-group-buffer) ;; The buffer may be narrowed. *************** *** 4583,4594 **** ;; Enter the current status into the dribble buffer. (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) (if (and entry (not (gnus-ephemeral-group-p group))) ! (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ")")))) ;; Find all group instances. If topics are in use, each group ;; may be listed in more than once. ! (while (setq loc (text-property-any loc (point-max) 'gnus-group ident)) (setq found t) (goto-char loc) --- 4643,4654 ---- ;; Enter the current status into the dribble buffer. (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) (if (and entry (not (gnus-ephemeral-group-p group))) ! (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ")")))) ;; Find all group instances. If topics are in use, each group ;; may be listed in more than once. ! (while (setq loc (text-property-any loc (point-max) 'gnus-group ident)) (setq found t) (goto-char loc) *************** *** 4605,4613 **** (not (gnus-goto-char (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe ! (car (car entry)) gnus-active-hashtb))))) (setq entry (cdr entry))) (or entry (goto-char (point-max)))) --- 4665,4673 ---- (not (gnus-goto-char (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe ! (car (car entry)) gnus-active-hashtb))))) (setq entry (cdr entry))) (or entry (goto-char (point-max)))) *************** *** 4619,4626 **** (when (memq 'group gnus-updated-mode-lines) (let* ((gformat (or gnus-group-mode-line-format-spec (setq gnus-group-mode-line-format-spec ! (gnus-parse-format ! gnus-group-mode-line-format gnus-group-mode-line-format-alist)))) (gnus-tmp-news-server (car (cdr gnus-select-method))) (gnus-tmp-news-method (car gnus-select-method)) --- 4679,4686 ---- (when (memq 'group gnus-updated-mode-lines) (let* ((gformat (or gnus-group-mode-line-format-spec (setq gnus-group-mode-line-format-spec ! (gnus-parse-format ! gnus-group-mode-line-format gnus-group-mode-line-format-alist)))) (gnus-tmp-news-server (car (cdr gnus-select-method))) (gnus-tmp-news-method (car gnus-select-method)) *************** *** 4629,4635 **** ;; Get the resulting string. (mode-string (eval gformat))) ;; If the line is too long, we chop it off. ! (when (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) (prog1 (setq mode-line-buffer-identification (list mode-string)) --- 4689,4695 ---- ;; Get the resulting string. (mode-string (eval gformat))) ;; If the line is too long, we chop it off. ! (when (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) (prog1 (setq mode-line-buffer-identification (list mode-string)) *************** *** 4662,4674 **** (if (and backward (progn (beginning-of-line)) (bobp)) nil (or first-too (forward-line way)) ! (while (and (not (eobp)) ! (not (setq ! found (and (or all (and ! (let ((unread (get-text-property (point) 'gnus-unread))) (and (numberp unread) (> unread 0))) (setq lev (get-text-property (point) --- 4722,4734 ---- (if (and backward (progn (beginning-of-line)) (bobp)) nil (or first-too (forward-line way)) ! (while (and (not (eobp)) ! (not (setq ! found (and (or all (and ! (let ((unread (get-text-property (point) 'gnus-unread))) (and (numberp unread) (> unread 0))) (setq lev (get-text-property (point) *************** *** 4685,4691 **** (setq pos (point)) nil)))))))) (zerop (forward-line way))))) ! (if found (progn (gnus-group-position-point) t) (goto-char (or pos beg)) (and pos t)))) --- 4745,4751 ---- (setq pos (point)) nil)))))))) (zerop (forward-line way))))) ! (if found (progn (gnus-group-position-point) t) (goto-char (or pos beg)) (and pos t)))) *************** *** 4699,4710 **** (interactive "p") (let ((buffer-read-only nil) group) ! (while ! (and (> n 0) (setq group (gnus-group-group-name)) (progn (beginning-of-line) ! (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (delete-char 1) (if unmark --- 4759,4770 ---- (interactive "p") (let ((buffer-read-only nil) group) ! (while ! (and (> n 0) (setq group (gnus-group-group-name)) (progn (beginning-of-line) ! (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (delete-char 1) (if unmark *************** *** 4723,4729 **** (defun gnus-group-unmark-group (n) "Remove the mark from the current group." (interactive "p") ! (gnus-group-mark-group n 'unmark)) (defun gnus-group-mark-region (unmark beg end) "Mark all groups between point and mark. --- 4783,4798 ---- (defun gnus-group-unmark-group (n) "Remove the mark from the current group." (interactive "p") ! (gnus-group-mark-group n 'unmark) ! (gnus-group-position-point)) ! ! (defun gnus-group-unmark-all-groups () ! "Unmark all groups." ! (let ((groups gnus-group-marked)) ! (save-excursion ! (while groups ! (gnus-group-remove-mark (pop groups))))) ! (gnus-group-position-point)) (defun gnus-group-mark-region (unmark beg end) "Mark all groups between point and mark. *************** *** 4741,4747 **** group) (while alist (when (string-match regexp (setq group (gnus-info-group (pop alist)))) ! (gnus-group-set-mark group))))) (defun gnus-group-remove-mark (group) (if (gnus-group-goto-group group) --- 4810,4817 ---- group) (while alist (when (string-match regexp (setq group (gnus-info-group (pop alist)))) ! (gnus-group-set-mark group)))) ! (gnus-group-position-point)) (defun gnus-group-remove-mark (group) (if (gnus-group-goto-group group) *************** *** 4749,4755 **** (gnus-group-mark-group 1 'unmark t)) (setq gnus-group-marked (delete group gnus-group-marked)))) ! (defun gnus-group-set-mark (group) "Set the process mark on GROUP." (if (gnus-group-goto-group group) --- 4819,4825 ---- (gnus-group-mark-group 1 'unmark t)) (setq gnus-group-marked (delete group gnus-group-marked)))) ! (defun gnus-group-set-mark (group) "Set the process mark on GROUP." (if (gnus-group-goto-group group) *************** *** 4757,4771 **** (gnus-group-mark-group 1 nil t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) ! ! ;; Return a list of groups to work on. Take into consideration N (the ! ;; prefix) and the list of marked groups. (defun gnus-group-process-prefix (n) (cond (n (setq n (prefix-numeric-value n)) ;; There is a prefix, so we return a list of the N next ! ;; groups. (let ((way (if (< n 0) -1 1)) (n (abs n)) group groups) --- 4827,4860 ---- (gnus-group-mark-group 1 nil t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) ! ! (defun gnus-group-universal-argument (arg &optional groups func) ! "Perform any command on all groups accoring to the process/prefix convention." ! (interactive "P") ! (let ((groups (or groups (gnus-group-process-prefix arg))) ! group func) ! (if (eq (setq func (or func ! (key-binding ! (read-key-sequence ! (substitute-command-keys ! "\\\\[gnus-group-universal-argument]"))))) ! 'undefined) ! (progn ! (message "Undefined key") ! (ding)) ! (while groups ! (gnus-group-remove-mark (setq group (pop groups))) ! (command-execute func)))) ! (gnus-group-position-point)) ! (defun gnus-group-process-prefix (n) + "Return a list of groups to work on. + Take into consideration N (the prefix) and the list of marked groups." (cond (n (setq n (prefix-numeric-value n)) ;; There is a prefix, so we return a list of the N next ! ;; groups. (let ((way (if (< n 0) -1 1)) (n (abs n)) group groups) *************** *** 4784,4791 **** groups) (save-excursion (goto-char (min (point) (mark))) ! (while ! (and (push (gnus-group-group-name) groups) (zerop (gnus-group-next-group 1)) (< (point) max))) --- 4873,4880 ---- groups) (save-excursion (goto-char (min (point) (mark))) ! (while ! (and (push (gnus-group-group-name) groups) (zerop (gnus-group-next-group 1)) (< (point) max))) *************** *** 4806,4812 **** If the prefix argument ALL is non-nil, already read articles become readable. IF ALL is a number, fetch this number of articles. If the optional argument NO-ARTICLE is non-nil, no article will be ! auto-selected upon group entry. If GROUP is non-nil, fetch that group." (interactive "P") (let ((group (or group (gnus-group-group-name))) --- 4895,4901 ---- If the prefix argument ALL is non-nil, already read articles become readable. IF ALL is a number, fetch this number of articles. If the optional argument NO-ARTICLE is non-nil, no article will be ! auto-selected upon group entry. If GROUP is non-nil, fetch that group." (interactive "P") (let ((group (or group (gnus-group-group-name))) *************** *** 4821,4828 **** (entry (car entry)) ((setq active (gnus-active group)) (- (1+ (cdr active)) (car active))))) ! (gnus-summary-read-group ! group (or all (and (numberp number) (zerop (+ number (length (cdr (assq 'tick marked))) (length (cdr (assq 'dormant marked))))))) no-article))) --- 4910,4917 ---- (entry (car entry)) ((setq active (gnus-active group)) (- (1+ (cdr active)) (car active))))) ! (gnus-summary-read-group ! group (or all (and (numberp number) (zerop (+ number (length (cdr (assq 'tick marked))) (length (cdr (assq 'dormant marked))))))) no-article))) *************** *** 4836,4842 **** (gnus-group-read-group all t)) (defun gnus-group-quick-select-group (&optional all) ! "Select the current group \"quickly\". This means that no highlighting or scoring will be performed." (interactive "P") (let (gnus-visual --- 4925,4931 ---- (gnus-group-read-group all t)) (defun gnus-group-quick-select-group (&optional all) ! "Select the current group \"quickly\". This means that no highlighting or scoring will be performed." (interactive "P") (let (gnus-visual *************** *** 4862,4878 **** ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. ! (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config) (let ((group (if (gnus-group-foreign-p group) group ! (gnus-group-prefixed-name group method))) ! (cur (current-buffer))) ! (gnus-sethash group ! (list t nil (list group gnus-level-default-subscribed nil nil (append method (list ! (list 'quit-config (if quit-config quit-config (cons (current-buffer) 'summary))))))) gnus-newsrc-hashtb) --- 4951,4966 ---- ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. ! (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config) (let ((group (if (gnus-group-foreign-p group) group ! (gnus-group-prefixed-name group method)))) ! (gnus-sethash group ! (list t nil (list group gnus-level-default-subscribed nil nil (append method (list ! (list 'quit-config (if quit-config quit-config (cons (current-buffer) 'summary))))))) gnus-newsrc-hashtb) *************** *** 4884,4904 **** (condition-case () (gnus-group-read-group t t group) (error nil) ! (quit nil)) ! (not (equal (current-buffer) cur)))) ! (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." ! (interactive ! (list (completing-read ! "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))) (if (equal group "") (error "Empty group name")) ! (let ((b (text-property-any ! (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (if b ;; Either go to the line in the group buffer... --- 4972,4991 ---- (condition-case () (gnus-group-read-group t t group) (error nil) ! (quit nil)))) ! (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." ! (interactive ! (list (completing-read ! "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))) (if (equal group "") (error "Empty group name")) ! (let ((b (text-property-any ! (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (if b ;; Either go to the line in the group buffer... *************** *** 4910,4916 **** (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) ! (goto-char (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) ;; Adjust cursor point. --- 4997,5003 ---- (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) ! (goto-char (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) ;; Adjust cursor point. *************** *** 4919,4925 **** (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." (when group ! (let ((b (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (and b (goto-char b))))) --- 5006,5012 ---- (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." (when group ! (let ((b (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (and b (goto-char b))))) *************** *** 4945,4951 **** (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) ! (gnus-group-search-forward backward (or (not gnus-group-goto-unread) all) level)) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") --- 5032,5038 ---- (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) ! (gnus-group-search-forward backward (or (not gnus-group-goto-unread) all) level)) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") *************** *** 4962,4968 **** (defun gnus-group-prev-unread-group (n) "Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually ! done." (interactive "p") (gnus-group-next-unread-group (- n))) --- 5049,5055 ---- (defun gnus-group-prev-unread-group (n) "Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually ! done." (interactive "p") (gnus-group-next-unread-group (- n))) *************** *** 4996,5002 **** (if (and (< (get-text-property (point) 'gnus-level) best) (or (not exclude-group) (not (equal exclude-group (gnus-group-group-name))))) ! (progn (setq best (get-text-property (point) 'gnus-level)) (setq best-point (point)))))) (forward-line 1)) --- 5083,5089 ---- (if (and (< (get-text-property (point) 'gnus-level) best) (or (not exclude-group) (not (equal exclude-group (gnus-group-group-name))))) ! (progn (setq best (get-text-property (point) 'gnus-level)) (setq best-point (point)))))) (forward-line 1)) *************** *** 5030,5039 **** The user will be prompted for a NAME, for a select METHOD, and an ADDRESS." (interactive ! (cons (read-string "Group name: ") (let ((method ! (completing-read "Method: " (append gnus-valid-select-methods gnus-server-alist) nil t))) (if (assoc method gnus-valid-select-methods) --- 5117,5126 ---- The user will be prompted for a NAME, for a select METHOD, and an ADDRESS." (interactive ! (cons (read-string "Group name: ") (let ((method ! (completing-read "Method: " (append gnus-valid-select-methods gnus-server-alist) nil t))) (if (assoc method gnus-valid-select-methods) *************** *** 5043,5067 **** (read-string "Address: ") "")) (list method nil))))) ! (save-excursion (set-buffer gnus-group-buffer) ! (let* ((meth (and method (if address (list (intern method) address) method))) (nname (if method (gnus-group-prefixed-name name meth) name)) info) (and (gnus-gethash nname gnus-newsrc-hashtb) (error "Group %s already exists" nname)) ! (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) ! gnus-level-default-subscribed gnus-level-killed (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) t) (gnus-set-active nname (cons 1 0)) (or (gnus-ephemeral-group-p name) ! (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) (gnus-group-insert-group-line-info nname) --- 5130,5154 ---- (read-string "Address: ") "")) (list method nil))))) ! (save-excursion (set-buffer gnus-group-buffer) ! (let* ((meth (and method (if address (list (intern method) address) method))) (nname (if method (gnus-group-prefixed-name name meth) name)) info) (and (gnus-gethash nname gnus-newsrc-hashtb) (error "Group %s already exists" nname)) ! (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) ! gnus-level-default-subscribed gnus-level-killed (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) t) (gnus-set-active nname (cons 1 0)) (or (gnus-ephemeral-group-p name) ! (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) (gnus-group-insert-group-line-info nname) *************** *** 5075,5082 **** "Delete the current group. If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face ! of the Earth\". There is no undo." ! (interactive (list (gnus-group-group-name) current-prefix-arg)) (or group (error "No group to rename")) --- 5162,5169 ---- "Delete the current group. If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face ! of the Earth\". There is no undo." ! (interactive (list (gnus-group-group-name) current-prefix-arg)) (or group (error "No group to rename")) *************** *** 5085,5091 **** (prog1 (if (not (gnus-yes-or-no-p (format ! "Do you really want to delete %s%s? " group (if force " and all its contents" "")))) () ; Whew! (gnus-message 6 "Deleting group %s..." group) --- 5172,5178 ---- (prog1 (if (not (gnus-yes-or-no-p (format ! "Do you really want to delete %s%s? " group (if force " and all its contents" "")))) () ; Whew! (gnus-message 6 "Deleting group %s..." group) *************** *** 5104,5110 **** (list (gnus-group-group-name) (progn ! (or (gnus-check-backend-function 'request-rename-group (gnus-group-group-name)) (error "This backend does not support renaming groups")) (read-string "New group name: ")))) --- 5191,5197 ---- (list (gnus-group-group-name) (progn ! (or (gnus-check-backend-function 'request-rename-group (gnus-group-group-name)) (error "This backend does not support renaming groups")) (read-string "New group name: ")))) *************** *** 5113,5124 **** (error "This backend does not support renaming groups")) (or group (error "No group to rename")) ! (and (string-match "^[ \t]*$" new-name) (error "Not a valid group name")) ;; We find the proper prefixed name. (setq new-name ! (gnus-group-prefixed-name (gnus-group-real-name new-name) (gnus-info-method (gnus-get-info group)))) --- 5200,5211 ---- (error "This backend does not support renaming groups")) (or group (error "No group to rename")) ! (and (string-match "^[ \t]*$" new-name) (error "Not a valid group name")) ;; We find the proper prefixed name. (setq new-name ! (gnus-group-prefixed-name (gnus-group-real-name new-name) (gnus-info-method (gnus-get-info group)))) *************** *** 5135,5141 **** (setcar (cdr (car gnus-list-of-killed-groups)) new-name) ;; ... and then yanking it. Magic! ! (gnus-group-yank-group) (gnus-set-active new-name (gnus-active group)) (gnus-message 6 "Renaming group %s to %s...done" group new-name) new-name) --- 5222,5228 ---- (setcar (cdr (car gnus-list-of-killed-groups)) new-name) ;; ... and then yanking it. Magic! ! (gnus-group-yank-group) (gnus-set-active new-name (gnus-active group)) (gnus-message 6 "Renaming group %s to %s...done" group new-name) new-name) *************** *** 5145,5151 **** (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let ((done-func '(lambda () "Exit editing mode and update the information." (interactive) (gnus-group-edit-group-done 'part 'group))) --- 5232,5238 ---- (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let ((done-func '(lambda () "Exit editing mode and update the information." (interactive) (gnus-group-edit-group-done 'part 'group))) *************** *** 5169,5182 **** (setcar (cdr (cdr (nth 4 done-func))) group) (erase-buffer) (insert ! (cond ((eq part 'method) ";; Type `C-c C-c' after editing the select method.\n\n") ((eq part 'params) ";; Type `C-c C-c' after editing the group parameters.\n\n") ((eq part 'info) ";; Type `C-c C-c' after editing the group info.\n\n"))) ! (insert (pp-to-string (cond ((eq part 'method) (or (gnus-info-method info) "native")) --- 5256,5269 ---- (setcar (cdr (cdr (nth 4 done-func))) group) (erase-buffer) (insert ! (cond ((eq part 'method) ";; Type `C-c C-c' after editing the select method.\n\n") ((eq part 'params) ";; Type `C-c C-c' after editing the group parameters.\n\n") ((eq part 'info) ";; Type `C-c C-c' after editing the group info.\n\n"))) ! (insert (pp-to-string (cond ((eq part 'method) (or (gnus-info-method info) "native")) *************** *** 5209,5215 **** (gnus-group-prefixed-name (gnus-group-real-name (car form)) (nth 4 form)))))) ;; Set the info. ! (if (eq part 'info) (progn (when new-group (setcar form new-group)) (gnus-group-set-info form)) --- 5296,5302 ---- (gnus-group-prefixed-name (gnus-group-real-name (car form)) (nth 4 form)))))) ;; Set the info. ! (if (eq part 'info) (progn (when new-group (setcar form new-group)) (gnus-group-set-info form)) *************** *** 5217,5223 **** (kill-buffer (current-buffer)) (and winconf (set-window-configuration winconf)) (set-buffer gnus-group-buffer) ! (when (and new-group (not (equal new-group group))) (when (gnus-group-goto-group group) (gnus-group-kill-group 1)) --- 5304,5310 ---- (kill-buffer (current-buffer)) (and winconf (set-window-configuration winconf)) (set-buffer gnus-group-buffer) ! (when (and new-group (not (equal new-group group))) (when (gnus-group-goto-group group) (gnus-group-kill-group 1)) *************** *** 5229,5266 **** "Create the Gnus documentation group." (interactive) (let ((path load-path) ! (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) ! file dir) (and (gnus-gethash name gnus-newsrc-hashtb) ! (error "Documentation group already exists")) (while path (setq dir (file-name-as-directory (expand-file-name (pop path))) file nil) (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt"))) (file-exists-p ! (setq file (concat (file-name-directory (directory-file-name dir)) "etc/gnus-tut.txt")))) (setq path nil))) (if (not file) ! (message "Couldn't find doc group") ! (gnus-group-make-group (gnus-group-real-name name) (list 'nndoc name ! (list 'nndoc-address file) ! (list 'nndoc-article-type 'mbox))))) (gnus-group-position-point)) (defun gnus-group-make-doc-group (file type) "Create a group that uses a single file as the source." ! (interactive ! (list (read-file-name "File name: ") (and current-prefix-arg 'ask))) (when (eq type 'ask) (let ((err "") char found) (while (not found) ! (message "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: " err) (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) --- 5316,5353 ---- "Create the Gnus documentation group." (interactive) (let ((path load-path) ! (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) ! file dir) (and (gnus-gethash name gnus-newsrc-hashtb) ! (error "Documentation group already exists")) (while path (setq dir (file-name-as-directory (expand-file-name (pop path))) file nil) (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt"))) (file-exists-p ! (setq file (concat (file-name-directory (directory-file-name dir)) "etc/gnus-tut.txt")))) (setq path nil))) (if (not file) ! (message "Couldn't find doc group") ! (gnus-group-make-group (gnus-group-real-name name) (list 'nndoc name ! (list 'nndoc-address file) ! (list 'nndoc-article-type 'mbox))))) (gnus-group-position-point)) (defun gnus-group-make-doc-group (file type) "Create a group that uses a single file as the source." ! (interactive ! (list (read-file-name "File name: ") (and current-prefix-arg 'ask))) (when (eq type 'ask) (let ((err "") char found) (while (not found) ! (message "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: " err) (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) *************** *** 5275,5281 **** (name (gnus-generate-new-group-name (gnus-group-prefixed-name (file-name-nondirectory file) '(nndoc ""))))) ! (gnus-group-make-group (gnus-group-real-name name) (list 'nndoc name (list 'nndoc-address file) --- 5362,5368 ---- (name (gnus-generate-new-group-name (gnus-group-prefixed-name (file-name-nondirectory file) '(nndoc ""))))) ! (gnus-group-make-group (gnus-group-real-name name) (list 'nndoc name (list 'nndoc-address file) *************** *** 5287,5301 **** "Create the (ding) Gnus archive group of the most recent articles. Given a prefix, create a full group." (interactive "P") ! (let ((group (gnus-group-prefixed-name (if all "ding.archives" "ding.recent") '(nndir "")))) (and (gnus-gethash group gnus-newsrc-hashtb) (error "Archive group already exists")) (gnus-group-make-group (gnus-group-real-name group) (list 'nndir (if all "hpc" "edu") ! (list 'nndir-directory ! (if all gnus-group-archive-directory gnus-group-recent-archive-directory))))) (forward-line -1) (gnus-group-position-point)) --- 5374,5388 ---- "Create the (ding) Gnus archive group of the most recent articles. Given a prefix, create a full group." (interactive "P") ! (let ((group (gnus-group-prefixed-name (if all "ding.archives" "ding.recent") '(nndir "")))) (and (gnus-gethash group gnus-newsrc-hashtb) (error "Archive group already exists")) (gnus-group-make-group (gnus-group-real-name group) (list 'nndir (if all "hpc" "edu") ! (list 'nndir-directory ! (if all gnus-group-archive-directory gnus-group-recent-archive-directory))))) (forward-line -1) (gnus-group-position-point)) *************** *** 5303,5309 **** (defun gnus-group-make-directory-group (dir) "Create an nndir group. The user will be prompted for a directory. The contents of this ! directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive (list (read-file-name "Create group from directory: "))) --- 5390,5396 ---- (defun gnus-group-make-directory-group (dir) "Create an nndir group. The user will be prompted for a directory. The contents of this ! directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive (list (read-file-name "Create group from directory: "))) *************** *** 5314,5325 **** group) (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) (setq group ! (gnus-group-prefixed-name (concat (file-name-as-directory (directory-file-name dir)) ext) '(nndir ""))) (setq ext (format "<%d>" (setq i (1+ i))))) ! (gnus-group-make-group (gnus-group-real-name group) (list 'nndir group (list 'nndir-directory dir)))) (forward-line -1) --- 5401,5412 ---- group) (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) (setq group ! (gnus-group-prefixed-name (concat (file-name-as-directory (directory-file-name dir)) ext) '(nndir ""))) (setq ext (format "<%d>" (setq i (1+ i))))) ! (gnus-group-make-group (gnus-group-real-name group) (list 'nndir group (list 'nndir-directory dir)))) (forward-line -1) *************** *** 5338,5347 **** "references" "chars" "lines" "xref" "followup" "all" "body" "head"))) scores header regexp regexps) ! (while (not (equal "" (setq header (completing-read "Match on header: " headers nil t)))) (setq regexps nil) ! (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) (setq regexps (cons (list regexp nil nil 'r) regexps))) --- 5425,5434 ---- "references" "chars" "lines" "xref" "followup" "all" "body" "head"))) scores header regexp regexps) ! (while (not (equal "" (setq header (completing-read "Match on header: " headers nil t)))) (setq regexps nil) ! (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) (setq regexps (cons (list regexp nil nil 'r) regexps))) *************** *** 5352,5358 **** (gnus-set-work-buffer) (let (emacs-lisp-mode-hook) (pp scores (current-buffer))) ! (write-region (point-min) (point-max) (gnus-score-file-name (concat "nnkiboze:" group)))) (forward-line -1) (gnus-group-position-point)) --- 5439,5445 ---- (gnus-set-work-buffer) (let (emacs-lisp-mode-hook) (pp scores (current-buffer))) ! (write-region (point-min) (point-max) (gnus-score-file-name (concat "nnkiboze:" group)))) (forward-line -1) (gnus-group-position-point)) *************** *** 5368,5377 **** (let* ((groups (gnus-group-process-prefix n)) (method (gnus-info-method (gnus-get-info vgroup)))) (setcar (cdr method) ! (concat (nth 1 method) "\\|" ! (mapconcat ! (lambda (s) (gnus-group-remove-mark s) (concat "\\(^" (regexp-quote s) "$\\)")) groups "\\|")))) --- 5455,5464 ---- (let* ((groups (gnus-group-process-prefix n)) (method (gnus-info-method (gnus-get-info vgroup)))) (setcar (cdr method) ! (concat (nth 1 method) "\\|" ! (mapconcat ! (lambda (s) (gnus-group-remove-mark s) (concat "\\(^" (regexp-quote s) "$\\)")) groups "\\|")))) *************** *** 5400,5406 **** method)) (name (gnus-generate-new-group-name leaf))) (let ((nneething-read-only t)) ! (or (gnus-group-read-ephemeral-group name method t (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 'summary 'group))) --- 5487,5493 ---- method)) (name (gnus-generate-new-group-name leaf))) (let ((nneething-read-only t)) ! (or (gnus-group-read-ephemeral-group name method t (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 'summary 'group))) *************** *** 5414,5433 **** If REVERSE, reverse the sorting order." (interactive (list gnus-group-sort-function current-prefix-arg)) ! (unless (listp func) ! (setq func (list func))) ! ;; We peel off the dummy group from the alist. ! (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") ! (pop gnus-newsrc-alist)) ! ;; Do the sorting. ! (while func ! (setq gnus-newsrc-alist ! (sort gnus-newsrc-alist (pop func)))) ! (when reverse ! (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) ! ;; Regenerate the hash table. ! (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups)) (defun gnus-group-sort-groups-by-alphabet (&optional reverse) "Sort the group buffer alphabetically by group name. --- 5501,5526 ---- If REVERSE, reverse the sorting order." (interactive (list gnus-group-sort-function current-prefix-arg)) ! (let ((func (cond ! ((not (listp func)) ! func) ! ((= 1 (length func)) ! (car func)) ! (t ! `(lambda (t1 t2) ! ,(gnus-make-sort-function ! (reverse func))))))) ! ;; We peel off the dummy group from the alist. ! (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") ! (pop gnus-newsrc-alist)) ! ;; Do the sorting. ! (setq gnus-newsrc-alist ! (sort gnus-newsrc-alist func)) ! (when reverse ! (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) ! ;; Regenerate the hash table. ! (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups))) (defun gnus-group-sort-groups-by-alphabet (&optional reverse) "Sort the group buffer alphabetically by group name. *************** *** 5484,5490 **** "Sort alphabetically by backend name." (string< (symbol-name (car (gnus-find-method-for-group (gnus-info-group info1) info1))) ! (symbol-name (car (gnus-find-method-for-group (gnus-info-group info2) info2))))) (defun gnus-group-sort-by-score (info1 info2) --- 5577,5583 ---- "Sort alphabetically by backend name." (string< (symbol-name (car (gnus-find-method-for-group (gnus-info-group info1) info1))) ! (symbol-name (car (gnus-find-method-for-group (gnus-info-group info2) info2))))) (defun gnus-group-sort-by-score (info1 info2) *************** *** 5519,5525 **** (let ((groups (gnus-group-process-prefix n)) (ret 0)) (while groups ! ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) (if (eq 'nnvirtual (car method)) (nnvirtual-catchup-group --- 5612,5618 ---- (let ((groups (gnus-group-process-prefix n)) (ret 0)) (while groups ! ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) (if (eq 'nnvirtual (car method)) (nnvirtual-catchup-group *************** *** 5552,5569 **** (gnus-message 1 "Can't catch up; non-active group") ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) ! (gnus-add-marked-articles group 'expire (gnus-list-of-unread-articles group)) (when all (let ((marks (nth 3 (nth 2 entry)))) ! (gnus-add-marked-articles group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) ! (gnus-add-marked-articles group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) (when entry (gnus-update-read-articles group nil) ! ;; Also nix out the lists of marks and dormants. ! (when all (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) num)))) --- 5645,5662 ---- (gnus-message 1 "Can't catch up; non-active group") ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) ! (gnus-add-marked-articles group 'expire (gnus-list-of-unread-articles group)) (when all (let ((marks (nth 3 (nth 2 entry)))) ! (gnus-add-marked-articles group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) ! (gnus-add-marked-articles group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) (when entry (gnus-update-read-articles group nil) ! ;; Also nix out the lists of marks and dormants. ! (when all (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) num)))) *************** *** 5575,5582 **** group) (unless groups (error "No groups to expire")) ! (while groups ! (setq group (pop groups)) (gnus-group-remove-mark group) (when (gnus-check-backend-function 'request-expire-articles group) (gnus-message 6 "Expiring articles in %s..." group) --- 5668,5674 ---- group) (unless groups (error "No groups to expire")) ! (while (setq group (pop groups)) (gnus-group-remove-mark group) (when (gnus-check-backend-function 'request-expire-articles group) (gnus-message 6 "Expiring articles in %s..." group) *************** *** 5585,5599 **** (cons nil (gnus-list-of-read-articles group)) (assq 'expire (gnus-info-marks info)))) (expiry-wait (gnus-group-get-parameter group 'expiry-wait))) ! (when expirable (setcdr expirable (gnus-compress-sequence (if expiry-wait (let ((nnmail-expiry-wait-function nil) (nnmail-expiry-wait expiry-wait)) ! (gnus-request-expire-articles (gnus-uncompress-sequence (cdr expirable)) group)) ! (gnus-request-expire-articles (gnus-uncompress-sequence (cdr expirable)) group))))) (gnus-message 6 "Expiring articles in %s...done" group))) --- 5677,5691 ---- (cons nil (gnus-list-of-read-articles group)) (assq 'expire (gnus-info-marks info)))) (expiry-wait (gnus-group-get-parameter group 'expiry-wait))) ! (when expirable (setcdr expirable (gnus-compress-sequence (if expiry-wait (let ((nnmail-expiry-wait-function nil) (nnmail-expiry-wait expiry-wait)) ! (gnus-request-expire-articles (gnus-uncompress-sequence (cdr expirable)) group)) ! (gnus-request-expire-articles (gnus-uncompress-sequence (cdr expirable)) group))))) (gnus-message 6 "Expiring articles in %s...done" group))) *************** *** 5613,5623 **** (defun gnus-group-set-current-level (n level) "Set the level of the next N groups to LEVEL." ! (interactive (list current-prefix-arg (string-to-int ! (let ((s (read-string (format "Level (default %s): " (gnus-group-group-level))))) (if (string-match "^\\s-*$" s) (int-to-string (gnus-group-group-level)) --- 5705,5715 ---- (defun gnus-group-set-current-level (n level) "Set the level of the next N groups to LEVEL." ! (interactive (list current-prefix-arg (string-to-int ! (let ((s (read-string (format "Level (default %s): " (gnus-group-group-level))))) (if (string-match "^\\s-*$" s) (int-to-string (gnus-group-group-level)) *************** *** 5630,5639 **** (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) ! (gnus-message 6 "Changed level of %s from %d to %d" ! group (gnus-group-group-level) level) ! (gnus-group-change-level group level ! (gnus-group-group-level)) (gnus-group-update-group-line))) (gnus-group-position-point)) --- 5722,5732 ---- (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) ! (gnus-message 6 "Changed level of %s from %d to %d" ! group (or (gnus-group-group-level) gnus-level-killed) ! level) ! (gnus-group-change-level ! group level (or (gnus-group-group-level) gnus-level-killed)) (gnus-group-update-group-line))) (gnus-group-position-point)) *************** *** 5660,5666 **** group line." (interactive (list (completing-read ! "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond --- 5753,5759 ---- group line." (interactive (list (completing-read ! "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond *************** *** 5668,5676 **** (error "Empty group name")) (newsrc ;; Toggle subscription flag. ! (gnus-group-change-level ! newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) ! gnus-level-subscribed) (1+ gnus-level-subscribed) gnus-level-default-subscribed))) (unless silent --- 5761,5769 ---- (error "Empty group name")) (newsrc ;; Toggle subscription flag. ! (gnus-group-change-level ! newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) ! gnus-level-subscribed) (1+ gnus-level-subscribed) gnus-level-default-subscribed))) (unless silent *************** *** 5679,5689 **** (or (not (memq gnus-select-method gnus-have-read-active-file)) (gnus-active group))) ;; Add new newsgroup. ! (gnus-group-change-level ! group ! (if level level gnus-level-default-subscribed) ! (or (and (member group gnus-zombie-list) ! gnus-level-zombie) gnus-level-killed) (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) --- 5772,5782 ---- (or (not (memq gnus-select-method gnus-have-read-active-file)) (gnus-active group))) ;; Add new newsgroup. ! (gnus-group-change-level ! group ! (if level level gnus-level-default-subscribed) ! (or (and (member group gnus-zombie-list) ! gnus-level-zombie) gnus-level-killed) (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) *************** *** 5694,5701 **** (defun gnus-group-transpose-groups (n) "Move the current newsgroup up N places. ! If given a negative prefix, move down instead. The difference between ! N and the number of steps taken is returned." (interactive "p") (or (gnus-group-group-name) (error "No group on current line")) --- 5787,5794 ---- (defun gnus-group-transpose-groups (n) "Move the current newsgroup up N places. ! If given a negative prefix, move down instead. The difference between ! N and the number of steps taken is returned." (interactive "p") (or (gnus-group-group-name) (error "No group on current line")) *************** *** 5735,5741 **** (defun gnus-group-kill-group (&optional n discard) "Kill the next N groups. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. ! However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. The return value is the name of the group that was killed, or a list of groups killed." --- 5828,5834 ---- (defun gnus-group-kill-group (&optional n discard) "Kill the next N groups. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. ! However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. The return value is the name of the group that was killed, or a list of groups killed." *************** *** 5752,5761 **** (gnus-delete-line) (if (and (not discard) (setq entry (gnus-gethash group gnus-newsrc-hashtb))) ! (setq gnus-list-of-killed-groups ! (cons (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups))) ! (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level))) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. --- 5845,5854 ---- (gnus-delete-line) (if (and (not discard) (setq entry (gnus-gethash group gnus-newsrc-hashtb))) ! (setq gnus-list-of-killed-groups ! (cons (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups))) ! (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level))) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. *************** *** 5769,5775 **** gnus-list-of-killed-groups) (setcdr (cdr entry) (cdr (cdr (cdr entry))))) (gnus-make-hashtable-from-newsrc-alist))) ! (gnus-group-position-point) (if (< (length out) 2) (car out) (nreverse out)))) --- 5862,5868 ---- gnus-list-of-killed-groups) (setcdr (cdr entry) (cdr (cdr (cdr entry))))) (gnus-make-hashtable-from-newsrc-alist))) ! (gnus-group-position-point) (if (< (length out) 2) (car out) (nreverse out)))) *************** *** 5791,5798 **** ;; other newsgroups in this buffer, just make this newsgroup the ;; first newsgroup. (setq prev (gnus-group-group-name)) ! (gnus-group-change-level ! info (nth 2 info) gnus-level-killed (and prev (gnus-gethash prev gnus-newsrc-hashtb)) t) (gnus-group-insert-group-line-info group)) --- 5884,5891 ---- ;; other newsgroups in this buffer, just make this newsgroup the ;; first newsgroup. (setq prev (gnus-group-group-name)) ! (gnus-group-change-level ! info (nth 2 info) gnus-level-killed (and prev (gnus-gethash prev gnus-newsrc-hashtb)) t) (gnus-group-insert-group-line-info group)) *************** *** 5803,5809 **** (defun gnus-group-kill-level (level) "Kill all groups that is on a certain LEVEL." (interactive "nKill all groups on level: ") ! (cond ((= level gnus-level-zombie) (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) --- 5896,5902 ---- (defun gnus-group-kill-level (level) "Kill all groups that is on a certain LEVEL." (interactive "nKill all groups on level: ") ! (cond ((= level gnus-level-zombie) (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) *************** *** 5812,5818 **** (> level 0) (or gnus-expert-user (gnus-yes-or-no-p ! (format "Do you really want to kill all groups on level %d? " level)))) (let* ((prev gnus-newsrc-alist) --- 5905,5911 ---- (> level 0) (or gnus-expert-user (gnus-yes-or-no-p ! (format "Do you really want to kill all groups on level %d? " level)))) (let* ((prev gnus-newsrc-alist) *************** *** 5826,5832 **** (gnus-group-list-groups))) (t (error "Can't kill; illegal level: %d" level)))) ! (defun gnus-group-list-all-groups (&optional arg) "List all newsgroups with level ARG or lower. Default is gnus-level-unsubscribed, which lists all subscribed and most --- 5919,5925 ---- (gnus-group-list-groups))) (t (error "Can't kill; illegal level: %d" level)))) ! (defun gnus-group-list-all-groups (&optional arg) "List all newsgroups with level ARG or lower. Default is gnus-level-unsubscribed, which lists all subscribed and most *************** *** 5861,5874 **** (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) () (setq groups (1+ groups)) ! (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb)))))) gnus-active-hashtb)) (if (not gnus-killed-list) (gnus-message 6 "No killed groups") (let (gnus-group-list-mode) ! (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)) (goto-char (point-min))) (gnus-group-position-point)) --- 5954,5967 ---- (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) () (setq groups (1+ groups)) ! (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb)))))) gnus-active-hashtb)) (if (not gnus-killed-list) (gnus-message 6 "No killed groups") (let (gnus-group-list-mode) ! (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)) (goto-char (point-min))) (gnus-group-position-point)) *************** *** 5887,5899 **** (defun gnus-group-list-active () "List all groups that are available from the server(s)." (interactive) ! ;; First we make sure that we have really read the active file. (unless gnus-have-read-active-file (let ((gnus-read-active-file t)) (gnus-read-active-file))) ;; Find all groups and sort them. ! (let ((groups ! (sort (let (list) (mapatoms (lambda (sym) --- 5980,5992 ---- (defun gnus-group-list-active () "List all groups that are available from the server(s)." (interactive) ! ;; First we make sure that we have really read the active file. (unless gnus-have-read-active-file (let ((gnus-read-active-file t)) (gnus-read-active-file))) ;; Find all groups and sort them. ! (let ((groups ! (sort (let (list) (mapatoms (lambda (sym) *************** *** 5954,5996 **** (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) ! (or (gnus-get-new-news-in-group group) ! (progn ! (ding) ! (gnus-message 3 "%s error: %s" group (gnus-status-message group)) ! (sit-for 2)))) ! (gnus-group-next-unread-group 1 t) (gnus-summary-position-point) ret)) (defun gnus-get-new-news-in-group (group) (when (and group (gnus-activate-group group 'scan)) ! (gnus-get-unread-articles-in-group ! (gnus-get-info group) (gnus-active group)) (when (gnus-group-goto-group group) (gnus-group-update-group-line)) t)) (defun gnus-group-fetch-faq (group &optional faq-dir) "Fetch the FAQ for the current group." ! (interactive (list (gnus-group-real-name (gnus-group-group-name)) (cond (current-prefix-arg ! (completing-read ! "Faq dir: " (and (listp gnus-group-faq-directory) gnus-group-faq-directory)))))) (or faq-dir (setq faq-dir (if (listp gnus-group-faq-directory) ! (car gnus-group-faq-directory) ! gnus-group-faq-directory))) (or group (error "No group name given")) (let ((file (concat (file-name-as-directory faq-dir) (gnus-group-real-name group)))) (if (not (file-exists-p file)) (error "No such file: %s" file) (find-file file)))) ! (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) --- 6047,6088 ---- (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) ! (unless (gnus-get-new-news-in-group group) ! (ding) ! (gnus-message 3 "%s error: %s" group (gnus-status-message group)))) ! (when gnus-goto-next-group-when-activating ! (gnus-group-next-unread-group 1 t)) (gnus-summary-position-point) ret)) (defun gnus-get-new-news-in-group (group) (when (and group (gnus-activate-group group 'scan)) ! (gnus-get-unread-articles-in-group ! (gnus-get-info group) (gnus-active group) t) (when (gnus-group-goto-group group) (gnus-group-update-group-line)) t)) (defun gnus-group-fetch-faq (group &optional faq-dir) "Fetch the FAQ for the current group." ! (interactive (list (gnus-group-real-name (gnus-group-group-name)) (cond (current-prefix-arg ! (completing-read ! "Faq dir: " (and (listp gnus-group-faq-directory) gnus-group-faq-directory)))))) (or faq-dir (setq faq-dir (if (listp gnus-group-faq-directory) ! (car gnus-group-faq-directory) ! gnus-group-faq-directory))) (or group (error "No group name given")) (let ((file (concat (file-name-as-directory faq-dir) (gnus-group-real-name group)))) (if (not (file-exists-p file)) (error "No such file: %s" file) (find-file file)))) ! (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) *************** *** 6000,6012 **** (or group (error "No group name given")) (and (or (and gnus-description-hashtb ;; We check whether this group's method has been ! ;; queried for a description file. ! (gnus-gethash ! (gnus-group-prefixed-name "" method) gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) (gnus-read-descriptions-file method)) ! (message (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) --- 6092,6104 ---- (or group (error "No group name given")) (and (or (and gnus-description-hashtb ;; We check whether this group's method has been ! ;; queried for a description file. ! (gnus-gethash ! (gnus-group-prefixed-name "" method) gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) (gnus-read-descriptions-file method)) ! (message (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) *************** *** 6026,6032 **** (setq b (point)) (insert (format " *: %-20s %s\n" (symbol-name group) (symbol-value group))) ! (add-text-properties b (1+ b) (list 'gnus-group group 'gnus-unread t 'gnus-marked nil 'gnus-level (1+ gnus-level-subscribed)))) --- 6118,6124 ---- (setq b (point)) (insert (format " *: %-20s %s\n" (symbol-name group) (symbol-value group))) ! (add-text-properties b (1+ b) (list 'gnus-group group 'gnus-unread t 'gnus-marked nil 'gnus-level (1+ gnus-level-subscribed)))) *************** *** 6042,6056 **** (obuf (current-buffer)) groups des) ;; Go through all newsgroups that are known to Gnus. ! (mapatoms (lambda (group) (and (symbol-name group) (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)) --- 6134,6148 ---- (obuf (current-buffer)) groups des) ;; Go through all newsgroups that are known to Gnus. ! (mapatoms (lambda (group) (and (symbol-name group) (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)) *************** *** 6070,6076 **** (progn (insert (setq prev (car groups)) "\n") (if (and gnus-description-hashtb ! (setq des (gnus-gethash (car groups) gnus-description-hashtb))) (insert " " des "\n")))) (setq groups (cdr groups))) --- 6162,6168 ---- (progn (insert (setq prev (car groups)) "\n") (if (and gnus-description-hashtb ! (setq des (gnus-gethash (car groups) gnus-description-hashtb))) (insert " " des "\n")))) (setq groups (cdr groups))) *************** *** 6086,6095 **** (gnus-group-apropos regexp t)) ;; Suggested by Per Abrahamsen . ! (defun gnus-group-list-matching (level regexp &optional all lowest) "List all groups with unread articles that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If ALL, also list groups with no unread articles. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") --- 6178,6187 ---- (gnus-group-apropos regexp t)) ;; Suggested by Per Abrahamsen . ! (defun gnus-group-list-matching (level regexp &optional all lowest) "List all groups with unread articles that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If ALL, also list groups with no unread articles. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") *************** *** 6098,6107 **** (goto-char (point-min)) (gnus-group-position-point)) ! (defun gnus-group-list-all-matching (level regexp &optional lowest) "List all groups that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) --- 6190,6199 ---- (goto-char (point-min)) (gnus-group-position-point)) ! (defun gnus-group-list-all-matching (level regexp &optional lowest) "List all groups that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) *************** *** 6139,6145 **** (interactive "P") (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) ! (gnus-message 6 (substitute-command-keys (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" --- 6231,6237 ---- (interactive "P") (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) ! (gnus-message 6 (substitute-command-keys (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" *************** *** 6201,6212 **** (gnus-close-backends) ;; Shut down the cache. (when gnus-use-cache ! (gnus-cache-open)) ;; Reset everything. (gnus-clear-system)))) (defun gnus-close-backends () ! ;; Send a close request to all backends that support such a request. (let ((methods gnus-valid-select-methods) func) (while methods --- 6293,6304 ---- (gnus-close-backends) ;; Shut down the cache. (when gnus-use-cache ! (gnus-cache-close)) ;; Reset everything. (gnus-clear-system)))) (defun gnus-close-backends () ! ;; Send a close request to all backends that support such a request. (let ((methods gnus-valid-select-methods) func) (while methods *************** *** 6235,6247 **** (gnus-close-backends) ;; Shut down the cache. (when gnus-use-cache ! (gnus-cache-open)) (gnus-clear-system))) (defun gnus-offer-save-summaries () "Offer to save all active summary buffers." (save-excursion ! (let ((buflist (buffer-list)) buffers bufname) ;; Go through all buffers and find all summaries. (while buflist --- 6327,6339 ---- (gnus-close-backends) ;; Shut down the cache. (when gnus-use-cache ! (gnus-cache-close)) (gnus-clear-system))) (defun gnus-offer-save-summaries () "Offer to save all active summary buffers." (save-excursion ! (let ((buflist (buffer-list)) buffers bufname) ;; Go through all buffers and find all summaries. (while buflist *************** *** 6257,6263 **** (setq buflist (cdr buflist))) ;; Go through all these summary buffers and offer to save them. (when buffers ! (map-y-or-n-p "Update summary buffer %s? " (lambda (buf) (set-buffer buf) (gnus-summary-exit)) buffers))))) --- 6349,6355 ---- (setq buflist (cdr buflist))) ;; Go through all these summary buffers and offer to save them. (when buffers ! (map-y-or-n-p "Update summary buffer %s? " (lambda (buf) (set-buffer buf) (gnus-summary-exit)) buffers))))) *************** *** 6270,6290 **** (defun gnus-group-browse-foreign-server (method) "Browse a foreign news server. If called interactively, this function will ask for a select method ! (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive ! (list (let ((how (completing-read "Which backend: " (append gnus-valid-select-methods gnus-server-alist) ! nil t "nntp"))) ;; We either got a backend name or a virtual server name. ;; If the first, we also need an address. (if (assoc how gnus-valid-select-methods) (list (intern how) ;; Suggested by mapjph@bath.ac.uk. ! (completing-read ! "Address: " (mapcar (lambda (server) (list server)) gnus-secondary-servers))) ;; We got a server name, so we find the method. --- 6362,6382 ---- (defun gnus-group-browse-foreign-server (method) "Browse a foreign news server. If called interactively, this function will ask for a select method ! (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive ! (list (let ((how (completing-read "Which backend: " (append gnus-valid-select-methods gnus-server-alist) ! nil t (cons "nntp" 0)))) ;; We either got a backend name or a virtual server name. ;; If the first, we also need an address. (if (assoc how gnus-valid-select-methods) (list (intern how) ;; Suggested by mapjph@bath.ac.uk. ! (completing-read ! "Address: " (mapcar (lambda (server) (list server)) gnus-secondary-servers))) ;; We got a server name, so we find the method. *************** *** 6293,6851 **** ;;; - ;;; Browse Server Mode - ;;; - - (defvar gnus-browse-mode-hook nil) - (defvar gnus-browse-mode-map nil) - (put 'gnus-browse-mode 'mode-class 'special) - - (if gnus-browse-mode-map - nil - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - (define-key gnus-browse-mode-map " " 'gnus-browse-read-group) - (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group) - (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group) - (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group) - (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group) - (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group) - (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group) - (define-key gnus-browse-mode-map "l" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "L" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "q" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly) - (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node) - ) - - (defvar gnus-browse-current-method nil) - (defvar gnus-browse-return-buffer nil) - - (defvar gnus-browse-buffer "*Gnus Browse Server*") - - (defun gnus-browse-foreign-server (method &optional return-buffer) - "Browse the server METHOD." - (setq gnus-browse-current-method method) - (setq gnus-browse-return-buffer return-buffer) - (let ((gnus-select-method method) - groups group) - (gnus-message 5 "Connecting to %s..." (nth 1 method)) - (cond - ((not (gnus-check-server method)) - (gnus-message - 1 "Unable to contact server: %s" (gnus-status-message method)) - nil) - ((not (gnus-request-list method)) - (gnus-message - 1 "Couldn't request list: %s" (gnus-status-message method)) - nil) - (t - (get-buffer-create gnus-browse-buffer) - (gnus-add-current-to-buffer-list) - (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) - (gnus-configure-windows 'browse) - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer)) - (gnus-browse-mode) - (setq mode-line-buffer-identification - (list - (format - "Gnus: %%b {%s:%s}" (car method) (car (cdr method))))) - (save-excursion - (set-buffer nntp-server-buffer) - (let ((cur (current-buffer))) - (goto-char (point-min)) - (or (string= gnus-ignored-newsgroups "") - (delete-matching-lines gnus-ignored-newsgroups)) - (while (re-search-forward - "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) - (goto-char (match-end 1)) - (setq groups (cons (cons (match-string 1) - (max 0 (- (1+ (read cur)) (read cur)))) - groups))))) - (setq groups (sort groups - (lambda (l1 l2) - (string< (car l1) (car l2))))) - (let ((buffer-read-only nil)) - (while groups - (setq group (car groups)) - (insert - (format "K%7d: %s\n" (cdr group) (car group))) - (setq groups (cdr groups)))) - (switch-to-buffer (current-buffer)) - (goto-char (point-min)) - (gnus-group-position-point) - t)))) - - (defun gnus-browse-mode () - "Major mode for browsing a foreign server. - - All normal editing commands are switched off. - - \\ - The only things you can do in this buffer is - - 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. - The group will be inserted into the group buffer upon exit from this - buffer. - - 2) `\\[gnus-browse-read-group]' to read a group ephemerally. - - 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) - (setq mode-name "Browse Server") - (setq mode-line-process nil) - (use-local-map gnus-browse-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (run-hooks 'gnus-browse-mode-hook)) - - (defun gnus-browse-read-group (&optional no-article) - "Enter the group at the current line." - (interactive) - (let ((group (gnus-browse-group-name))) - (or (gnus-group-read-ephemeral-group - group gnus-browse-current-method nil - (cons (current-buffer) 'browse)) - (error "Couldn't enter %s" group)))) - - (defun gnus-browse-select-group () - "Select the current group." - (interactive) - (gnus-browse-read-group 'no)) - - (defun gnus-browse-next-group (n) - "Go to the next group." - (interactive "p") - (prog1 - (forward-line n) - (gnus-group-position-point))) - - (defun gnus-browse-prev-group (n) - "Go to the next group." - (interactive "p") - (gnus-browse-next-group (- n))) - - (defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." - (interactive "p") - (and (eobp) - (error "No group at current line.")) - (let ((ward (if (< arg 0) -1 1)) - (arg (abs arg))) - (while (and (> arg 0) - (not (eobp)) - (gnus-browse-unsubscribe-group) - (zerop (gnus-browse-next-group ward))) - (setq arg (1- arg))) - (gnus-group-position-point) - (if (/= 0 arg) (gnus-message 7 "No more newsgroups")) - arg)) - - (defun gnus-browse-group-name () - (save-excursion - (beginning-of-line) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) - (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method)))) - - (defun gnus-browse-unsubscribe-group () - "Toggle subscription of the current group in the browse buffer." - (let ((sub nil) - (buffer-read-only nil) - group) - (save-excursion - (beginning-of-line) - ;; If this group it killed, then we want to subscribe it. - (if (= (following-char) ?K) (setq sub t)) - (setq group (gnus-browse-group-name)) - (delete-char 1) - (if sub - (progn - (gnus-group-change-level - (list t group gnus-level-default-subscribed - nil nil gnus-browse-current-method) - gnus-level-default-subscribed gnus-level-killed - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-gethash (car (nth 1 gnus-newsrc-alist)) - gnus-newsrc-hashtb)) - t) - (insert ? )) - (gnus-group-change-level - group gnus-level-killed gnus-level-default-subscribed) - (insert ?K))) - t)) - - (defun gnus-browse-exit () - "Quit browsing and return to the group buffer." - (interactive) - (if (eq major-mode 'gnus-browse-mode) - (kill-buffer (current-buffer))) - (if gnus-browse-return-buffer - (gnus-configure-windows 'server 'force) - (gnus-configure-windows 'group 'force) - (gnus-group-list-groups nil))) - - (defun gnus-browse-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) - - - ;;; ;;; Gnus summary mode ;;; (defvar gnus-summary-mode-map nil) - (defvar gnus-summary-mark-map nil) - (defvar gnus-summary-mscore-map nil) - (defvar gnus-summary-article-map nil) - (defvar gnus-summary-thread-map nil) - (defvar gnus-summary-goto-map nil) - (defvar gnus-summary-exit-map nil) - (defvar gnus-summary-interest-map nil) - (defvar gnus-summary-sort-map nil) - (defvar gnus-summary-backend-map nil) - (defvar gnus-summary-save-map nil) - (defvar gnus-summary-wash-map nil) - (defvar gnus-summary-wash-hide-map nil) - (defvar gnus-summary-wash-highlight-map nil) - (defvar gnus-summary-wash-time-map nil) - (defvar gnus-summary-help-map nil) - (defvar gnus-summary-limit-map nil) (put 'gnus-summary-mode 'mode-class 'special) ! (if gnus-summary-mode-map ! nil (setq gnus-summary-mode-map (make-keymap)) (suppress-keymap gnus-summary-mode-map) ;; Non-orthogonal keys ! (define-key gnus-summary-mode-map " " 'gnus-summary-next-page) ! (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page) ! (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up) ! (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article) ! (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article) ! (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article) ! (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article) ! (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject) ! (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject) ! (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject) ! (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject) ! (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article) ! (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article) ! (define-key gnus-summary-mode-map ! "\M-s" 'gnus-summary-search-article-forward) ! (define-key gnus-summary-mode-map ! "\M-r" 'gnus-summary-search-article-backward) ! (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article) ! (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article) ! (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-article) ! (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article) ! (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article) ! (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward) ! (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward) ! (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward) ! (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable) ! (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward) ! (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward) ! (define-key gnus-summary-mode-map ! "k" 'gnus-summary-kill-same-subject-and-select) ! (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject) ! (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread) ! (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread) ! (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article) ! (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable) ! (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable) ! (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads) ! (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread) ! (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread) ! (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread) ! (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread) ! (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread) ! (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread) ! (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command) ! (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit) ! (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read) ! (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation) ! (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant) ! (define-key gnus-summary-mode-map ! "\C-c\M-\C-s" 'gnus-summary-limit-include-expunged) ! (define-key gnus-summary-mode-map ! "\C-c\C-s\C-n" 'gnus-summary-sort-by-number) ! (define-key gnus-summary-mode-map ! "\C-c\C-s\C-a" 'gnus-summary-sort-by-author) ! (define-key gnus-summary-mode-map ! "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject) ! (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date) ! (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score) ! (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window) ! (define-key gnus-summary-mode-map ! "\C-x\C-s" 'gnus-summary-reselect-current-group) ! (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group) ! (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking) ! (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message) ! (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime) ! (define-key gnus-summary-mode-map "f" 'gnus-summary-followup) ! (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original) ! (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article) ! (define-key gnus-summary-mode-map "r" 'gnus-summary-reply) ! (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original) ! (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward) ! (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article) ! (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail) ! (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output) ! (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill) ! (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill) ! (define-key gnus-summary-mode-map "V" 'gnus-version) ! (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group) ! (define-key gnus-summary-mode-map "q" 'gnus-summary-exit) ! (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update) ! (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node) ! (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article) ! (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window) ! (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news) ! (define-key gnus-summary-mode-map "x" 'gnus-summary-limit-to-unread) ! (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article) ! (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header) ! (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article) ! ; (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly) ! (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article) ! (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view) ! (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group) ! (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers) ! (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug) ! ! (define-key gnus-summary-mode-map "*" 'gnus-cache-enter-article) ! (define-key gnus-summary-mode-map "\M-*" 'gnus-cache-remove-article) ;; Sort of orthogonal keymap ! (define-prefix-command 'gnus-summary-mark-map) ! (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map) ! (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward) ! (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward) ! (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward) ! (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward) ! (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable) ! (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable) ! (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant) ! (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark) ! (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark) ! (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable) ! (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable) ! (define-key gnus-summary-mark-map "S" 'gnus-summary-limit-include-expunged) ! (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup) ! (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here) ! (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all) ! (define-key gnus-summary-mark-map ! "k" 'gnus-summary-kill-same-subject-and-select) ! (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject) ! ! (define-prefix-command 'gnus-summary-mscore-map) ! (define-key gnus-summary-mark-map "V" 'gnus-summary-mscore-map) ! (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above) ! (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above) ! (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above) ! (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below) ! ! (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map) ! ! (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) ! ! (define-prefix-command 'gnus-summary-limit-map) ! (define-key gnus-summary-mode-map "/" 'gnus-summary-limit-map) ! (define-key gnus-summary-limit-map "/" 'gnus-summary-limit-to-subject) ! (define-key gnus-summary-limit-map "n" 'gnus-summary-limit-to-articles) ! (define-key gnus-summary-limit-map "w" 'gnus-summary-pop-limit) ! (define-key gnus-summary-limit-map "s" 'gnus-summary-limit-to-subject) ! (define-key gnus-summary-limit-map "u" 'gnus-summary-limit-to-unread) ! (define-key gnus-summary-limit-map "m" 'gnus-summary-limit-to-marks) ! (define-key gnus-summary-limit-map "v" 'gnus-summary-limit-to-score) ! (define-key gnus-summary-limit-map "D" 'gnus-summary-limit-include-dormant) ! (define-key gnus-summary-limit-map "d" 'gnus-summary-limit-exclude-dormant) ! ; (define-key gnus-summary-limit-map "t" 'gnus-summary-limit-exclude-thread) ! (define-key gnus-summary-mark-map "E" 'gnus-summary-limit-include-expunged) ! (define-key gnus-summary-limit-map "c" ! 'gnus-summary-limit-exclude-childless-dormant) ! ! (define-prefix-command 'gnus-summary-goto-map) ! (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map) ! (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article) ! (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article) ! (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article) ! (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article) ! (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject) ! (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject) ! (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject) ! (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject) ! (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article) ! (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article) ! (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject) ! (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article) ! (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article) ! ! ! (define-prefix-command 'gnus-summary-thread-map) ! (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map) ! (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread) ! (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread) ! (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread) ! (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads) ! (define-key gnus-summary-thread-map "T" 'gnus-summary-rethread-current) ! (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread) ! (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads) ! (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread) ! (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads) ! (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread) ! (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread) ! (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread) ! (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread) ! (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread) ! (define-key gnus-summary-thread-map "\M-#" 'gnus-uu-unmark-thread) ! ! ! (define-prefix-command 'gnus-summary-exit-map) ! (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map) ! (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit) ! (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit) ! (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update) ! (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit) ! (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit) ! (define-key gnus-summary-exit-map ! "n" 'gnus-summary-catchup-and-goto-next-group) ! (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group) ! (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group) ! (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group) ! (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group) ! ! ! (define-prefix-command 'gnus-summary-article-map) ! (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map) ! (define-key gnus-summary-article-map " " 'gnus-summary-next-page) ! (define-key gnus-summary-article-map "n" 'gnus-summary-next-page) ! (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page) ! (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page) ! (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up) ! (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article) ! (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article) ! (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article) ! (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article) ! (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article) ! (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article) ! (define-key gnus-summary-article-map "R" 'gnus-summary-refer-references) ! (define-key gnus-summary-article-map "g" 'gnus-summary-show-article) ! (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article) ! ! ! ! (define-prefix-command 'gnus-summary-wash-map) ! (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map) ! ! (define-prefix-command 'gnus-summary-wash-hide-map) ! (define-key gnus-summary-wash-map "W" 'gnus-summary-wash-hide-map) ! (define-key gnus-summary-wash-hide-map "a" 'gnus-article-hide) ! (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers) ! (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature) ! (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation) ! (define-key gnus-summary-wash-hide-map "p" 'gnus-article-hide-pgp) ! (define-key gnus-summary-wash-hide-map ! "\C-c" 'gnus-article-hide-citation-maybe) ! ! (define-prefix-command 'gnus-summary-wash-highlight-map) ! (define-key gnus-summary-wash-map "H" 'gnus-summary-wash-highlight-map) ! (define-key gnus-summary-wash-highlight-map "a" 'gnus-article-highlight) ! (define-key gnus-summary-wash-highlight-map ! "h" 'gnus-article-highlight-headers) ! (define-key gnus-summary-wash-highlight-map ! "c" 'gnus-article-highlight-citation) ! (define-key gnus-summary-wash-highlight-map ! "s" 'gnus-article-highlight-signature) ! ! (define-prefix-command 'gnus-summary-wash-time-map) ! (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map) ! (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut) ! (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut) ! (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local) ! (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed) ! (define-key gnus-summary-wash-time-map "o" 'gnus-article-date-original) ! ! (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons) ! (define-key gnus-summary-wash-map "B" 'gnus-article-add-buttons-to-head) ! (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike) ! (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap) ! (define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr) ! (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable) ! (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face) ! (define-key gnus-summary-wash-map "l" 'gnus-summary-stop-page-breaking) ! (define-key gnus-summary-wash-map "r" 'gnus-summary-caesar-message) ! (define-key gnus-summary-wash-map "t" 'gnus-summary-toggle-header) ! (define-key gnus-summary-wash-map "m" 'gnus-summary-toggle-mime) ! ! ! (define-prefix-command 'gnus-summary-help-map) ! (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map) ! (define-key gnus-summary-help-map "v" 'gnus-version) ! (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq) ! (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group) ! (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly) ! (define-key gnus-summary-help-map "i" 'gnus-info-find-node) ! ! ! (define-prefix-command 'gnus-summary-backend-map) ! (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map) ! (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles) ! (define-key gnus-summary-backend-map "\M-\C-e" ! 'gnus-summary-expire-articles-now) ! (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article) ! (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article) ! (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article) ! (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article) ! (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article) ! (define-key gnus-summary-backend-map "q" 'gnus-summary-respool-query) ! (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article) ! ! ! (define-prefix-command 'gnus-summary-save-map) ! (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map) ! (define-key gnus-summary-save-map "o" 'gnus-summary-save-article) ! (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail) ! (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail) ! (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file) ! (define-key gnus-summary-save-map "b" 'gnus-summary-save-article-body-file) ! (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder) ! (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm) ! (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output) ! (define-key gnus-summary-save-map "s" 'gnus-soup-add-article) ! ! (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) ! ! (define-key gnus-summary-mode-map "\M-&" 'gnus-summary-universal-argument) ! (define-key gnus-summary-article-map "D" 'gnus-summary-enter-digest-group) ! ! (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map) ! ! (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score) ! (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score) ) --- 6385,6689 ---- ;;; ;;; Gnus summary mode ;;; (defvar gnus-summary-mode-map nil) (put 'gnus-summary-mode 'mode-class 'special) ! (unless gnus-summary-mode-map (setq gnus-summary-mode-map (make-keymap)) (suppress-keymap gnus-summary-mode-map) ;; Non-orthogonal keys ! (gnus-define-keys ! gnus-summary-mode-map ! " " gnus-summary-next-page ! "\177" gnus-summary-prev-page ! "\r" gnus-summary-scroll-up ! "n" gnus-summary-next-unread-article ! "p" gnus-summary-prev-unread-article ! "N" gnus-summary-next-article ! "P" gnus-summary-prev-article ! "\M-\C-n" gnus-summary-next-same-subject ! "\M-\C-p" gnus-summary-prev-same-subject ! "\M-n" gnus-summary-next-unread-subject ! "\M-p" gnus-summary-prev-unread-subject ! "." gnus-summary-first-unread-article ! "," gnus-summary-best-unread-article ! "\M-s" gnus-summary-search-article-forward ! "\M-r" gnus-summary-search-article-backward ! "<" gnus-summary-beginning-of-article ! ">" gnus-summary-end-of-article ! "j" gnus-summary-goto-article ! "^" gnus-summary-refer-parent-article ! "\M-^" gnus-summary-refer-article ! "u" gnus-summary-tick-article-forward ! "!" gnus-summary-tick-article-forward ! "U" gnus-summary-tick-article-backward ! "d" gnus-summary-mark-as-read-forward ! "D" gnus-summary-mark-as-read-backward ! "E" gnus-summary-mark-as-expirable ! "\M-u" gnus-summary-clear-mark-forward ! "\M-U" gnus-summary-clear-mark-backward ! "k" gnus-summary-kill-same-subject-and-select ! "\C-k" gnus-summary-kill-same-subject ! "\M-\C-k" gnus-summary-kill-thread ! "\M-\C-l" gnus-summary-lower-thread ! "e" gnus-summary-edit-article ! "#" gnus-summary-mark-as-processable ! "\M-#" gnus-summary-unmark-as-processable ! "\M-\C-t" gnus-summary-toggle-threads ! "\M-\C-s" gnus-summary-show-thread ! "\M-\C-h" gnus-summary-hide-thread ! "\M-\C-f" gnus-summary-next-thread ! "\M-\C-b" gnus-summary-prev-thread ! "\M-\C-u" gnus-summary-up-thread ! "\M-\C-d" gnus-summary-down-thread ! "&" gnus-summary-execute-command ! "c" gnus-summary-catchup-and-exit ! "\C-w" gnus-summary-mark-region-as-read ! "\C-t" gnus-summary-toggle-truncation ! "?" gnus-summary-mark-as-dormant ! "\C-c\M-\C-s" gnus-summary-limit-include-expunged ! "\C-c\C-s\C-n" gnus-summary-sort-by-number ! "\C-c\C-s\C-a" gnus-summary-sort-by-author ! "\C-c\C-s\C-s" gnus-summary-sort-by-subject ! "\C-c\C-s\C-d" gnus-summary-sort-by-date ! "\C-c\C-s\C-i" gnus-summary-sort-by-score ! "=" gnus-summary-expand-window ! "\C-x\C-s" gnus-summary-reselect-current-group ! "\M-g" gnus-summary-rescan-group ! "w" gnus-summary-stop-page-breaking ! "\C-c\C-r" gnus-summary-caesar-message ! "\M-t" gnus-summary-toggle-mime ! "f" gnus-summary-followup ! "F" gnus-summary-followup-with-original ! "C" gnus-summary-cancel-article ! "r" gnus-summary-reply ! "R" gnus-summary-reply-with-original ! "\C-c\C-f" gnus-summary-mail-forward ! "o" gnus-summary-save-article ! "\C-o" gnus-summary-save-article-mail ! "|" gnus-summary-pipe-output ! "\M-k" gnus-summary-edit-local-kill ! "\M-K" gnus-summary-edit-global-kill ! "V" gnus-version ! "\C-c\C-d" gnus-summary-describe-group ! "q" gnus-summary-exit ! "Q" gnus-summary-exit-no-update ! "\C-c\C-i" gnus-info-find-node ! gnus-mouse-2 gnus-mouse-pick-article ! "m" gnus-summary-mail-other-window ! "a" gnus-summary-post-news ! "x" gnus-summary-limit-to-unread ! "s" gnus-summary-isearch-article ! "t" gnus-summary-toggle-header ! "g" gnus-summary-show-article ! "l" gnus-summary-goto-last-article ! "\C-c\C-v\C-v" gnus-uu-decode-uu-view ! "\C-d" gnus-summary-enter-digest-group ! "v" gnus-summary-verbose-headers ! "\C-c\C-b" gnus-bug ! "*" gnus-cache-enter-article ! "\M-*" gnus-cache-remove-article ! "\M-&" gnus-summary-universal-argument ! "D" gnus-summary-enter-digest-group ! "I" gnus-summary-increase-score ! "L" gnus-summary-lower-score ! ! "V" gnus-summary-score-map ! "X" gnus-uu-extract-map ! "S" gnus-summary-send-map) ;; Sort of orthogonal keymap ! (gnus-define-keys ! (gnus-summary-mark-map "M" gnus-summary-mode-map) ! "t" gnus-summary-tick-article-forward ! "!" gnus-summary-tick-article-forward ! "d" gnus-summary-mark-as-read-forward ! "r" gnus-summary-mark-as-read-forward ! "c" gnus-summary-clear-mark-forward ! " " gnus-summary-clear-mark-forward ! "e" gnus-summary-mark-as-expirable ! "x" gnus-summary-mark-as-expirable ! "?" gnus-summary-mark-as-dormant ! "b" gnus-summary-set-bookmark ! "B" gnus-summary-remove-bookmark ! "#" gnus-summary-mark-as-processable ! "\M-#" gnus-summary-unmark-as-processable ! "S" gnus-summary-limit-include-expunged ! "C" gnus-summary-catchup ! "H" gnus-summary-catchup-to-here ! "\C-c" gnus-summary-catchup-all ! "k" gnus-summary-kill-same-subject-and-select ! "K" gnus-summary-kill-same-subject ! "P" gnus-uu-mark-map) ! ! (gnus-define-keys ! (gnus-summary-mscore-map "V" gnus-summary-mode-map) ! "c" gnus-summary-clear-above ! "u" gnus-summary-tick-above ! "m" gnus-summary-mark-above ! "k" gnus-summary-kill-below) ! ! (gnus-define-keys ! (gnus-summary-limit-map "/" gnus-summary-mode-map) ! "/" gnus-summary-limit-to-subject ! "n" gnus-summary-limit-to-articles ! "w" gnus-summary-pop-limit ! "s" gnus-summary-limit-to-subject ! "a" gnus-summary-limit-to-author ! "u" gnus-summary-limit-to-unread ! "m" gnus-summary-limit-to-marks ! "v" gnus-summary-limit-to-score ! "D" gnus-summary-limit-include-dormant ! "d" gnus-summary-limit-exclude-dormant ! ;; "t" gnus-summary-limit-exclude-thread ! "E" gnus-summary-limit-include-expunged ! "c" gnus-summary-limit-exclude-childless-dormant ! "C" gnus-summary-limit-mark-excluded-as-read) ! ! (gnus-define-keys ! (gnus-summary-goto-map "G" gnus-summary-mode-map) ! "n" gnus-summary-next-unread-article ! "p" gnus-summary-prev-unread-article ! "N" gnus-summary-next-article ! "P" gnus-summary-prev-article ! "\C-n" gnus-summary-next-same-subject ! "\C-p" gnus-summary-prev-same-subject ! "\M-n" gnus-summary-next-unread-subject ! "\M-p" gnus-summary-prev-unread-subject ! "f" gnus-summary-first-unread-article ! "b" gnus-summary-best-unread-article ! "g" gnus-summary-goto-subject ! "l" gnus-summary-goto-last-article ! "p" gnus-summary-pop-article) ! ! (gnus-define-keys ! (gnus-summary-thread-map "T" gnus-summary-mode-map) ! "k" gnus-summary-kill-thread ! "l" gnus-summary-lower-thread ! "i" gnus-summary-raise-thread ! "T" gnus-summary-toggle-threads ! "t" gnus-summary-rethread-current ! "s" gnus-summary-show-thread ! "S" gnus-summary-show-all-threads ! "h" gnus-summary-hide-thread ! "H" gnus-summary-hide-all-threads ! "n" gnus-summary-next-thread ! "p" gnus-summary-prev-thread ! "u" gnus-summary-up-thread ! "o" gnus-summary-top-thread ! "d" gnus-summary-down-thread ! "#" gnus-uu-mark-thread ! "\M-#" gnus-uu-unmark-thread) ! ! (gnus-define-keys ! (gnus-summary-exit-map "Z" gnus-summary-mode-map) ! "c" gnus-summary-catchup-and-exit ! "C" gnus-summary-catchup-all-and-exit ! "E" gnus-summary-exit-no-update ! "Q" gnus-summary-exit ! "Z" gnus-summary-exit ! "n" gnus-summary-catchup-and-goto-next-group ! "R" gnus-summary-reselect-current-group ! "G" gnus-summary-rescan-group ! "N" gnus-summary-next-group ! "P" gnus-summary-prev-group) ! ! (gnus-define-keys ! (gnus-summary-article-map "A" gnus-summary-mode-map) ! " " gnus-summary-next-page ! "n" gnus-summary-next-page ! "\177" gnus-summary-prev-page ! "p" gnus-summary-prev-page ! "\r" gnus-summary-scroll-up ! "<" gnus-summary-beginning-of-article ! ">" gnus-summary-end-of-article ! "b" gnus-summary-beginning-of-article ! "e" gnus-summary-end-of-article ! "^" gnus-summary-refer-parent-article ! "r" gnus-summary-refer-parent-article ! "R" gnus-summary-refer-references ! "g" gnus-summary-show-article ! "s" gnus-summary-isearch-article) ! ! (gnus-define-keys ! (gnus-summary-wash-map "W" gnus-summary-mode-map) ! "b" gnus-article-add-buttons ! "B" gnus-article-add-buttons-to-head ! "o" gnus-article-treat-overstrike ! ;; "w" gnus-article-word-wrap ! "w" gnus-article-fill-cited-article ! "c" gnus-article-remove-cr ! "L" gnus-article-remove-trailing-blank-lines ! "q" gnus-article-de-quoted-unreadable ! "f" gnus-article-display-x-face ! "l" gnus-summary-stop-page-breaking ! "r" gnus-summary-caesar-message ! "t" gnus-summary-toggle-header ! "m" gnus-summary-toggle-mime) ! ! (gnus-define-keys ! (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) ! "a" gnus-article-hide ! "h" gnus-article-hide-headers ! "b" gnus-article-hide-boring-headers ! "s" gnus-article-hide-signature ! "c" gnus-article-hide-citation ! "p" gnus-article-hide-pgp ! "\C-c" gnus-article-hide-citation-maybe) ! ! (gnus-define-keys ! (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) ! "a" gnus-article-highlight ! "h" gnus-article-highlight-headers ! "c" gnus-article-highlight-citation ! "s" gnus-article-highlight-signature) ! ! (gnus-define-keys ! (gnus-summary-wash-time-map "T" gnus-summary-wash-map) ! "z" gnus-article-date-ut ! "u" gnus-article-date-ut ! "l" gnus-article-date-local ! "e" gnus-article-date-lapsed ! "o" gnus-article-date-original) ! ! (gnus-define-keys ! (gnus-summary-help-map "H" gnus-summary-mode-map) ! "v" gnus-version ! "f" gnus-summary-fetch-faq ! "d" gnus-summary-describe-group ! "h" gnus-summary-describe-briefly ! "i" gnus-info-find-node) ! ! (gnus-define-keys ! (gnus-summary-backend-map "B" gnus-summary-mode-map) ! "e" gnus-summary-expire-articles ! "\M-\C-e" gnus-summary-expire-articles-now ! "\177" gnus-summary-delete-article ! "m" gnus-summary-move-article ! "r" gnus-summary-respool-article ! "w" gnus-summary-edit-article ! "c" gnus-summary-copy-article ! "B" gnus-summary-crosspost-article ! "q" gnus-summary-respool-query ! "i" gnus-summary-import-article) ! ! (gnus-define-keys ! (gnus-summary-save-map "O" gnus-summary-mode-map) ! "o" gnus-summary-save-article ! "m" gnus-summary-save-article-mail ! "r" gnus-summary-save-article-rmail ! "f" gnus-summary-save-article-file ! "b" gnus-summary-save-article-body-file ! "h" gnus-summary-save-article-folder ! "v" gnus-summary-save-article-vm ! "p" gnus-summary-pipe-output ! "s" gnus-soup-add-article) ) *************** *** 6858,6872 **** \\ Each line in this buffer represents one article. To read an article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards ! and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', respectively. ! You can also post articles and send mail from this buffer. To ! follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author of an article, type `\\[gnus-summary-reply]'. ! There are approx. one gazillion commands you can execute in this ! buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: --- 6696,6710 ---- \\ Each line in this buffer represents one article. To read an article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards ! and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', respectively. ! You can also post articles and send mail from this buffer. To ! follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author of an article, type `\\[gnus-summary-reply]'. ! There are approx. one gazillion commands you can execute in this ! buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: *************** *** 6901,6912 **** (run-hooks 'gnus-summary-mode-hook)) (defun gnus-summary-make-display-table () ! ;; Change the display table. Odd characters have a tendency to mess ;; up nicely formatted displays - we make all possible glyphs ;; display only a single character. ;; We start from the standard display table, if any. ! (setq gnus-summary-display-table (or (copy-sequence standard-display-table) (make-display-table))) ;; Nix out all the control chars... --- 6739,6750 ---- (run-hooks 'gnus-summary-mode-hook)) (defun gnus-summary-make-display-table () ! ;; Change the display table. Odd characters have a tendency to mess ;; up nicely formatted displays - we make all possible glyphs ;; display only a single character. ;; We start from the standard display table, if any. ! (setq gnus-summary-display-table (or (copy-sequence standard-display-table) (make-display-table))) ;; Nix out all the control chars... *************** *** 6914,6927 **** (while (>= (setq i (1- i)) 0) (aset gnus-summary-display-table i [??]))) ;; ... but not newline and cr, of course. (cr is necessary for the ! ;; selective display). (aset gnus-summary-display-table ?\n nil) (aset gnus-summary-display-table ?\r nil) ! ;; We nix out any glyphs over 126 that are not set already. (let ((i 256)) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. ! (or (aref gnus-summary-display-table i) (aset gnus-summary-display-table i [??]))))) (defun gnus-summary-clear-local-variables () --- 6752,6765 ---- (while (>= (setq i (1- i)) 0) (aset gnus-summary-display-table i [??]))) ;; ... but not newline and cr, of course. (cr is necessary for the ! ;; selective display). (aset gnus-summary-display-table ?\n nil) (aset gnus-summary-display-table ?\r nil) ! ;; We nix out any glyphs over 126 that are not set already. (let ((i 256)) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. ! (or (aref gnus-summary-display-table i) (aset gnus-summary-display-table i [??]))))) (defun gnus-summary-clear-local-variables () *************** *** 6988,6994 **** (ilist list)) (or data (not after-article) (error "No such article: %d" after-article)) ;; Find the last element in the list to be spliced into the main ! ;; list. (while (cdr list) (setq list (cdr list))) (if (not data) --- 6826,6832 ---- (ilist list)) (or data (not after-article) (error "No such article: %d" after-article)) ;; Find the last element in the list to be spliced into the main ! ;; list. (while (cdr list) (setq list (cdr list))) (if (not data) *************** *** 7033,7039 **** (let ((data gnus-newsgroup-data) pos) (while data ! (when (setq pos (text-property-any (point-min) (point-max) 'gnus-number (gnus-data-number (car data)))) (gnus-data-set-pos (car data) (+ pos 3))) --- 6871,6877 ---- (let ((data gnus-newsgroup-data) pos) (while data ! (when (setq pos (text-property-any (point-min) (point-max) 'gnus-number (gnus-data-number (car data)))) (gnus-data-set-pos (car data) (+ pos 3))) *************** *** 7049,7055 **** (and (cdr data) ; There has to be an article after... (< (gnus-data-level (car data)) ; And it has to have a higher level. (gnus-data-level (nth 1 data)))))) ! (defmacro gnus-summary-skip-intangible () "If the current article is intangible, then jump to a different article." '(let ((to (get-text-property (point) 'gnus-intangible))) --- 6887,6893 ---- (and (cdr data) ; There has to be an article after... (< (gnus-data-level (car data)) ; And it has to have a higher level. (gnus-data-level (nth 1 data)))))) ! (defmacro gnus-summary-skip-intangible () "If the current article is intangible, then jump to a different article." '(let ((to (get-text-property (point) 'gnus-intangible))) *************** *** 7068,7074 **** article number." '(progn (gnus-summary-skip-intangible) ! (or (get-text-property (point) 'gnus-number) (gnus-summary-last-subject)))) (defmacro gnus-summary-article-header (&optional number) --- 6906,6912 ---- article number." '(progn (gnus-summary-skip-intangible) ! (or (get-text-property (point) 'gnus-number) (gnus-summary-last-subject)))) (defmacro gnus-summary-article-header (&optional number) *************** *** 7076,7083 **** ,(or number '(gnus-summary-article-number))))) (defmacro gnus-summary-thread-level (&optional number) ! `(gnus-data-level (gnus-data-find ! ,(or number '(gnus-summary-article-number))))) (defmacro gnus-summary-article-mark (&optional number) `(gnus-data-mark (gnus-data-find --- 6914,6924 ---- ,(or number '(gnus-summary-article-number))))) (defmacro gnus-summary-thread-level (&optional number) ! `(if (and (eq gnus-summary-make-false-root 'dummy) ! (get-text-property (point) 'gnus-intangible)) ! 0 ! (gnus-data-level (gnus-data-find ! ,(or number '(gnus-summary-article-number)))))) (defmacro gnus-summary-article-mark (&optional number) `(gnus-data-mark (gnus-data-find *************** *** 7089,7095 **** (defmacro gnus-summary-article-subject (&optional number) "Return current subject string or nil if nothing." ! `(let ((headers ,(if number `(gnus-data-header (assq ,number gnus-newsgroup-data)) '(gnus-data-header (assq (gnus-summary-article-number) --- 6930,6936 ---- (defmacro gnus-summary-article-subject (&optional number) "Return current subject string or nil if nothing." ! `(let ((headers ,(if number `(gnus-data-header (assq ,number gnus-newsgroup-data)) '(gnus-data-header (assq (gnus-summary-article-number) *************** *** 7148,7157 **** (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) (gnus-add-current-to-buffer-list) (gnus-summary-mode group) ! (when gnus-carpal (gnus-carpal-setup-buffer 'summary)) (unless gnus-single-article-buffer ! (make-local-variable 'gnus-article-buffer)) (setq gnus-newsgroup-name group) t))) --- 6989,6999 ---- (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) (gnus-add-current-to-buffer-list) (gnus-summary-mode group) ! (when gnus-carpal (gnus-carpal-setup-buffer 'summary)) (unless gnus-single-article-buffer ! (make-local-variable 'gnus-article-buffer) ! (make-local-variable 'gnus-original-article-buffer)) (setq gnus-newsgroup-name group) t))) *************** *** 7159,7165 **** ;; Set the global equivalents of the summary buffer-local variables ;; to the latest values they had. These reflect the summary buffer ;; that was in action when the last article was fetched. ! (when (eq major-mode 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) --- 7001,7007 ---- ;; Set the global equivalents of the summary buffer-local variables ;; to the latest values they had. These reflect the summary buffer ;; that was in action when the last article was fetched. ! (when (eq major-mode 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) *************** *** 7183,7189 **** (if (not (setq article (or article (gnus-summary-article-number)))) t ; All non-existant numbers are the last article. :-) (cdr (gnus-data-find-list article)))) ! (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) "Insert a dummy root in the summary buffer." (beginning-of-line) --- 7025,7031 ---- (if (not (setq article (or article (gnus-summary-article-number)))) t ; All non-existant numbers are the last article. :-) (cdr (gnus-data-find-list article)))) ! (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) "Insert a dummy root in the summary buffer." (beginning-of-line) *************** *** 7205,7212 **** (make-string (* n gnus-thread-indent-level) ? )) (setq n (1- n)))))) ! (defun gnus-summary-insert-line ! (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) --- 7047,7054 ---- (make-string (* n gnus-thread-indent-level) ? )) (setq n (1- n)))))) ! (defun gnus-summary-insert-line ! (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) *************** *** 7226,7235 **** gnus-saved-mark) (t gnus-unread-mark))) (gnus-tmp-from (mail-header-from gnus-tmp-header)) ! (gnus-tmp-name ! (cond ((string-match "(.+)" gnus-tmp-from) ! (substring gnus-tmp-from (1+ (match-beginning 0)) (1- (match-end 0)))) ((string-match "<[^>]+> *$" gnus-tmp-from) (let ((beg (match-beginning 0))) --- 7068,7077 ---- gnus-saved-mark) (t gnus-unread-mark))) (gnus-tmp-from (mail-header-from gnus-tmp-header)) ! (gnus-tmp-name ! (cond ((string-match "(.+)" gnus-tmp-from) ! (substring gnus-tmp-from (1+ (match-beginning 0)) (1- (match-end 0)))) ((string-match "<[^>]+> *$" gnus-tmp-from) (let ((beg (match-beginning 0))) *************** *** 7272,7278 **** (when (eq (gnus-summary-article-mark) gnus-low-score-mark) ;; This article was previously marked as read on account ;; of a low score, but now it has risen, so we mark it as ! ;; unread. (gnus-summary-mark-article-as-unread gnus-unread-mark))) (gnus-summary-update-mark (if (or (null gnus-summary-default-score) --- 7114,7120 ---- (when (eq (gnus-summary-article-mark) gnus-low-score-mark) ;; This article was previously marked as read on account ;; of a low score, but now it has risen, so we mark it as ! ;; unread. (gnus-summary-mark-article-as-unread gnus-unread-mark))) (gnus-summary-update-mark (if (or (null gnus-summary-default-score) *************** *** 7284,7311 **** (when (gnus-visual-p 'summary-highlight 'highlight) (run-hooks 'gnus-summary-update-hook))))) ! (defvar gnus-tmp-new-adopts) (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) ;; Sum up all elements (and sub-elements) in a list. (let* ((number ;; Fix by Luc Van Eycken . ! (cond ((and (consp thread) (cdr thread)) ! (apply ! '+ 1 (mapcar ! 'gnus-summary-number-of-articles-in-thread ! (cdr thread)))) ! ((null thread) ! 1) ! ((and level (zerop level) gnus-tmp-new-adopts) ! (apply '+ 1 (mapcar ! 'gnus-summary-number-of-articles-in-thread ! gnus-tmp-new-adopts))) ! ((memq (mail-header-number (car thread)) ! gnus-newsgroup-limit) ! 1) ! (t 1)))) ! (if char (if (> number 1) gnus-not-empty-thread-mark gnus-empty-thread-mark) number))) --- 7126,7153 ---- (when (gnus-visual-p 'summary-highlight 'highlight) (run-hooks 'gnus-summary-update-hook))))) ! (defvar gnus-tmp-new-adopts nil) (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) ;; Sum up all elements (and sub-elements) in a list. (let* ((number ;; Fix by Luc Van Eycken . ! (cond ! ((and (consp thread) (cdr thread)) ! (apply ! '+ 1 (mapcar ! 'gnus-summary-number-of-articles-in-thread (cdr thread)))) ! ((null thread) ! 1) ! ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) ! 1) ! (t 1)))) ! (when (and level (zerop level) gnus-tmp-new-adopts) ! (incf number ! (apply '+ (mapcar ! 'gnus-summary-number-of-articles-in-thread ! gnus-tmp-new-adopts)))) ! (if char (if (> number 1) gnus-not-empty-thread-mark gnus-empty-thread-mark) number))) *************** *** 7324,7330 **** (make-local-variable (car elem)) (set (car elem) (eval (nth 1 elem)))))))) ! (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer no-display) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. --- 7166,7172 ---- (make-local-variable (car elem)) (set (car elem) (eval (nth 1 elem)))))))) ! (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer no-display) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. *************** *** 7334,7351 **** (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) (did-select (and new-group (gnus-select-newsgroup group show-all)))) ! (cond ! ;; This summary buffer exists already, so we just select it. ((not new-group) (gnus-set-global-variables) ! (gnus-kill-or-deaden-summary kill-buffer) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary) (gnus-summary-position-point) (message "") t) ;; We couldn't select this group. ! ((null did-select) (when (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer))) (kill-buffer (current-buffer)) --- 7176,7194 ---- (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) (did-select (and new-group (gnus-select-newsgroup group show-all)))) ! (cond ! ;; This summary buffer exists already, so we just select it. ((not new-group) (gnus-set-global-variables) ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary) (gnus-summary-position-point) (message "") t) ;; We couldn't select this group. ! ((null did-select) (when (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer))) (kill-buffer (current-buffer)) *************** *** 7368,7374 **** (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) ! (gnus-kill-or-deaden-summary kill-buffer) (if (not quit-config) (progn (set-buffer gnus-group-buffer) --- 7211,7218 ---- (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) (if (not quit-config) (progn (set-buffer gnus-group-buffer) *************** *** 7381,7393 **** (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) ! ;; Finallt signal the quit. (signal 'quit nil)) ;; The group was successfully selected. (t (gnus-set-global-variables) ;; Save the active value in effect when the group was entered. ! (setq gnus-newsgroup-active (gnus-copy-sequence (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this hook. --- 7225,7237 ---- (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) ! ;; Finally signal the quit. (signal 'quit nil)) ;; The group was successfully selected. (t (gnus-set-global-variables) ;; Save the active value in effect when the group was entered. ! (setq gnus-newsgroup-active (gnus-copy-sequence (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this hook. *************** *** 7398,7411 **** (when gnus-use-scoring (gnus-possibly-score-headers)) (gnus-update-format-specifications) ;; Find the initial limit. ! (gnus-summary-initial-limit) ;; Generate the summary buffer. (unless no-display (gnus-summary-prepare)) ;; If the summary buffer is empty, but there are some low-scored ;; articles or some excluded dormants, we include these in the ! ;; buffer. (when (zerop (buffer-size)) (cond (gnus-newsgroup-dormant (gnus-summary-limit-include-dormant)) --- 7242,7262 ---- (when gnus-use-scoring (gnus-possibly-score-headers)) (gnus-update-format-specifications) + ;; Check whether to fill in the gaps in the threads. + (when gnus-build-sparse-threads + (gnus-build-sparse-threads)) ;; Find the initial limit. ! (gnus-summary-initial-limit show-all) ;; Generate the summary buffer. (unless no-display (gnus-summary-prepare)) + (when gnus-use-trees + (gnus-tree-open group) + (setq gnus-summary-highlight-line-function + 'gnus-tree-highlight-article)) ;; If the summary buffer is empty, but there are some low-scored ;; articles or some excluded dormants, we include these in the ! ;; buffer. (when (zerop (buffer-size)) (cond (gnus-newsgroup-dormant (gnus-summary-limit-include-dormant)) *************** *** 7418,7424 **** ;; This newsgroup is empty. (gnus-summary-catchup-and-exit nil t) ;Without confirmations. (gnus-message 6 "No unread news") ! (gnus-kill-or-deaden-summary kill-buffer) ;; Return nil from this function. nil) ;; Hide conversation thread subtrees. We cannot do this in --- 7269,7276 ---- ;; This newsgroup is empty. (gnus-summary-catchup-and-exit nil t) ;Without confirmations. (gnus-message 6 "No unread news") ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) ;; Return nil from this function. nil) ;; Hide conversation thread subtrees. We cannot do this in *************** *** 7431,7440 **** (if (and (not no-article) gnus-newsgroup-unreads gnus-auto-select-first) ! (progn ! (if (eq gnus-auto-select-first 'best) ! (gnus-summary-best-unread-article) ! (gnus-summary-first-unread-article))) ;; Don't select any articles, just move point to the first ;; article in the group. (goto-char (point-min)) --- 7283,7291 ---- (if (and (not no-article) gnus-newsgroup-unreads gnus-auto-select-first) ! (if (eq gnus-auto-select-first 'best) ! (gnus-summary-best-unread-article) ! (gnus-summary-first-unread-article)) ;; Don't select any articles, just move point to the first ;; article in the group. (goto-char (point-min)) *************** *** 7444,7458 **** ;; If we are in async mode, we send some info to the backend. (when gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data)) ! (gnus-kill-or-deaden-summary kill-buffer) (when (get-buffer-window gnus-group-buffer) ;; Gotta use windows, because recenter does wierd stuff if ;; the current buffer ain't the displayed window. ! (let ((owin (selected-window))) ! (select-window (get-buffer-window gnus-group-buffer)) ! (when (gnus-group-goto-group group) (recenter)) ! (select-window owin)))) ;; Mark this buffer as "prepared". (setq gnus-newsgroup-prepared t) t)))) --- 7295,7310 ---- ;; If we are in async mode, we send some info to the backend. (when gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data)) ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) (when (get-buffer-window gnus-group-buffer) ;; Gotta use windows, because recenter does wierd stuff if ;; the current buffer ain't the displayed window. ! (let ((owin (selected-window))) ! (select-window (get-buffer-window gnus-group-buffer)) ! (when (gnus-group-goto-group group) (recenter)) ! (select-window owin)))) ;; Mark this buffer as "prepared". (setq gnus-newsgroup-prepared t) t)))) *************** *** 7465,7528 **** gnus-newsgroup-data-reverse nil) (run-hooks 'gnus-summary-generate-hook) ;; Generate the buffer, either with threads or without. ! (gnus-summary-prepare-threads ! (if gnus-show-threads ! (gnus-gather-threads (gnus-sort-threads (gnus-make-threads))) ! gnus-newsgroup-headers)) (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) ;; Call hooks for modifying summary buffer. (goto-char (point-min)) (run-hooks 'gnus-summary-prepare-hook))) ! (defun gnus-gather-threads (threads) ! "Gather threads that have lost their roots." (if (not gnus-summary-make-false-root) ! threads (let ((hashtb (gnus-make-hashtable 1023)) (prev threads) (result threads) subject hthread whole-subject) (while threads ! (setq whole-subject ! (setq subject (mail-header-subject (car (car threads))))) (if (and gnus-summary-gather-exclude-subject (string-match gnus-summary-gather-exclude-subject ! subject)) ! () ; We don't want to do anything with this. ! (if gnus-summary-gather-subject-limit ! (or (and (numberp gnus-summary-gather-subject-limit) ! (> (length subject) gnus-summary-gather-subject-limit) ! (setq subject ! (substring subject 0 ! gnus-summary-gather-subject-limit))) ! (and (eq 'fuzzy gnus-summary-gather-subject-limit) ! (setq subject (gnus-simplify-subject-fuzzy subject)))) ! (setq subject (gnus-simplify-subject-re subject))) ! (if (setq hthread ! (gnus-gethash subject hashtb)) (progn ! (or (stringp (car (car hthread))) ! (setcar hthread (list whole-subject (car hthread)))) ! (setcdr (car hthread) (nconc (cdr (car hthread)) ! (list (car threads)))) (setcdr prev (cdr threads)) (setq threads prev)) (gnus-sethash subject threads hashtb))) (setq prev threads) (setq threads (cdr threads))) result))) (defun gnus-make-threads () ! "Go through the dependency hashtb and find the roots. Return all threads." ! ;; Then we find all the roots and return all the threads. (let (threads) (mapatoms (lambda (refs) ! (or (car (symbol-value refs)) ! (setq threads (append (cdr (symbol-value refs)) threads)))) gnus-newsgroup-dependencies) threads)) ! (defun gnus-build-old-threads () ;; Look at all the articles that refer back to old articles, and ;; fetch the headers for the articles that aren't there. This will --- 7317,7505 ---- gnus-newsgroup-data-reverse nil) (run-hooks 'gnus-summary-generate-hook) ;; Generate the buffer, either with threads or without. ! (when gnus-newsgroup-headers ! (gnus-summary-prepare-threads ! (if gnus-show-threads ! (gnus-sort-gathered-threads ! (funcall gnus-summary-thread-gathering-function ! (gnus-sort-threads ! (gnus-cut-threads (gnus-make-threads))))) ! ;; Unthreaded display. ! (gnus-sort-articles gnus-newsgroup-headers)))) (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) ;; Call hooks for modifying summary buffer. (goto-char (point-min)) (run-hooks 'gnus-summary-prepare-hook))) ! (defun gnus-gather-threads-by-subject (threads) ! "Gather threads by looking at Subject headers." (if (not gnus-summary-make-false-root) ! threads (let ((hashtb (gnus-make-hashtable 1023)) (prev threads) (result threads) subject hthread whole-subject) (while threads ! (setq whole-subject (mail-header-subject (car (car threads)))) (if (and gnus-summary-gather-exclude-subject (string-match gnus-summary-gather-exclude-subject ! whole-subject)) ! () ; We don't want to do anything with this article. ! ;; We simplify the subject before looking it up in the ! ;; hash table. ! (setq subject ! (cond ! ;; Truncate the subject. ! ((numberp gnus-summary-gather-subject-limit) ! (setq subject (gnus-simplify-subject-re whole-subject)) ! (if (> (length subject) gnus-summary-gather-subject-limit) ! (substring subject 0 gnus-summary-gather-subject-limit) ! subject)) ! ;; Fuzzily simplify it. ! ((eq 'fuzzy gnus-summary-gather-subject-limit) ! (gnus-simplify-subject-fuzzy whole-subject)) ! ;; Just remove the leading "Re:". ! (t ! (gnus-simplify-subject-re whole-subject)))) ! ! (if (setq hthread (gnus-gethash subject hashtb)) (progn ! ;; We enter a dummy root into the thread, if we ! ;; haven't done that already. ! (unless (stringp (car (car hthread))) ! (setcar hthread (list whole-subject (car hthread)))) ! ;; We add this new gathered thread to this gathered ! ;; thread. ! (setcdr (car hthread) ! (nconc (cdr (car hthread)) (list (car threads)))) ! ;; Remove it from the list of threads. (setcdr prev (cdr threads)) (setq threads prev)) + ;; Enter this thread into the hash table. (gnus-sethash subject threads hashtb))) (setq prev threads) (setq threads (cdr threads))) result))) + (defun gnus-summary-gather-threads-by-references (threads) + "Gather threads by looking at References headers." + (let ((idhashtb (gnus-make-hashtable 1023)) + (thhashtb (gnus-make-hashtable 1023)) + (prev threads) + (result threads) + ids references id gthread gid entered) + (while threads + (when (setq references (mail-header-references (caar threads))) + (setq id (mail-header-id (caar threads))) + (setq ids (gnus-split-references references)) + (setq entered nil) + (while ids + (if (not (setq gid (gnus-gethash (car ids) idhashtb))) + (progn + (gnus-sethash (car ids) id idhashtb) + (gnus-sethash id threads thhashtb)) + (setq gthread (gnus-gethash gid thhashtb)) + (unless entered + ;; We enter a dummy root into the thread, if we + ;; haven't done that already. + (unless (stringp (caar gthread)) + (setcar gthread (list (mail-header-subject (caar gthread)) + (car gthread)))) + ;; We add this new gathered thread to this gathered + ;; thread. + (setcdr (car gthread) + (nconc (cdar gthread) (list (car threads))))) + ;; Add it into the thread hash table. + (gnus-sethash id gthread thhashtb) + (setq entered t) + ;; Remove it from the list of threads. + (setcdr prev (cdr threads)) + (setq threads prev)) + (setq ids (cdr ids)))) + (setq prev threads) + (setq threads (cdr threads))) + result)) + + (defun gnus-sort-gathered-threads (threads) + "Sort subtreads inside each gathered thread by article number." + (let ((result threads)) + (while threads + (when (stringp (car (car threads))) + (setcdr (car threads) + (sort (cdr (car threads)) 'gnus-thread-sort-by-number))) + (setq threads (cdr threads))) + result)) + (defun gnus-make-threads () ! "Go through the dependency hashtb and find the roots. Return all threads." (let (threads) (mapatoms (lambda (refs) ! (unless (car (symbol-value refs)) ! ;; These threads do not refer back to any other articles, ! ;; so they're roots. ! (setq threads (append (cdr (symbol-value refs)) threads)))) gnus-newsgroup-dependencies) threads)) ! ! (defun gnus-build-sparse-threads () ! (let ((headers gnus-newsgroup-headers) ! (deps gnus-newsgroup-dependencies) ! header references generation relations ! cthread subject child end pthread relation) ! ;; First we create an alist of generations/relations, where ! ;; generations is how much we trust the ralation, and the relation ! ;; is parent/child. ! (gnus-message 7 "Making sparse threads...") ! (save-excursion ! (nnheader-set-temp-buffer " *gnus sparse threads*") ! (while (setq header (pop headers)) ! (when (and (setq references (mail-header-references header)) ! (not (string= references ""))) ! (insert references) ! (setq child (downcase (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))) ! subject) ! relations))) ! (push (list (1+ generation) child nil subject) relations) ! (erase-buffer))) ! (kill-buffer (current-buffer))) ! ;; Sort over trustworthiness. ! (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2))))) ! (while (setq relation (pop relations)) ! (when (if (boundp (setq cthread (intern (cadr relation) deps))) ! (unless (car (symbol-value cthread)) ! ;; Make this article the parent of these threads. ! (setcar (symbol-value cthread) ! (vector gnus-reffed-article-number ! (cadddr relation) ! "" "" ! (cadr relation) ! (or (caddr relation) "") 0 0 ""))) ! (set cthread (list (vector gnus-reffed-article-number ! (cadddr relation) ! "" "" (cadr relation) ! (or (caddr relation) "") 0 0 "")))) ! (push gnus-reffed-article-number gnus-newsgroup-limit) ! (push gnus-reffed-article-number gnus-newsgroup-sparse) ! (push (cons gnus-reffed-article-number gnus-sparse-mark) ! gnus-newsgroup-reads) ! (decf gnus-reffed-article-number) ! ;; Make this new thread the child of its parent. ! (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) ! (setcdr (symbol-value pthread) ! (nconc (cdr (symbol-value pthread)) ! (list (symbol-value cthread)))) ! (set pthread (list nil (symbol-value cthread)))))) ! (gnus-message 7 "Making sparse threads...done"))) ! (defun gnus-build-old-threads () ;; Look at all the articles that refer back to old articles, and ;; fetch the headers for the articles that aren't there. This will *************** *** 7539,7545 **** (setq heads (cdr heads)) (setq id (symbol-name refs)) (while (and (setq id (gnus-build-get-header id)) ! (not (car (gnus-gethash id gnus-newsgroup-dependencies))))) (setq heads nil))))) gnus-newsgroup-dependencies))) --- 7516,7522 ---- (setq heads (cdr heads)) (setq id (symbol-name refs)) (while (and (setq id (gnus-build-get-header id)) ! (not (car (gnus-gethash id gnus-newsgroup-dependencies))))) (setq heads nil))))) gnus-newsgroup-dependencies))) *************** *** 7556,7562 **** (goto-char (point-min)) (while (and (not found) (search-forward id nil t)) (beginning-of-line) ! (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" (regexp-quote id)))) (or found (beginning-of-line 2))) --- 7533,7539 ---- (goto-char (point-min)) (while (and (not found) (search-forward id nil t)) (beginning-of-line) ! (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" (regexp-quote id)))) (or found (beginning-of-line 2))) *************** *** 7564,7577 **** (let (ref) (beginning-of-line) (and ! (setq header (gnus-nov-parse-line (read (current-buffer)) deps)) (gnus-parent-id (mail-header-references header)))))) (when header (let ((number (mail-header-number header))) (push number gnus-newsgroup-limit) (push header gnus-newsgroup-headers) ! (push number gnus-newsgroup-ancient)))))) (defun gnus-rebuild-thread (id) "Rebuild the thread containing ID." --- 7541,7565 ---- (let (ref) (beginning-of-line) (and ! (setq header (gnus-nov-parse-line (read (current-buffer)) deps)) (gnus-parent-id (mail-header-references header)))))) (when header (let ((number (mail-header-number header))) (push number gnus-newsgroup-limit) (push header gnus-newsgroup-headers) ! (if (memq number gnus-newsgroup-unselected) ! (progn ! (push number gnus-newsgroup-unreads) ! (setq gnus-newsgroup-unselected ! (delq number gnus-newsgroup-unselected))) ! (push number gnus-newsgroup-ancient))))))) ! ! (defun gnus-summary-update-article (article) ! "Update ARTICLE in the summary buffer." ! (let ((id (mail-header-id (gnus-summary-article-header article)))) ! (setcar (car (gnus-id-to-thread id)) nil) ! (gnus-summary-insert-subject id))) (defun gnus-rebuild-thread (id) "Rebuild the thread containing ID." *************** *** 7579,7585 **** (buffer-read-only nil) current headers refs thread art data) (if (not gnus-show-threads) ! (setq thread (list (car (gnus-gethash (downcase id) dep)))) ;; Get the thread this article is part of. (setq thread (gnus-remove-thread id))) (setq current (save-excursion --- 7567,7573 ---- (buffer-read-only nil) current headers refs thread art data) (if (not gnus-show-threads) ! (setq thread (list (car (gnus-id-to-thread id)))) ;; Get the thread this article is part of. (setq thread (gnus-remove-thread id))) (setq current (save-excursion *************** *** 7591,7597 **** roots thr) (setq thread (cdr thread)) (while thread ! (unless (memq (setq thr (gnus-id-to-thread (gnus-root-id (mail-header-id (car (car thread)))))) roots) --- 7579,7585 ---- roots thr) (setq thread (cdr thread)) (while thread ! (unless (memq (setq thr (gnus-id-to-thread (gnus-root-id (mail-header-id (car (car thread)))))) roots) *************** *** 7602,7608 **** ;; All the loose roots are now one solid root. (setq thread (car roots)) (setq thread (cons subject (gnus-sort-threads roots)))))) ! (let ((beg (point)) threads) ;; We then insert this thread into the summary buffer. (let (gnus-newsgroup-data gnus-newsgroup-threads) --- 7590,7596 ---- ;; All the loose roots are now one solid root. (setq thread (car roots)) (setq thread (cons subject (gnus-sort-threads roots)))))) ! (let ((beg (point)) threads) ;; We then insert this thread into the summary buffer. (let (gnus-newsgroup-data gnus-newsgroup-threads) *************** *** 7618,7634 **** "Return the (sub-)thread where ID appears." (gnus-gethash (downcase id) gnus-newsgroup-dependencies)) (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)))) (setq last-id id id (gnus-parent-id (mail-header-references prev)))) last-id)) ! (defun gnus-remove-thread (id) "Remove the thread that has ID in it." (let ((dep gnus-newsgroup-dependencies) headers thread prev last-id) --- 7606,7646 ---- "Return the (sub-)thread where ID appears." (gnus-gethash (downcase id) gnus-newsgroup-dependencies)) + (defun gnus-id-to-article (id) + "Return the article number of ID." + (let ((thread (gnus-id-to-thread id))) + (when thread + (mail-header-number (car thread))))) + + (defun gnus-id-to-header (id) + "Return the article headers of ID." + (car (gnus-id-to-thread id))) + + (defun gnus-article-displayed-root-p (article) + "Say whether ARTICLE is a root(ish) article." + (let ((level (gnus-summary-thread-level article)) + particle) + (cond + ((null level) nil) + ((zerop level) t) + ((and (= 1 level) + (null (setq particle (gnus-id-to-article + (gnus-parent-id + (mail-header-references + (gnus-summary-article-header article)))))) + (null (gnus-summary-thread-level particle))))))) + (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)))) (setq last-id id id (gnus-parent-id (mail-header-references prev)))) last-id)) ! (defun gnus-remove-thread (id &optional dont-remove) "Remove the thread that has ID in it." (let ((dep gnus-newsgroup-dependencies) headers thread prev last-id) *************** *** 7636,7642 **** (setq last-id (gnus-root-id id)) (setq headers (list (car (gnus-id-to-thread last-id)) (car (car (cdr (gnus-id-to-thread last-id)))))) ! ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. (let ((threads gnus-newsgroup-threads) --- 7648,7654 ---- (setq last-id (gnus-root-id id)) (setq headers (list (car (gnus-id-to-thread last-id)) (car (car (cdr (gnus-id-to-thread last-id)))))) ! ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. (let ((threads gnus-newsgroup-threads) *************** *** 7660,7690 **** (setq thread sub threads nil))) (setq threads (cdr threads))) ! ;; If this article is in no thread, then it's a root. ! (if thread ! (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)) (setq thread (gnus-gethash (downcase last-id) dep))) (when thread ! (prog1 thread ; We return this thread. ! (if (stringp (car thread)) ! (progn ! ;; If we use dummy roots, then we have to remove the ! ;; dummy root as well. ! (when (eq gnus-summary-make-false-root 'dummy) ! ;; Uhm. ! ) ! (setq thread (cdr thread)) ! (while thread ! (gnus-remove-thread-1 (car thread)) ! (setq thread (cdr thread)))) ! (gnus-remove-thread-1 thread))))))) (defun gnus-remove-thread-1 (thread) "Remove the thread THREAD recursively." (let ((number (mail-header-number (car thread))) pos) ! (when (setq pos (text-property-any (point-min) (point-max) 'gnus-number number)) (goto-char pos) (gnus-delete-line) --- 7672,7704 ---- (setq thread sub threads nil))) (setq threads (cdr threads))) ! ;; If this article is in no thread, then it's a root. ! (if thread ! (unless dont-remove ! (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) (setq thread (gnus-gethash (downcase last-id) dep))) (when thread ! (prog1 thread ; We return this thread. ! (unless dont-remove ! (if (stringp (car thread)) ! (progn ! ;; If we use dummy roots, then we have to remove the ! ;; dummy root as well. ! (when (eq gnus-summary-make-false-root 'dummy) ! ;; Uhm. ! ) ! (setq thread (cdr thread)) ! (while thread ! (gnus-remove-thread-1 (car thread)) ! (setq thread (cdr thread)))) ! (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) "Remove the thread THREAD recursively." (let ((number (mail-header-number (car thread))) pos) ! (when (setq pos (text-property-any (point-min) (point-max) 'gnus-number number)) (goto-char pos) (gnus-delete-line) *************** *** 7695,7709 **** (setq thread (cdr thread))))) (defun gnus-sort-threads (threads) ! "Sort THREADS as specified in `gnus-thread-sort-functions'." ! (let ((funs gnus-thread-sort-functions)) ! (when funs ! (while funs ! (gnus-message 7 "Sorting with %S..." (car funs)) ! (setq threads (sort threads (pop funs)))) ! (gnus-message 7 "Sorting...done"))) ! threads) ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) ;; Return header of first article in THREAD. --- 7709,7747 ---- (setq thread (cdr thread))))) (defun gnus-sort-threads (threads) ! "Sort THREADS." ! (when gnus-thread-sort-functions ! (let ((func (if (= 1 (length gnus-thread-sort-functions)) ! (car gnus-thread-sort-functions) ! `(lambda (t1 t2) ! ,(gnus-make-sort-function ! (reverse gnus-thread-sort-functions)))))) ! (gnus-message 7 "Sorting threads...") ! (prog1 ! (sort threads func) ! (gnus-message 7 "Sorting threads...done"))))) + (defun gnus-sort-articles (articles) + "Sort ARTICLES." + (when gnus-article-sort-functions + (let ((func (if (= 1 (length gnus-article-sort-functions)) + (car gnus-article-sort-functions) + `(lambda (t1 t2) + ,(gnus-make-sort-function + (reverse gnus-article-sort-functions)))))) + (gnus-message 7 "Sorting articles...") + (prog1 + (sort articles func) + (gnus-message 7 "Sorting articles...done"))))) + + (defun gnus-make-sort-function (funs) + "Return a composite sort condition based on the functions in FUNC." + (if (cdr funs) + `(or (,(car funs) t1 t2) + (and (not (,(car funs) t2 t1)) + ,(gnus-make-sort-function (cdr funs)))) + `(,(car funs) t1 t2))) + ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) ;; Return header of first article in THREAD. *************** *** 7711,7717 **** ;; using some other form will lead to serious barfage. (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) ! (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) --- 7749,7755 ---- ;; using some other form will lead to serious barfage. (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) ! (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) *************** *** 7721,7738 **** (defun gnus-thread-sort-by-number (h1 h2) "Sort threads by root article number." ! (gnus-article-sort-by-number (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp ! (let ((extract (funcall gnus-extract-address-components (mail-header-from h1)))) (or (car extract) (cdr extract))) (let ((extract (funcall ! gnus-extract-address-components (mail-header-from h2)))) (or (car extract) (cdr extract))))) --- 7759,7776 ---- (defun gnus-thread-sort-by-number (h1 h2) "Sort threads by root article number." ! (gnus-article-sort-by-number (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp ! (let ((extract (funcall gnus-extract-address-components (mail-header-from h1)))) (or (car extract) (cdr extract))) (let ((extract (funcall ! gnus-extract-address-components (mail-header-from h2)))) (or (car extract) (cdr extract))))) *************** *** 7749,7755 **** (defun gnus-thread-sort-by-subject (h1 h2) "Sort threads by root subject." ! (gnus-article-sort-by-subject (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-date (h1 h2) --- 7787,7793 ---- (defun gnus-thread-sort-by-subject (h1 h2) "Sort threads by root subject." ! (gnus-article-sort-by-subject (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-date (h1 h2) *************** *** 7760,7766 **** (defun gnus-thread-sort-by-date (h1 h2) "Sort threads by root article date." ! (gnus-article-sort-by-date (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-score (h1 h2) --- 7798,7804 ---- (defun gnus-thread-sort-by-date (h1 h2) "Sort threads by root article date." ! (gnus-article-sort-by-date (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-score (h1 h2) *************** *** 7775,7781 **** (defun gnus-thread-sort-by-score (h1 h2) "Sort threads by root article score." ! (gnus-article-sort-by-score (gnus-thread-header h1) (gnus-thread-header h2))) (defun gnus-thread-sort-by-total-score (h1 h2) --- 7813,7819 ---- (defun gnus-thread-sort-by-score (h1 h2) "Sort threads by root article score." ! (gnus-article-sort-by-score (gnus-thread-header h1) (gnus-thread-header h2))) (defun gnus-thread-sort-by-total-score (h1 h2) *************** *** 7809,7816 **** (defvar gnus-tmp-dummy-line nil) (defun gnus-summary-prepare-threads (threads) ! "Prepare summary buffer from THREADS and indentation LEVEL. ! THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' or a straight list of headers." (gnus-message 7 "Generating summary...") --- 7847,7854 ---- (defvar gnus-tmp-dummy-line nil) (defun gnus-summary-prepare-threads (threads) ! "Prepare summary buffer from THREADS and indentation LEVEL. ! THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' or a straight list of headers." (gnus-message 7 "Generating summary...") *************** *** 7862,7868 **** (setq thread threads gnus-tmp-header (car (car thread))) ;; There were no current threads, so we pop something off ! ;; the stack. (setq state (car stack) gnus-tmp-level (car state) thread (cdr state) --- 7900,7906 ---- (setq thread threads gnus-tmp-header (car (car thread))) ;; There were no current threads, so we pop something off ! ;; the stack. (setq state (car stack) gnus-tmp-level (car state) thread (cdr state) *************** *** 7875,7886 **** (if (stringp gnus-tmp-header) ;; The header is a dummy root. ! (cond ((eq gnus-summary-make-false-root 'adopt) ;; We let the first article adopt the rest. (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts (cdr (cdr (car thread))))) ! (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (cdr (car thread)))) --- 7913,7924 ---- (if (stringp gnus-tmp-header) ;; The header is a dummy root. ! (cond ((eq gnus-summary-make-false-root 'adopt) ;; We let the first article adopt the rest. (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts (cdr (cdr (car thread))))) ! (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (cdr (car thread)))) *************** *** 7892,7898 **** gnus-tmp-false-parent t)) ((eq gnus-summary-make-false-root 'empty) ;; We print adopted articles with empty subject fields. ! (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (cdr (car thread)))) --- 7930,7936 ---- gnus-tmp-false-parent t)) ((eq gnus-summary-make-false-root 'empty) ;; We print adopted articles with empty subject fields. ! (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (cdr (car thread)))) *************** *** 7900,7918 **** (setq gnus-tmp-level -1)) ((eq gnus-summary-make-false-root 'dummy) ;; We remember that we probably want to output a dummy ! ;; root. (setq gnus-tmp-dummy-line gnus-tmp-header) (setq gnus-tmp-prev-subject gnus-tmp-header)) (t ;; We do not make a root for the gathered ! ;; sub-threads at all. (setq gnus-tmp-level -1))) ! (setq number (mail-header-number gnus-tmp-header) subject (mail-header-subject gnus-tmp-header)) ! (cond ! ;; If the thread has changed subject, we might want to make ;; this subthread into a root. ((and (null gnus-thread-ignore-subject) (not (zerop gnus-tmp-level)) --- 7938,7956 ---- (setq gnus-tmp-level -1)) ((eq gnus-summary-make-false-root 'dummy) ;; We remember that we probably want to output a dummy ! ;; root. (setq gnus-tmp-dummy-line gnus-tmp-header) (setq gnus-tmp-prev-subject gnus-tmp-header)) (t ;; We do not make a root for the gathered ! ;; sub-threads at all. (setq gnus-tmp-level -1))) ! (setq number (mail-header-number gnus-tmp-header) subject (mail-header-subject gnus-tmp-header)) ! (cond ! ;; If the thread has changed subject, we might want to make ;; this subthread into a root. ((and (null gnus-thread-ignore-subject) (not (zerop gnus-tmp-level)) *************** *** 7925,7937 **** ;; If the article lies outside the current limit, ;; then we do not display it. ((not (memq number gnus-newsgroup-limit)) ! (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (car thread))) gnus-tmp-gathered)) (setq gnus-tmp-new-adopts (if (cdr (car thread)) ! (append gnus-tmp-new-adopts (cdr (car thread))) gnus-tmp-new-adopts) thread-end t --- 7963,7975 ---- ;; If the article lies outside the current limit, ;; then we do not display it. ((not (memq number gnus-newsgroup-limit)) ! (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (car thread))) gnus-tmp-gathered)) (setq gnus-tmp-new-adopts (if (cdr (car thread)) ! (append gnus-tmp-new-adopts (cdr (car thread))) gnus-tmp-new-adopts) thread-end t *************** *** 7943,7967 **** (< (or (cdr (assq number gnus-newsgroup-scored)) default-score) gnus-summary-mark-below)) ! (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire (push number gnus-newsgroup-expirable) (push (cons number gnus-low-score-mark) gnus-newsgroup-reads)))) ! (when gnus-tmp-header ;; We may have an old dummy line to output before this ! ;; article. (when gnus-tmp-dummy-line ! (gnus-summary-insert-dummy-line gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) (setq gnus-tmp-dummy-line nil)) ;; Compute the mark. ! (setq gnus-tmp-unread ! (cond ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) --- 7981,8005 ---- (< (or (cdr (assq number gnus-newsgroup-scored)) default-score) gnus-summary-mark-below)) ! (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire (push number gnus-newsgroup-expirable) (push (cons number gnus-low-score-mark) gnus-newsgroup-reads)))) ! (when gnus-tmp-header ;; We may have an old dummy line to output before this ! ;; article. (when gnus-tmp-dummy-line ! (gnus-summary-insert-dummy-line gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) (setq gnus-tmp-dummy-line nil)) ;; Compute the mark. ! (setq gnus-tmp-unread ! (cond ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) *************** *** 7974,7985 **** gnus-newsgroup-data) ;; Actually insert the line. ! (setq gnus-tmp-subject-or-nil (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-subject ! (not (inline (gnus-subject-equal gnus-tmp-prev-subject subject)))) subject) ((zerop gnus-tmp-level) --- 8012,8023 ---- gnus-newsgroup-data) ;; Actually insert the line. ! (setq gnus-tmp-subject-or-nil (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-subject ! (not (inline (gnus-subject-equal gnus-tmp-prev-subject subject)))) subject) ((zerop gnus-tmp-level) *************** *** 7998,8005 **** gnus-tmp-closing-bracket ?\>) (setq gnus-tmp-opening-bracket ?\[ gnus-tmp-closing-bracket ?\])) ! (setq ! gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level) gnus-tmp-lines (mail-header-lines gnus-tmp-header) gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) --- 8036,8043 ---- gnus-tmp-closing-bracket ?\>) (setq gnus-tmp-opening-bracket ?\[ gnus-tmp-closing-bracket ?\])) ! (setq ! gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level) gnus-tmp-lines (mail-header-lines gnus-tmp-header) gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) *************** *** 8019,8028 **** gnus-replied-mark) (t gnus-unread-mark)) gnus-tmp-from (mail-header-from gnus-tmp-header) ! gnus-tmp-name ! (cond ((string-match "(.+)" gnus-tmp-from) ! (substring gnus-tmp-from (1+ (match-beginning 0)) (1- (match-end 0)))) ((string-match "<[^>]+> *$" gnus-tmp-from) (setq beg-match (match-beginning 0)) --- 8057,8066 ---- gnus-replied-mark) (t gnus-unread-mark)) gnus-tmp-from (mail-header-from gnus-tmp-header) ! gnus-tmp-name ! (cond ((string-match "(.+)" gnus-tmp-from) ! (substring gnus-tmp-from (1+ (match-beginning 0)) (1- (match-end 0)))) ((string-match "<[^>]+> *$" gnus-tmp-from) (setq beg-match (match-beginning 0)) *************** *** 8045,8051 **** (setq gnus-tmp-prev-subject subject))) ! (when (nth 1 thread) (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) (incf gnus-tmp-level) (setq threads (if thread-end nil (cdr (car thread)))) --- 8083,8089 ---- (setq gnus-tmp-prev-subject subject))) ! (when (nth 1 thread) (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) (incf gnus-tmp-level) (setq threads (if thread-end nil (cdr (car thread)))) *************** *** 8068,8089 **** (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-mark-below)) ! (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire (push number gnus-newsgroup-expirable) (push (cons number gnus-low-score-mark) gnus-newsgroup-reads))) ! (setq mark ! (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq number gnus-newsgroup-reads)) gnus-ancient-mark)))) ! (setq gnus-newsgroup-data (cons (gnus-data-make number mark (1+ (point)) header 0) gnus-newsgroup-data)) (gnus-summary-insert-line --- 8106,8127 ---- (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-mark-below)) ! (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire (push number gnus-newsgroup-expirable) (push (cons number gnus-low-score-mark) gnus-newsgroup-reads))) ! (setq mark ! (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq number gnus-newsgroup-reads)) gnus-ancient-mark)))) ! (setq gnus-newsgroup-data (cons (gnus-data-make number mark (1+ (point)) header 0) gnus-newsgroup-data)) (gnus-summary-insert-line *************** *** 8098,8114 **** If READ-ALL is non-nil, all articles in the group are selected." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! articles fetched-articles) (or (gnus-check-server (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) ! (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. (kill-buffer (current-buffer)) ! (error "Couldn't request group %s: %s" group (gnus-status-message group)))) (setq gnus-newsgroup-name group) --- 8136,8152 ---- If READ-ALL is non-nil, all articles in the group are selected." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! articles fetched-articles cached) (or (gnus-check-server (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) ! (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. (kill-buffer (current-buffer)) ! (error "Couldn't request group %s: %s" group (gnus-status-message group)))) (setq gnus-newsgroup-name group) *************** *** 8116,8122 **** (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) (and gnus-asynchronous ! (gnus-check-backend-function 'request-asynchronous gnus-newsgroup-name) (setq gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name))) --- 8154,8160 ---- (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) (and gnus-asynchronous ! (gnus-check-backend-function 'request-asynchronous gnus-newsgroup-name) (setq gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name))) *************** *** 8125,8176 **** (when info (gnus-adjust-marked-articles info)) ! (setq gnus-newsgroup-unreads (gnus-set-difference (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) gnus-newsgroup-dormant)) (setq gnus-newsgroup-processable nil) ! (setq articles (gnus-articles-to-read group read-all)) ! ! (cond ! ((null articles) ! (gnus-message 3 "Couldn't select newsgroup") ! 'quit) ((eq articles 0) nil) (t ;; Init the dependencies hash table. ! (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) ;; Retrieve the headers and read them in. (gnus-message 5 "Fetching headers...") ! (setq gnus-newsgroup-headers ! (if (eq 'nov (setq gnus-headers-retrieved-by ! (gnus-retrieve-headers articles gnus-newsgroup-name ;; We might want to fetch old headers, but ;; not if there is only 1 article. (and gnus-fetch-old-headers ! (or (and (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)))))) (gnus-get-newsgroup-headers-xover articles) (gnus-get-newsgroup-headers))) ! (gnus-message 5 "Fetching headers...done") ;; Set the initial limit. (setq gnus-newsgroup-limit (copy-sequence articles)) ;; Remove canceled articles from the list of unread articles. (setq gnus-newsgroup-unreads ! (gnus-set-sorted-intersection gnus-newsgroup-unreads (setq fetched-articles (mapcar (lambda (headers) (mail-header-number headers)) gnus-newsgroup-headers)))) ;; Removed marked articles that do not exist. ! (gnus-update-missing-marks (gnus-sorted-complement fetched-articles articles)) ;; We might want to build some more threads first. (and gnus-fetch-old-headers --- 8163,8223 ---- (when info (gnus-adjust-marked-articles info)) ! ;; Kludge to avoid having cached articles nixed out in virtual groups. ! (when (gnus-virtual-group-p group) ! (setq cached gnus-newsgroup-cached)) ! ! (setq gnus-newsgroup-unreads (gnus-set-difference (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) gnus-newsgroup-dormant)) (setq gnus-newsgroup-processable nil) ! (setq articles (gnus-articles-to-read group read-all)) ! ! (cond ! ((null articles) ! (gnus-message 3 "Couldn't select newsgroup -- no articles to display") ! 'quit) ((eq articles 0) nil) (t ;; Init the dependencies hash table. ! (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) ;; Retrieve the headers and read them in. (gnus-message 5 "Fetching headers...") ! (setq gnus-newsgroup-headers ! (if (eq 'nov (setq gnus-headers-retrieved-by ! (gnus-retrieve-headers articles gnus-newsgroup-name ;; We might want to fetch old headers, but ;; not if there is only 1 article. (and gnus-fetch-old-headers ! (or (and (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)))))) (gnus-get-newsgroup-headers-xover articles) (gnus-get-newsgroup-headers))) ! (gnus-message 5 "Fetching headers...done") ! ! ;; Kludge to avoid having cached articles nixed out in virtual groups. ! (when cached ! (setq gnus-newsgroup-cached cached)) ! ;; Set the initial limit. (setq gnus-newsgroup-limit (copy-sequence articles)) ;; Remove canceled articles from the list of unread articles. (setq gnus-newsgroup-unreads ! (gnus-set-sorted-intersection gnus-newsgroup-unreads (setq fetched-articles (mapcar (lambda (headers) (mail-header-number headers)) gnus-newsgroup-headers)))) ;; Removed marked articles that do not exist. ! (gnus-update-missing-marks (gnus-sorted-complement fetched-articles articles)) ;; We might want to build some more threads first. (and gnus-fetch-old-headers *************** *** 8181,8187 **** (gnus-group-auto-expirable-p group)) ;; First and last article in this newsgroup. (and gnus-newsgroup-headers ! (setq gnus-newsgroup-begin (mail-header-number (car gnus-newsgroup-headers))) (setq gnus-newsgroup-end (mail-header-number --- 8228,8234 ---- (gnus-group-auto-expirable-p group)) ;; First and last article in this newsgroup. (and gnus-newsgroup-headers ! (setq gnus-newsgroup-begin (mail-header-number (car gnus-newsgroup-headers))) (setq gnus-newsgroup-end (mail-header-number *************** *** 8199,8205 **** (and (zerop (length gnus-newsgroup-marked)) (zerop (length gnus-newsgroup-unreads)))) (gnus-uncompress-range (gnus-active group)) ! (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) --- 8246,8252 ---- (and (zerop (length gnus-newsgroup-marked)) (zerop (length gnus-newsgroup-unreads)))) (gnus-uncompress-range (gnus-active group)) ! (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) *************** *** 8208,8219 **** (marked (+ (length gnus-newsgroup-marked) (length gnus-newsgroup-dormant))) (select ! (cond ((numberp read-all) read-all) (t (condition-case () ! (cond ((and (or (<= scored marked) (= scored number)) (numberp gnus-large-newsgroup) (> number gnus-large-newsgroup)) --- 8255,8266 ---- (marked (+ (length gnus-newsgroup-marked) (length gnus-newsgroup-dormant))) (select ! (cond ((numberp read-all) read-all) (t (condition-case () ! (cond ((and (or (<= scored marked) (= scored number)) (numberp gnus-large-newsgroup) (> number gnus-large-newsgroup)) *************** *** 8243,8249 **** (setq articles (copy-sequence articles))) (if (< (abs select) number) ! (if (< select 0) ;; Select the N oldest articles. (setcdr (nthcdr (1- (abs select)) articles) nil) ;; Select the N most recent articles. --- 8290,8296 ---- (setq articles (copy-sequence articles))) (if (< (abs select) number) ! (if (< select 0) ;; Select the N oldest articles. (setcdr (nthcdr (1- (abs select)) articles) nil) ;; Select the N most recent articles. *************** *** 8262,8267 **** --- 8309,8325 ---- (setq articles (cdr articles))) out)) + (defun gnus-uncompress-marks (marks) + "Uncompress the mark ranges in MARKS." + (let ((uncompressed '(score bookmark)) + out) + (while marks + (if (memq (caar marks) uncompressed) + (push (car marks) out) + (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) + (setq marks (cdr marks))) + out)) + (defun gnus-adjust-marked-articles (info) "Set all article lists and remove all marks that are no longer legal." (let* ((marked-lists (gnus-info-marks info)) *************** *** 8274,8289 **** (while marked-lists (setq marks (pop marked-lists)) ! (set (setq var (intern (format "gnus-newsgroup-%s" ! (car (rassq (setq mark (car marks)) types))))) (if (memq (car marks) uncompressed) (cdr marks) (gnus-uncompress-range (cdr marks)))) (setq articles (symbol-value var)) ! ;; All articles have to be subsets of the active articles. ! (cond ;; Adjust "simple" lists. ((memq mark '(tick dormant expirable reply killed save)) (while articles --- 8332,8347 ---- (while marked-lists (setq marks (pop marked-lists)) ! (set (setq var (intern (format "gnus-newsgroup-%s" ! (car (rassq (setq mark (car marks)) types))))) (if (memq (car marks) uncompressed) (cdr marks) (gnus-uncompress-range (cdr marks)))) (setq articles (symbol-value var)) ! ;; All articles have to be subsets of the active articles. ! (cond ;; Adjust "simple" lists. ((memq mark '(tick dormant expirable reply killed save)) (while articles *************** *** 8291,8298 **** (set var (delq article (symbol-value var)))))) ;; Adjust assocs. ((memq mark '(score bookmark)) ! (while articles ! (when (or (< (car (setq article (pop articles))) min) (> (car article) max)) (set var (delq article (symbol-value var)))))))))) --- 8349,8356 ---- (set var (delq article (symbol-value var)))))) ;; Adjust assocs. ((memq mark '(score bookmark)) ! (while articles ! (when (or (< (car (setq article (pop articles))) min) (> (car article) max)) (set var (delq article (symbol-value var)))))))))) *************** *** 8305,8311 **** (while types (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) (when (symbol-value var) ! ;; This list has articles. So we delete all missing articles ;; from it. (setq m missing) (while m --- 8363,8369 ---- (while types (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) (when (symbol-value var) ! ;; This list has articles. So we delete all missing articles ;; from it. (setq m missing) (while m *************** *** 8317,8330 **** (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) var type list newmarked symbol) ! ;; Add all marks lists that are non-nil to the list of marks lists. (while types (setq type (pop types)) ! (when (setq list (symbol-value (setq symbol ! (intern (format "gnus-newsgroup-%s" (car type)))))) ! (push (cons (cdr type) (if (memq (cdr type) uncompressed) list (gnus-compress-sequence (set symbol (sort list '<)) t))) newmarked))) --- 8375,8388 ---- (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) var type list newmarked symbol) ! ;; Add all marks lists that are non-nil to the list of marks lists. (while types (setq type (pop types)) ! (when (setq list (symbol-value (setq symbol ! (intern (format "gnus-newsgroup-%s" (car type)))))) ! (push (cons (cdr type) (if (memq (cdr type) uncompressed) list (gnus-compress-sequence (set symbol (sort list '<)) t))) newmarked))) *************** *** 8336,8342 **** (when newmarked (setcdr (nthcdr 2 info) (list newmarked)))) ! ;; Cut off the end of the info if there's nothing else there. (let ((i 5)) (while (and (> i 2) (not (nth i info))) --- 8394,8400 ---- (when newmarked (setcdr (nthcdr 2 info) (list newmarked)))) ! ;; Cut off the end of the info if there's nothing else there. (let ((i 5)) (while (and (> i 2) (not (nth i info))) *************** *** 8345,8351 **** (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. ! ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) (uncompressed '(score bookmark killed)) --- 8403,8409 ---- (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. ! ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) (uncompressed '(score bookmark killed)) *************** *** 8356,8370 **** (list (list (cons type (gnus-compress-sequence articles t)))))) (and (not (setq m (assq type (car marked)))) ! (setcar marked (cons (cons type (gnus-compress-sequence articles t) ) (car marked)))) (if force (setcdr m (gnus-compress-sequence articles t)) (setcdr m (gnus-compress-sequence ! (sort (nconc (gnus-uncompress-range m) (copy-sequence articles)) '<) t)))))) ! (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." --- 8414,8428 ---- (list (list (cons type (gnus-compress-sequence articles t)))))) (and (not (setq m (assq type (car marked)))) ! (setcar marked (cons (cons type (gnus-compress-sequence articles t) ) (car marked)))) (if force (setcdr m (gnus-compress-sequence articles t)) (setcdr m (gnus-compress-sequence ! (sort (nconc (gnus-uncompress-range m) (copy-sequence articles)) '<) t)))))) ! (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." *************** *** 8376,8385 **** ;; variables are buffer-local to that buffer. (set-buffer gnus-summary-buffer) ;; We bind all these variables that are used in the `eval' form ! ;; below. ! (let* ((mformat (if (eq where 'article) ! gnus-article-mode-line-format-spec ! gnus-summary-mode-line-format-spec)) (gnus-tmp-group-name gnus-newsgroup-name) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) --- 8434,8443 ---- ;; variables are buffer-local to that buffer. (set-buffer gnus-summary-buffer) ;; We bind all these variables that are used in the `eval' form ! ;; below. ! (let* ((mformat (symbol-value ! (intern ! (format "gnus-%s-mode-line-format-spec" where)))) (gnus-tmp-group-name gnus-newsgroup-name) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) *************** *** 8388,8394 **** (gnus-tmp-unread-and-unselected (cond ((and (zerop gnus-tmp-unread-and-unticked) (zerop gnus-tmp-unselected)) "") ! ((zerop gnus-tmp-unselected) (format "{%d more}" gnus-tmp-unread-and-unticked)) (t (format "{%d(+%d) more}" gnus-tmp-unread-and-unticked --- 8446,8452 ---- (gnus-tmp-unread-and-unselected (cond ((and (zerop gnus-tmp-unread-and-unticked) (zerop gnus-tmp-unselected)) "") ! ((zerop gnus-tmp-unselected) (format "{%d more}" gnus-tmp-unread-and-unticked)) (t (format "{%d(+%d) more}" gnus-tmp-unread-and-unticked *************** *** 8397,8412 **** (if (and gnus-current-headers (vectorp gnus-current-headers)) (mail-header-subject gnus-current-headers) "")) ! max-len header);; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) (setq max-len (max 4 (if gnus-mode-non-string-length ! (- (frame-width) gnus-mode-non-string-length) (length mode-string)))) ;; We might have to chop a bit of the string off... (when (> (length mode-string) max-len) ! (setq mode-string (concat (gnus-truncate-string mode-string (- max-len 3)) "..."))) ;; Pad the mode string a bit. --- 8455,8470 ---- (if (and gnus-current-headers (vectorp gnus-current-headers)) (mail-header-subject gnus-current-headers) "")) ! max-len header);; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) (setq max-len (max 4 (if gnus-mode-non-string-length ! (- (frame-width) gnus-mode-non-string-length) (length mode-string)))) ;; We might have to chop a bit of the string off... (when (> (length mode-string) max-len) ! (setq mode-string (concat (gnus-truncate-string mode-string (- max-len 3)) "..."))) ;; Pad the mode string a bit. *************** *** 8419,8428 **** "Go through the HEADERS list and add all Xrefs to a hash table. The resulting hash table is returned, or nil if no Xrefs were found." (let* ((from-method (gnus-find-method-for-group from-newsgroup)) ! (virtual (memq 'virtual ! (assoc (symbol-name (car (gnus-find-method-for-group ! from-newsgroup))) ! gnus-valid-select-methods))) (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) (xref-hashtb (make-vector 63 0)) start group entry number xrefs header) --- 8477,8483 ---- "Go through the HEADERS list and add all Xrefs to a hash table. The resulting hash table is returned, or nil if no Xrefs were found." (let* ((from-method (gnus-find-method-for-group from-newsgroup)) ! (virtual (gnus-virtual-group-p from-newsgroup)) (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) (xref-hashtb (make-vector 63 0)) start group entry number xrefs header) *************** *** 8434,8443 **** (setq start 0) (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) (setq start (match-end 0)) ! (setq group (concat prefix (substring xrefs (match-beginning 1) (match-end 1)))) ! (setq number ! (string-to-int (substring xrefs (match-beginning 2) (match-end 2)))) (if (setq entry (gnus-gethash group xref-hashtb)) (setcdr entry (cons number (cdr entry))) --- 8489,8498 ---- (setq start 0) (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) (setq start (match-end 0)) ! (setq group (concat prefix (substring xrefs (match-beginning 1) (match-end 1)))) ! (setq number ! (string-to-int (substring xrefs (match-beginning 2) (match-end 2)))) (if (setq entry (gnus-gethash group xref-hashtb)) (setcdr entry (cons number (cdr entry))) *************** *** 8446,8477 **** (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) "Look through all the headers and mark the Xrefs as read." ! (let ((virtual (memq 'virtual ! (assoc (symbol-name (car (gnus-find-method-for-group ! from-newsgroup))) ! gnus-valid-select-methods))) ! name entry info xref-hashtb idlist method ! nth4) (save-excursion (set-buffer gnus-group-buffer) ! (when (setq xref-hashtb (gnus-create-xref-hashtb from-newsgroup headers unreads)) ! (mapatoms (lambda (group) (unless (string= from-newsgroup (setq name (symbol-name group))) (setq idlist (symbol-value group)) ;; Dead groups are not updated. ! (and (prog1 (setq entry (gnus-gethash name gnus-newsrc-hashtb) info (nth 2 entry)) (if (stringp (setq nth4 (gnus-info-method info))) (setq nth4 (gnus-server-to-method nth4)))) ;; Only do the xrefs if the group has the same ;; select method as the group we have just read. ! (or (gnus-methods-equal-p nth4 (gnus-find-method-for-group from-newsgroup)) virtual ! (equal nth4 (setq method (gnus-find-method-for-group from-newsgroup))) (and (equal (car nth4) (car method)) (equal (nth 1 nth4) (nth 1 method)))) --- 8501,8528 ---- (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) "Look through all the headers and mark the Xrefs as read." ! (let ((virtual (gnus-virtual-group-p from-newsgroup)) ! name entry info xref-hashtb idlist method nth4) (save-excursion (set-buffer gnus-group-buffer) ! (when (setq xref-hashtb (gnus-create-xref-hashtb from-newsgroup headers unreads)) ! (mapatoms (lambda (group) (unless (string= from-newsgroup (setq name (symbol-name group))) (setq idlist (symbol-value group)) ;; Dead groups are not updated. ! (and (prog1 (setq entry (gnus-gethash name gnus-newsrc-hashtb) info (nth 2 entry)) (if (stringp (setq nth4 (gnus-info-method info))) (setq nth4 (gnus-server-to-method nth4)))) ;; Only do the xrefs if the group has the same ;; select method as the group we have just read. ! (or (gnus-methods-equal-p nth4 (gnus-find-method-for-group from-newsgroup)) virtual ! (equal nth4 (setq method (gnus-find-method-for-group from-newsgroup))) (and (equal (car nth4) (car method)) (equal (nth 1 nth4) (nth 1 method)))) *************** *** 8479,8485 **** (or (not (eq gnus-use-cross-reference t)) virtual ;; Only do cross-references on subscribed ! ;; groups, if that is what is wanted. (<= (gnus-info-level info) gnus-level-subscribed)) (gnus-group-make-articles-read name idlist)))) xref-hashtb))))) --- 8530,8536 ---- (or (not (eq gnus-use-cross-reference t)) virtual ;; Only do cross-references on subscribed ! ;; groups, if that is what is wanted. (<= (gnus-info-level info) gnus-level-subscribed)) (gnus-group-make-articles-read name idlist)))) xref-hashtb))))) *************** *** 8499,8505 **** (if (and first (> id (cdr active))) (progn ;; We'll end up in this situation in one particular ! ;; obscure situation. If you re-scan a group and get ;; a new article that is cross-posted to a different ;; group that has not been re-scanned, you might get ;; crossposted article that has a higher number than --- 8550,8556 ---- (if (and first (> id (cdr active))) (progn ;; We'll end up in this situation in one particular ! ;; obscure situation. If you re-scan a group and get ;; a new article that is cross-posted to a different ;; group that has not been re-scanned, you might get ;; crossposted article that has a higher number than *************** *** 8521,8537 **** (gnus-info-set-read info (setq range ! (gnus-add-to-range (gnus-info-read info) (setq articles (sort articles '<))))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (if active (progn ! (cond ((not range) (setq num (- (1+ (cdr active)) (car active)))) ((not (listp (cdr range))) ! (setq num (- (cdr active) (- (1+ (cdr range)) (car range))))) (t (while range --- 8572,8588 ---- (gnus-info-set-read info (setq range ! (gnus-add-to-range (gnus-info-read info) (setq articles (sort articles '<))))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (if active (progn ! (cond ((not range) (setq num (- (1+ (cdr active)) (car active)))) ((not (listp (cdr range))) ! (setq num (- (cdr active) (- (1+ (cdr range)) (car range))))) (t (while range *************** *** 8560,8568 **** (defvar gnus-newsgroup-none-id 0) ! (defun gnus-get-newsgroup-headers (&optional dependencies) (let ((cur nntp-server-buffer) ! (dependencies (or dependencies (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) --- 8611,8619 ---- (defvar gnus-newsgroup-none-id 0) ! (defun gnus-get-newsgroup-headers (&optional dependencies force-new) (let ((cur nntp-server-buffer) ! (dependencies (or dependencies (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) *************** *** 8572,8578 **** (let ((case-fold-search t) in-reply-to header number p lines) (goto-char (point-min)) ! ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. (while (re-search-forward "^[23][0-9]+ " nil t) (setq id nil --- 8623,8629 ---- (let ((case-fold-search t) in-reply-to header number p lines) (goto-char (point-min)) ! ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. (while (re-search-forward "^[23][0-9]+ " nil t) (setq id nil *************** *** 8580,8589 **** ;; This implementation of this function, with nine ;; search-forwards instead of the one re-search-forward and ;; a case (which basically was the old function) is actually ! ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance ;; doesn't always go hand in hand. ! (setq header (vector ;; Number. --- 8631,8640 ---- ;; This implementation of this function, with nine ;; search-forwards instead of the one re-search-forward and ;; a case (which basically was the old function) is actually ! ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance ;; doesn't always go hand in hand. ! (setq header (vector ;; Number. *************** *** 8591,8597 **** (read cur) (end-of-line) (setq p (point)) ! (narrow-to-region (point) (or (and (search-forward "\n.\n" nil t) (- (point) 2)) (point)))) --- 8642,8648 ---- (read cur) (end-of-line) (setq p (point)) ! (narrow-to-region (point) (or (and (search-forward "\n.\n" nil t) (- (point) 2)) (point)))) *************** *** 8617,8625 **** (setq id (gnus-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 --- 8668,8676 ---- (setq id (gnus-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 *************** *** 8629,8638 **** (gnus-header-value) (setq end (match-end 0)) (save-excursion ! (setq ref (downcase (buffer-substring ! (progn (end-of-line) (search-backward ">" end t) (1+ (point))) --- 8680,8689 ---- (gnus-header-value) (setq end (match-end 0)) (save-excursion ! (setq ref (downcase (buffer-substring ! (progn (end-of-line) (search-backward ">" end t) (1+ (point))) *************** *** 8641,8647 **** (point))))))) ;; Get the references from the in-reply-to header if there ;; were no references and the in-reply-to header looks ! ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) (setq in-reply-to (gnus-header-value)) (string-match "<[^>]+>" in-reply-to)) --- 8692,8698 ---- (point))))))) ;; Get the references from the in-reply-to header if there ;; were no references and the in-reply-to header looks ! ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) (setq in-reply-to (gnus-header-value)) (string-match "<[^>]+>" in-reply-to)) *************** *** 8674,8707 **** ;; done in case an article has arrived before the article ;; which it refers to. (if (boundp (setq id-dep (intern (downcase id) dependencies))) ! (if (car (symbol-value id-dep)) ;; An article with this Message-ID has already ;; been seen, so we ignore this one, except we add ;; any additional Xrefs (in case the two articles ;; came from different servers). (progn ! (mail-header-set-xref (car (symbol-value id-dep)) ! (concat (or (mail-header-xref (car (symbol-value id-dep))) "") (or (mail-header-xref header) ""))) (setq header nil)) (setcar (symbol-value id-dep) header)) (set id-dep (list header)))) ! (if header ! (progn ! (if (boundp (setq ref-dep (intern ref dependencies))) ! (setcdr (symbol-value ref-dep) ! (nconc (cdr (symbol-value ref-dep)) ! (list (symbol-value id-dep)))) ! (set ref-dep (list nil (symbol-value id-dep)))) ! (setq headers (cons header headers)))) (goto-char (point-max)) (widen)) (nreverse headers))))) ;; The following macros and functions were written by Felix Lee ! ;; . (defmacro gnus-nov-read-integer () '(prog1 --- 8725,8758 ---- ;; done in case an article has arrived before the article ;; which it refers to. (if (boundp (setq id-dep (intern (downcase id) dependencies))) ! (if (and (car (symbol-value id-dep)) ! (not force-new)) ;; An article with this Message-ID has already ;; been seen, so we ignore this one, except we add ;; any additional Xrefs (in case the two articles ;; came from different servers). (progn ! (mail-header-set-xref (car (symbol-value id-dep)) ! (concat (or (mail-header-xref (car (symbol-value id-dep))) "") (or (mail-header-xref header) ""))) (setq header nil)) (setcar (symbol-value id-dep) header)) (set id-dep (list header)))) ! (when header ! (if (boundp (setq ref-dep (intern ref dependencies))) ! (setcdr (symbol-value ref-dep) ! (nconc (cdr (symbol-value ref-dep)) ! (list (symbol-value id-dep)))) ! (set ref-dep (list nil (symbol-value id-dep)))) ! (setq headers (cons header headers))) (goto-char (point-max)) (widen)) (nreverse headers))))) ;; The following macros and functions were written by Felix Lee ! ;; . (defmacro gnus-nov-read-integer () '(prog1 *************** *** 8718,8724 **** '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) ;; Goes through the xover lines and returns a list of vectors ! (defun gnus-get-newsgroup-headers-xover (sequence) "Parse the news overview data in the server buffer, and return a list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some --- 8769,8775 ---- '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) ;; Goes through the xover lines and returns a list of vectors ! (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new) "Parse the news overview data in the server buffer, and return a list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some *************** *** 8738,8749 **** (setq number (read cur)) (while (and sequence (< (car sequence) number)) (setq sequence (cdr sequence))) ! (and sequence (eq number (car sequence)) (progn (setq sequence (cdr sequence)) ! (if (setq header ! (inline (gnus-nov-parse-line number dependencies))) (setq headers (cons header headers))))) (forward-line 1)) (setq headers (nreverse headers))) --- 8789,8801 ---- (setq number (read cur)) (while (and sequence (< (car sequence) number)) (setq sequence (cdr sequence))) ! (and sequence (eq number (car sequence)) (progn (setq sequence (cdr sequence)) ! (if (setq header ! (inline (gnus-nov-parse-line ! number dependencies force-new))) (setq headers (cons header headers))))) (forward-line 1)) (setq headers (nreverse headers))) *************** *** 8751,8759 **** ;; This function has to be called with point after the article number ;; on the beginning of the line. ! (defun gnus-nov-parse-line (number dependencies) (let ((none 0) ! (eol (gnus-point-at-eol)) (buffer (current-buffer)) header ref id id-dep ref-dep) --- 8803,8811 ---- ;; This function has to be called with point after the article number ;; on the beginning of the line. ! (defun gnus-nov-parse-line (number dependencies &optional force-new) (let ((none 0) ! (eol (gnus-point-at-eol)) (buffer (current-buffer)) header ref id id-dep ref-dep) *************** *** 8763,8785 **** (condition-case nil (setq header ! (vector number ; number ! (gnus-nov-field) ; subject ! (gnus-nov-field) ; from (gnus-nov-field) ; date (setq id (or (gnus-nov-field) (concat "none+" ! (int-to-string (setq none (1+ none)))))) ; id (progn (save-excursion (let ((beg (point))) (search-forward "\t" eol) (if (search-backward ">" beg t) ! (setq ref ! (downcase ! (buffer-substring (1+ (point)) (progn (search-backward "<" beg t) --- 8815,8837 ---- (condition-case nil (setq header ! (vector number ; number ! (gnus-nov-field) ; subject ! (gnus-nov-field) ; from (gnus-nov-field) ; date (setq id (or (gnus-nov-field) (concat "none+" ! (int-to-string (setq none (1+ none)))))) ; id (progn (save-excursion (let ((beg (point))) (search-forward "\t" eol) (if (search-backward ">" beg t) ! (setq ref ! (downcase ! (buffer-substring (1+ (point)) (progn (search-backward "<" beg t) *************** *** 8792,8798 **** nil (gnus-nov-field)) ; misc )) ! (error (progn (ding) (gnus-message 4 "Strange nov line") (setq header nil) --- 8844,8850 ---- nil (gnus-nov-field)) ; misc )) ! (error (progn (ding) (gnus-message 4 "Strange nov line") (setq header nil) *************** *** 8807,8821 **** ;; Banned article. (setq header nil) (if (boundp (setq id-dep (intern (downcase id) dependencies))) ! (if (car (symbol-value id-dep)) ;; An article with this Message-ID has already been seen, ;; so we ignore this one, except we add any additional ;; Xrefs (in case the two articles came from different ;; servers. (progn ! (mail-header-set-xref (car (symbol-value id-dep)) ! (concat (or (mail-header-xref (car (symbol-value id-dep))) "") (or (mail-header-xref header) ""))) (setq header nil)) --- 8859,8874 ---- ;; Banned article. (setq header nil) (if (boundp (setq id-dep (intern (downcase id) dependencies))) ! (if (and (car (symbol-value id-dep)) ! (not force-new)) ;; An article with this Message-ID has already been seen, ;; so we ignore this one, except we add any additional ;; Xrefs (in case the two articles came from different ;; servers. (progn ! (mail-header-set-xref (car (symbol-value id-dep)) ! (concat (or (mail-header-xref (car (symbol-value id-dep))) "") (or (mail-header-xref header) ""))) (setq header nil)) *************** *** 8824,8830 **** (if header (progn (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) ! (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) (list (symbol-value id-dep)))) (set ref-dep (list nil (symbol-value id-dep)))))) --- 8877,8883 ---- (if header (progn (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) ! (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) (list (symbol-value id-dep)))) (set ref-dep (list nil (symbol-value id-dep)))))) *************** *** 8842,8880 **** (let ((case-fold-search t) xref) (save-restriction ! (gnus-narrow-to-headers) (goto-char (point-min)) (if (or (and (eq (downcase (following-char)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (progn (goto-char (1+ (match-end 0))) ! (setq xref (buffer-substring (point) (progn (end-of-line) (point)))) (mail-header-set-xref headers xref)))))))) (defun gnus-summary-insert-subject (id) "Find article ID and insert the summary line for that article." (let ((header (gnus-read-header id)) ! number) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. (gnus-rebuild-thread (mail-header-id header)) ! (gnus-summary-goto-subject (setq number (mail-header-number header))) ! (when (> number 0) ! ;; We have to update the boundaries, possibly. ! (and (> number gnus-newsgroup-end) ! (setq gnus-newsgroup-end number)) ! (and (< number gnus-newsgroup-begin) ! (setq gnus-newsgroup-begin number)) ! (setq gnus-newsgroup-unselected ! (delq number gnus-newsgroup-unselected))) ! ;; Report back a success. ! number))) (defun gnus-summary-work-articles (n) ! "Return a list of articles to be worked upon. The prefix argument, the list of process marked articles, and the current article will be taken into consideration." (cond --- 8895,8937 ---- (let ((case-fold-search t) xref) (save-restriction ! (nnheader-narrow-to-headers) (goto-char (point-min)) (if (or (and (eq (downcase (following-char)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (progn (goto-char (1+ (match-end 0))) ! (setq xref (buffer-substring (point) (progn (end-of-line) (point)))) (mail-header-set-xref headers xref)))))))) (defun gnus-summary-insert-subject (id) "Find article ID and insert the summary line for that article." (let ((header (gnus-read-header id)) ! (number (and (numberp id) id))) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. (gnus-rebuild-thread (mail-header-id header)) ! (gnus-summary-goto-subject (setq number (mail-header-number header)))) ! (when (and (numberp number) ! (> number 0)) ! ;; We have to update the boundaries even if we can't fetch the ! ;; article if ID is a number -- so that the next `P' or `N' ! ;; command will fetch the previous (or next) article even ! ;; if the one we tried to fetch this time has been canceled. ! (and (> number gnus-newsgroup-end) ! (setq gnus-newsgroup-end number)) ! (and (< number gnus-newsgroup-begin) ! (setq gnus-newsgroup-begin number)) ! (setq gnus-newsgroup-unselected ! (delq number gnus-newsgroup-unselected))) ! ;; Report back a success? ! (and header number))) (defun gnus-summary-work-articles (n) ! "Return a list of articles to be worked upon. The prefix argument, the list of process marked articles, and the current article will be taken into consideration." (cond *************** *** 8884,8890 **** (n (abs n)) articles article) (save-excursion ! (while (and (> n 0) (push (setq article (gnus-summary-article-number)) articles) --- 8941,8947 ---- (n (abs n)) articles article) (save-excursion ! (while (and (> n 0) (push (setq article (gnus-summary-article-number)) articles) *************** *** 8901,8908 **** articles article) (save-excursion (goto-char (min (point) (mark))) ! (while ! (and (push (setq article (gnus-summary-article-number)) articles) (gnus-summary-find-next nil article) (< (point) max))) --- 8958,8965 ---- articles article) (save-excursion (goto-char (min (point) (mark))) ! (while ! (and (push (setq article (gnus-summary-article-number)) articles) (gnus-summary-find-next nil article) (< (point) max))) *************** *** 8919,8925 **** If optional argument BACKWARD is non-nil, search backward instead." (save-excursion (set-buffer gnus-group-buffer) ! (if (gnus-group-search-forward backward nil (if use-level (gnus-group-group-level) nil)) (gnus-group-group-name)))) --- 8976,8982 ---- If optional argument BACKWARD is non-nil, search backward instead." (save-excursion (set-buffer gnus-group-buffer) ! (if (gnus-group-search-forward backward nil (if use-level (gnus-group-group-level) nil)) (gnus-group-group-name)))) *************** *** 8989,8995 **** (and (or (not unread) (gnus-data-unread-p (car arts))) (vectorp (gnus-data-header (car arts))) ! (gnus-subject-equal simp-subject (mail-header-subject (gnus-data-header (car arts))) t) (setq result (car arts) arts nil)) --- 9046,9052 ---- (and (or (not unread) (gnus-data-unread-p (car arts))) (vectorp (gnus-data-header (car arts))) ! (gnus-subject-equal simp-subject (mail-header-subject (gnus-data-header (car arts))) t) (setq result (car arts) arts nil)) *************** *** 9009,9015 **** (defun gnus-summary-recenter () "Center point in the summary window. If `gnus-auto-center-summary' is nil, or the article buffer isn't ! displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) --- 9066,9072 ---- (defun gnus-summary-recenter () "Center point in the summary window. If `gnus-auto-center-summary' is nil, or the article buffer isn't ! displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) *************** *** 9020,9040 **** (forward-line (- height)) (point))) (window (get-buffer-window (current-buffer)))) ! (and ! ;; The user has to want it, ! gnus-auto-center-summary ! ;; the article buffer must be displayed, ! (get-buffer-window gnus-article-buffer) ! ;; Set the window start to either `bottom', which is the biggest ! ;; possible valid number, or the second line from the top, ! ;; whichever is the least. ! (set-window-start ! window (min bottom (save-excursion (forward-line (- top)) (point))))))) ! ;; Function written by Stainless Steel Rat . (defun gnus-short-group-name (group &optional levels) "Collapse GROUP name LEVELS." ! (let* ((name "") (foreign "") (depth -1) (skip 1) (levels (or levels (progn (while (string-match "\\." group skip) --- 9077,9121 ---- (forward-line (- height)) (point))) (window (get-buffer-window (current-buffer)))) ! ;; The user has to want it. ! (when gnus-auto-center-summary ! (when (get-buffer-window gnus-article-buffer) ! ;; Only do recentering when the article buffer is displayed, ! ;; Set the window start to either `bottom', which is the biggest ! ;; possible valid number, or the second line from the top, ! ;; whichever is the least. ! (set-window-start ! window (min bottom (save-excursion ! (forward-line (- top)) (point))))) ! ;; Do horizontal recentering while we're at it. ! (gnus-horizontal-recenter)))) ! ! (defun gnus-horizontal-recenter () ! "Recenter the current buffer horizontally." ! (if (< (current-column) (/ (window-width) 2)) ! (set-window-hscroll (get-buffer-window (current-buffer)) 0) ! (let* ((orig (point)) ! (max 0)) ! ;; Find the longest line currently displayed in the window. ! (goto-char (window-start)) ! (while (< (point) (window-end)) ! (end-of-line) ! (setq max (max max (current-column))) ! (forward-line 1)) ! (goto-char orig) ! ;; Scroll horizontally to center (sort of) the point. ! (if (> max (window-width)) ! (set-window-hscroll ! (get-buffer-window (current-buffer)) ! (min (- (current-column) ! (/ (+ (window-width) (window-hscroll)) 2)) ! (+ 2 (- max (window-width))))) ! (set-window-hscroll (get-buffer-window (current-buffer)) 0))))) ! ;; Function written by Stainless Steel Rat . (defun gnus-short-group-name (group &optional levels) "Collapse GROUP name LEVELS." ! (let* ((name "") (foreign "") (depth 0) (skip 1) (levels (or levels (progn (while (string-match "\\." group skip) *************** *** 9078,9084 **** (active (gnus-active group)) (last (cdr active)) first nlast unread) ! ;; If none are read, then all are unread. (if (not read) (setq first (car active)) ;; If the range of read articles is a single range, then the --- 9159,9165 ---- (active (gnus-active group)) (last (cdr active)) first nlast unread) ! ;; If none are read, then all are unread. (if (not read) (setq first (car active)) ;; If the range of read articles is a single range, then the *************** *** 9087,9102 **** (if (not (listp (cdr read))) (setq first (1+ (cdr read))) ;; `read' is a list of ranges. ! (if (/= (setq nlast (or (and (numberp (car read)) (car read)) (car (car read)))) 1) (setq first 1)) (while read ! (if first (while (< first nlast) (setq unread (cons first unread)) (setq first (1+ first)))) (setq first (1+ (if (atom (car read)) (car read) (cdr (car read))))) ! (setq nlast (if (atom (car (cdr read))) (car (cdr read)) (car (car (cdr read))))) (setq read (cdr read))))) --- 9168,9183 ---- (if (not (listp (cdr read))) (setq first (1+ (cdr read))) ;; `read' is a list of ranges. ! (if (/= (setq nlast (or (and (numberp (car read)) (car read)) (car (car read)))) 1) (setq first 1)) (while read ! (if first (while (< first nlast) (setq unread (cons first unread)) (setq first (1+ first)))) (setq first (1+ (if (atom (car read)) (car read) (cdr (car read))))) ! (setq nlast (if (atom (car (cdr read))) (car (cdr read)) (car (car (cdr read))))) (setq read (cdr read))))) *************** *** 9114,9142 **** (active (gnus-active group))) (and info active (gnus-set-difference ! (gnus-sorted-complement ! (gnus-uncompress-range active) (gnus-list-of-unread-articles group)) ! (append (gnus-uncompress-range (cdr (assq 'dormant marked))) (gnus-uncompress-range (cdr (assq 'tick marked)))))))) ;; Various summary commands ! (defun gnus-summary-universal-argument () ! "Perform any operation on all articles marked with the process mark." ! (interactive) (gnus-set-global-variables) ! (let ((articles (reverse gnus-newsgroup-processable)) ! func) ! (or articles (error "No articles marked")) ! (or (setq func (key-binding (read-key-sequence "C-c C-u"))) ! (error "Undefined key")) ! (while articles ! (gnus-summary-goto-subject (car articles)) ! (command-execute func) ! (gnus-summary-remove-process-mark (car articles)) ! (setq articles (cdr articles))))) (defun gnus-summary-toggle-truncation (&optional arg) "Toggle truncation of summary lines. --- 9195,9233 ---- (active (gnus-active group))) (and info active (gnus-set-difference ! (gnus-sorted-complement ! (gnus-uncompress-range active) (gnus-list-of-unread-articles group)) ! (append (gnus-uncompress-range (cdr (assq 'dormant marked))) (gnus-uncompress-range (cdr (assq 'tick marked)))))))) ;; Various summary commands ! (defun gnus-summary-universal-argument (arg) ! "Perform any operation on all articles that are process/prefixed." ! (interactive "P") (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles arg)) ! func article) ! (if (eq ! (setq ! func ! (key-binding ! (read-key-sequence ! (substitute-command-keys ! "\\\\[gnus-summary-universal-argument]" ! )))) ! 'undefined) ! (progn ! (message "Undefined key") ! (ding)) ! (save-excursion ! (while articles ! (gnus-summary-goto-subject (setq article (pop articles))) ! (command-execute func) ! (gnus-summary-remove-process-mark article))))) ! (gnus-summary-position-point)) (defun gnus-summary-toggle-truncation (&optional arg) "Toggle truncation of summary lines. *************** *** 9147,9154 **** (> (prefix-numeric-value arg) 0))) (redraw-display)) ! (defun gnus-summary-reselect-current-group (&optional all) ! "Once exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." (interactive "P") (gnus-set-global-variables) --- 9238,9245 ---- (> (prefix-numeric-value arg) 0))) (redraw-display)) ! (defun gnus-summary-reselect-current-group (&optional all rescan) ! "Exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." (interactive "P") (gnus-set-global-variables) *************** *** 9160,9181 **** ;; current point was moved to the next unread newsgroup by ;; exiting. (gnus-summary-jump-to-group group) (gnus-group-read-group all t) (gnus-summary-goto-subject current-subject))) (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." (interactive "P") ! (gnus-set-global-variables) ! ;; Fix by Ilja Weis . ! (let ((group gnus-newsgroup-name)) ! (gnus-summary-exit) ! (gnus-summary-jump-to-group group) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-group-get-new-news-this-group 1)) ! (gnus-summary-jump-to-group group) ! (gnus-group-read-group all))) (defun gnus-summary-update-info () (let* ((group gnus-newsgroup-name)) --- 9251,9266 ---- ;; current point was moved to the next unread newsgroup by ;; exiting. (gnus-summary-jump-to-group group) + (when rescan + (save-excursion + (gnus-group-get-new-news-this-group 1))) (gnus-group-read-group all t) (gnus-summary-goto-subject current-subject))) (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." (interactive "P") ! (gnus-summary-reselect-current-group all t)) (defun gnus-summary-update-info () (let* ((group gnus-newsgroup-name)) *************** *** 9207,9219 **** ;; Do adaptive scoring, and possibly save score files. (when gnus-newsgroup-adaptive (gnus-score-adaptive)) ! (when gnus-use-scoring (gnus-score-save)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group))))) ! (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. gnus-exit-group-hook is called with no arguments if that value is non-nil." --- 9292,9304 ---- ;; Do adaptive scoring, and possibly save score files. (when gnus-newsgroup-adaptive (gnus-score-adaptive)) ! (when gnus-use-scoring (gnus-score-save)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group))))) ! (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. gnus-exit-group-hook is called with no arguments if that value is non-nil." *************** *** 9226,9260 **** (buf (current-buffer))) (run-hooks 'gnus-summary-prepare-exit-hook) ;; Make all changes in this group permanent. ! (gnus-summary-update-info) (set-buffer buf) (when gnus-use-cache (gnus-cache-possibly-remove-articles) (gnus-cache-save-buffers)) ;; Make sure where I was, and go to next newsgroup. (set-buffer gnus-group-buffer) (or quit-config (progn (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1))) (if temporary nil ;Nothing to do. ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer ! (gnus-kill-buffer gnus-article-buffer)) (if (not gnus-kill-summary-on-exit) (gnus-deaden-summary) ;; We set all buffer-local variables to nil. It is unclear why ;; this is needed, but if we don't, buffer-local variables are ;; not garbage-collected, it seems. This would the lead to en ;; ever-growing Emacs. - (set-buffer buf) (gnus-summary-clear-local-variables) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. (gnus-configure-windows 'group 'force) (gnus-summary-clear-local-variables) ! ;; Return to group mode buffer. (if (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) --- 9311,9349 ---- (buf (current-buffer))) (run-hooks 'gnus-summary-prepare-exit-hook) ;; Make all changes in this group permanent. ! (gnus-summary-update-info) (set-buffer buf) (when gnus-use-cache (gnus-cache-possibly-remove-articles) (gnus-cache-save-buffers)) + (when gnus-use-trees + (gnus-tree-close group)) ;; Make sure where I was, and go to next newsgroup. (set-buffer gnus-group-buffer) (or quit-config (progn (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1))) + (run-hooks 'gnus-summary-exit-hook) (if temporary nil ;Nothing to do. ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer ! (gnus-kill-buffer gnus-article-buffer) ! (gnus-kill-buffer gnus-original-article-buffer)) ! (set-buffer buf) (if (not gnus-kill-summary-on-exit) (gnus-deaden-summary) ;; We set all buffer-local variables to nil. It is unclear why ;; this is needed, but if we don't, buffer-local variables are ;; not garbage-collected, it seems. This would the lead to en ;; ever-growing Emacs. (gnus-summary-clear-local-variables) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. (gnus-configure-windows 'group 'force) (gnus-summary-clear-local-variables) ! ;; Return to group mode buffer. (if (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) *************** *** 9263,9276 **** (if (not quit-config) (progn (gnus-group-jump-to-group group) ! (gnus-group-next-unread-group 1)) (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) - (run-hooks 'gnus-summary-exit-hook) (unless quit-config (setq gnus-newsgroup-name nil))))) --- 9352,9365 ---- (if (not quit-config) (progn (gnus-group-jump-to-group group) ! (gnus-group-next-unread-group 1) ! (gnus-configure-windows 'group 'force)) (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) (unless quit-config (setq gnus-newsgroup-name nil))))) *************** *** 9286,9292 **** (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer ! (gnus-kill-buffer gnus-article-buffer)) (if (not gnus-kill-summary-on-exit) (gnus-deaden-summary) (gnus-close-group group) --- 9375,9382 ---- (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer ! (gnus-kill-buffer gnus-article-buffer) ! (gnus-kill-buffer gnus-original-article-buffer)) (if (not gnus-kill-summary-on-exit) (gnus-deaden-summary) (gnus-close-group group) *************** *** 9295,9300 **** --- 9385,9392 ---- (gnus-summary-clear-local-variables) (when (get-buffer gnus-summary-buffer) (kill-buffer gnus-summary-buffer))) + (when gnus-use-trees + (gnus-tree-close group)) ;; Return to the group buffer. (gnus-configure-windows 'group 'force) ;; Clear the current group name. *************** *** 9315,9329 **** (if gnus-dead-summary-mode-map nil ! (setq gnus-dead-summary-map (make-keymap)) ! (suppress-keymap gnus-dead-summary-map) (substitute-key-definition ! 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-map) (let ((keys '("\C-d" "\r" "\177"))) (while keys ! (define-key gnus-dead-summary-map (pop keys) 'gnus-summary-wake-up-the-dead)))) ! (defvar gnus-dead-summary-mode nil "Minor mode for Gnus summary buffers.") --- 9407,9421 ---- (if gnus-dead-summary-mode-map nil ! (setq gnus-dead-summary-mode-map (make-keymap)) ! (suppress-keymap gnus-dead-summary-mode-map) (substitute-key-definition ! 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) (let ((keys '("\C-d" "\r" "\177"))) (while keys ! (define-key gnus-dead-summary-mode-map (pop keys) 'gnus-summary-wake-up-the-dead)))) ! (defvar gnus-dead-summary-mode nil "Minor mode for Gnus summary buffers.") *************** *** 9332,9338 **** (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-dead-summary-mode) ! (setq gnus-dead-summary-mode (if (null arg) (not gnus-dead-summary-mode) (> (prefix-numeric-value arg) 0))) (when gnus-dead-summary-mode --- 9424,9430 ---- (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-dead-summary-mode) ! (setq gnus-dead-summary-mode (if (null arg) (not gnus-dead-summary-mode) (> (prefix-numeric-value arg) 0))) (when gnus-dead-summary-mode *************** *** 9363,9368 **** --- 9455,9466 ---- (defun gnus-kill-or-deaden-summary (buffer) "Kill or deaden the summary BUFFER." (cond (gnus-kill-summary-on-exit + (when (and gnus-use-trees + (and (get-buffer buffer) + (buffer-name (get-buffer buffer)))) + (save-excursion + (set-buffer (get-buffer buffer)) + (gnus-tree-close gnus-newsgroup-name))) (gnus-kill-buffer buffer)) ((and (get-buffer buffer) (buffer-name (get-buffer buffer))) *************** *** 9386,9399 **** "Fetch the FAQ for the current group. If FAQ-DIR (the prefix), prompt for a directory to search for the faq in." ! (interactive (list (if current-prefix-arg ! (completing-read "Faq dir: " (and (listp gnus-group-faq-directory) gnus-group-faq-directory))))) (let (gnus-faq-buffer) ! (and (setq gnus-faq-buffer (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) (gnus-configure-windows 'summary-faq)))) --- 9484,9497 ---- "Fetch the FAQ for the current group. If FAQ-DIR (the prefix), prompt for a directory to search for the faq in." ! (interactive (list (if current-prefix-arg ! (completing-read "Faq dir: " (and (listp gnus-group-faq-directory) gnus-group-faq-directory))))) (let (gnus-faq-buffer) ! (and (setq gnus-faq-buffer (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) (gnus-configure-windows 'summary-faq)))) *************** *** 9407,9413 **** "Describe summary mode commands briefly." (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. --- 9505,9511 ---- "Describe summary mode commands briefly." (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. *************** *** 9430,9438 **** ;; Then we find what group we are supposed to enter. (set-buffer gnus-group-buffer) (gnus-group-jump-to-group current-group) ! (setq target-group ! (or target-group ! (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) (if (not target-group) --- 9528,9536 ---- ;; Then we find what group we are supposed to enter. (set-buffer gnus-group-buffer) (gnus-group-jump-to-group current-group) ! (setq target-group ! (or target-group ! (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) (if (not target-group) *************** *** 9468,9474 **** Returns the article selected or nil if there are no unread articles." (interactive "P") (prog1 ! (cond ;; Empty summary. ((null gnus-newsgroup-data) (gnus-message 3 "No articles in the group") --- 9566,9572 ---- Returns the article selected or nil if there are no unread articles." (interactive "P") (prog1 ! (cond ;; Empty summary. ((null gnus-newsgroup-data) (gnus-message 3 "No articles in the group") *************** *** 9537,9543 **** (let ((b (point)) (data (gnus-data-find article))) ;; We read in the article if we have to. ! (and (not data) force (gnus-summary-insert-subject article) (setq data (gnus-data-find article))) --- 9635,9641 ---- (let ((b (point)) (data (gnus-data-find article))) ;; We read in the article if we have to. ! (and (not data) force (gnus-summary-insert-subject article) (setq data (gnus-data-find article))) *************** *** 9567,9580 **** (if (null article) nil (prog1 ! (gnus-article-prepare article all-header) ! (gnus-summary-show-thread) (run-hooks 'gnus-select-article-hook) (gnus-summary-recenter) (gnus-summary-goto-subject article) ;; Successfully display article. ! (gnus-summary-update-line) ! (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))) t))) --- 9665,9681 ---- (if (null article) nil (prog1 ! (if gnus-summary-display-article-function ! (funcall gnus-summary-display-article-function article all-header) ! (gnus-article-prepare article all-header)) (run-hooks 'gnus-select-article-hook) (gnus-summary-recenter) (gnus-summary-goto-subject article) + (when gnus-use-trees + (gnus-possibly-generate-tree article) + (gnus-highlight-selected-tree article)) ;; Successfully display article. ! (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))) t))) *************** *** 9586,9593 **** be displayed." (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. ! did) ! (and (not pseudo) (gnus-summary-article-pseudo-p article) (error "This is a pseudo-article.")) (prog1 --- 9687,9695 ---- be displayed." (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. ! gnus-summary-display-article-function ! did) ! (and (not pseudo) (gnus-summary-article-pseudo-p article) (error "This is a pseudo-article.")) (prog1 *************** *** 9607,9617 **** (prog1 (gnus-summary-display-article article all-headers) (setq did article)) ! (if (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) t)) ! (if did ! (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))))))) (defun gnus-summary-set-current-mark (&optional current-mark) --- 9709,9719 ---- (prog1 (gnus-summary-display-article article all-headers) (setq did article)) ! (if (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) t)) ! (if did ! (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))))))) (defun gnus-summary-set-current-mark (&optional current-mark) *************** *** 9642,9648 **** ;; Try to get next/previous article not displayed in this group. ((and gnus-auto-extend-newsgroup (not unread) (not subject)) ! (gnus-summary-goto-article (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) nil t)) ;; Go to next/previous group. --- 9744,9750 ---- ;; Try to get next/previous article not displayed in this group. ((and gnus-auto-extend-newsgroup (not unread) (not subject)) ! (gnus-summary-goto-article (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) nil t)) ;; Go to next/previous group. *************** *** 9650,9664 **** (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-summary-jump-to-group gnus-newsgroup-name)) (let ((cmd last-command-char) ! (group ! (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) ;; For some reason, the group window gets selected. We change ! ;; it back. (select-window (get-buffer-window (current-buffer))) ;; Select next unread newsgroup automagically. ! (cond ((not gnus-auto-select-next) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ((or (eq gnus-auto-select-next 'quietly) --- 9752,9766 ---- (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-summary-jump-to-group gnus-newsgroup-name)) (let ((cmd last-command-char) ! (group ! (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) ;; For some reason, the group window gets selected. We change ! ;; it back. (select-window (get-buffer-window (current-buffer))) ;; Select next unread newsgroup automagically. ! (cond ((not gnus-auto-select-next) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ((or (eq gnus-auto-select-next 'quietly) *************** *** 9668,9679 **** (if (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-summary-exit) (gnus-message 7 "No more%s articles (%s)..." ! (if unread " unread" "") (if group (concat "selecting " group) "exiting")) (gnus-summary-next-group nil group backward))) (t ! (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward)))))))) (defun gnus-summary-walk-group-buffer (from-group cmd unread backward) --- 9770,9781 ---- (if (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-summary-exit) (gnus-message 7 "No more%s articles (%s)..." ! (if unread " unread" "") (if group (concat "selecting " group) "exiting")) (gnus-summary-next-group nil group backward))) (t ! (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward)))))))) (defun gnus-summary-walk-group-buffer (from-group cmd unread backward) *************** *** 9683,9693 **** (save-excursion (set-buffer gnus-group-buffer) (gnus-summary-jump-to-group from-group) ! (setq group (gnus-summary-search-group backward))) (while (not ended) ! (gnus-message 7 "No more%s articles%s" (if unread " unread" "") ! (if (and group (not (gnus-ephemeral-group-p gnus-newsgroup-name))) (format " (Type %s for %s [%s])" (single-key-description cmd) group --- 9785,9798 ---- (save-excursion (set-buffer gnus-group-buffer) (gnus-summary-jump-to-group from-group) ! (setq group ! (if (eq gnus-keep-same-level 'best) ! (gnus-summary-best-group gnus-newsgroup-name) ! (gnus-summary-search-group backward gnus-keep-same-level)))) (while (not ended) ! (gnus-message 7 "No more%s articles%s" (if unread " unread" "") ! (if (and group (not (gnus-ephemeral-group-p gnus-newsgroup-name))) (format " (Type %s for %s [%s])" (single-key-description cmd) group *************** *** 9698,9704 **** ;; Confirm auto selection. (setq key (car (setq keve (gnus-read-event-char)))) (setq ended t) ! (cond ((assq key keystrokes) (let ((obuf (current-buffer))) (switch-to-buffer gnus-group-buffer) --- 9803,9809 ---- ;; Confirm auto selection. (setq key (car (setq keve (gnus-read-event-char)))) (setq ended t) ! (cond ((assq key keystrokes) (let ((obuf (current-buffer))) (switch-to-buffer gnus-group-buffer) *************** *** 9740,9751 **** (gnus-summary-article-subject)))) (defun gnus-summary-next-page (&optional lines circular) ! "Show next page of selected article. ! If end of article, select next article. ! Argument LINES specifies lines to be scrolled up. ! If CIRCULAR is non-nil, go to the start of the article instead of ! instead of selecting the next article when reaching the end of the ! current article." (interactive "P") (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) --- 9845,9857 ---- (gnus-summary-article-subject)))) (defun gnus-summary-next-page (&optional lines circular) ! "Show next page of the selected article. ! If at the end of the current article, select the next article. ! LINES says how many lines should be scrolled up. ! ! If CIRCULAR is non-nil, go to the start of the article instead of ! selecting the next article when reaching the end of the current ! article." (interactive "P") (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) *************** *** 9762,9773 **** gnus-article-buffer (setq endp (gnus-article-next-page lines))) (if endp ! (cond (circular ! (gnus-summary-beginning-of-article)) ! (lines ! (gnus-message 3 "End of message")) ! ((null lines) ! (gnus-summary-next-unread-article))))) (gnus-summary-recenter) (gnus-summary-position-point))) --- 9868,9881 ---- gnus-article-buffer (setq endp (gnus-article-next-page lines))) (if endp ! (cond (circular ! (gnus-summary-beginning-of-article)) ! (lines ! (gnus-message 3 "End of message")) ! ((null lines) ! (if (eq gnus-summary-goto-unread 'always) ! (gnus-summary-next-article) ! (gnus-summary-next-unread-article)))))) (gnus-summary-recenter) (gnus-summary-position-point))) *************** *** 9796,9802 **** (gnus-set-global-variables) (gnus-configure-windows 'article) (or (gnus-summary-select-article nil nil 'pseudo) ! (gnus-eval-in-buffer-window gnus-article-buffer (cond ((> lines 0) (if (gnus-article-next-page lines) --- 9904,9910 ---- (gnus-set-global-variables) (gnus-configure-windows 'article) (or (gnus-summary-select-article nil nil 'pseudo) ! (gnus-eval-in-buffer-window gnus-article-buffer (cond ((> lines 0) (if (gnus-article-next-page lines) *************** *** 9831,9837 **** (gnus-summary-prev-article t (gnus-summary-article-subject))) (defun gnus-summary-first-unread-article () ! "Select the first unread article. Return nil if there are no unread articles." (interactive) (gnus-set-global-variables) --- 9939,9945 ---- (gnus-summary-prev-article t (gnus-summary-article-subject))) (defun gnus-summary-first-unread-article () ! "Select the first unread article. Return nil if there are no unread articles." (interactive) (gnus-set-global-variables) *************** *** 9852,9858 **** article score) (while data (and (gnus-data-unread-p (car data)) ! (> (setq score (gnus-summary-article-score (gnus-data-number (car data)))) best) (setq best score --- 9960,9966 ---- article score) (while data (and (gnus-data-unread-p (car data)) ! (> (setq score (gnus-summary-article-score (gnus-data-number (car data)))) best) (setq best score *************** *** 9875,9881 **** (interactive (list (string-to-int ! (completing-read "Article number: " (mapcar (lambda (number) (list (int-to-string number))) gnus-newsgroup-limit))) --- 9983,9989 ---- (interactive (list (string-to-int ! (completing-read "Article number: " (mapcar (lambda (number) (list (int-to-string number))) gnus-newsgroup-limit))) *************** *** 9926,9940 **** (interactive "P") (gnus-set-global-variables) (prog2 ! (if total (setq gnus-newsgroup-limits (list (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers)))) (gnus-summary-limit nil 'pop) (gnus-summary-position-point))) ! (defun gnus-summary-limit-to-subject (subject) "Limit the summary buffer to articles that have subjects that match a regexp." (interactive "sRegexp: ") (when (not (equal "" subject)) (prog1 (let ((articles (gnus-summary-find-matching "subject" subject 'all))) --- 10034,10050 ---- (interactive "P") (gnus-set-global-variables) (prog2 ! (if total (setq gnus-newsgroup-limits (list (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers)))) (gnus-summary-limit nil 'pop) (gnus-summary-position-point))) ! (defun gnus-summary-limit-to-subject (subject &optional header) "Limit the summary buffer to articles that have subjects that match a regexp." (interactive "sRegexp: ") + (unless header + (setq header "subject")) (when (not (equal "" subject)) (prog1 (let ((articles (gnus-summary-find-matching "subject" subject 'all))) *************** *** 9942,9949 **** (gnus-summary-limit articles)) (gnus-summary-position-point)))) (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) ! (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (defun gnus-summary-limit-to-unread (&optional all) --- 10052,10064 ---- (gnus-summary-limit articles)) (gnus-summary-position-point)))) + (defun gnus-summary-limit-to-author (from) + "Limit the summary buffer to articles that have authors that match a regexp." + (interactive "sRegexp: ") + (gnus-summary-limit-to-subject from "from")) + (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) ! (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (defun gnus-summary-limit-to-unread (&optional all) *************** *** 9954,9960 **** (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) (gnus-summary-limit-to-marks ;; Concat all the marks that say that an article is read and have ! ;; those removed. (list gnus-del-mark gnus-read-mark gnus-ancient-mark gnus-killed-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark --- 10069,10075 ---- (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) (gnus-summary-limit-to-marks ;; Concat all the marks that say that an article is read and have ! ;; those removed. (list gnus-del-mark gnus-read-mark gnus-ancient-mark gnus-killed-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark *************** *** 9967,9973 **** (defun gnus-summary-limit-to-marks (marks &optional reverse) "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are not marked ! with MARKS. MARKS can either be a string of marks or a list of marks. Returns how many articles were removed." (interactive "sMarks: ") (gnus-set-global-variables) --- 10082,10088 ---- (defun gnus-summary-limit-to-marks (marks &optional reverse) "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are not marked ! with MARKS. MARKS can either be a string of marks or a list of marks. Returns how many articles were removed." (interactive "sMarks: ") (gnus-set-global-variables) *************** *** 10006,10012 **** "Display all the hidden articles that are marked as dormant." (interactive) (gnus-set-global-variables) ! (or gnus-newsgroup-dormant (error "There are no dormant articles in this group")) (prog1 (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) --- 10121,10127 ---- "Display all the hidden articles that are marked as dormant." (interactive) (gnus-set-global-variables) ! (or gnus-newsgroup-dormant (error "There are no dormant articles in this group")) (prog1 (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) *************** *** 10027,10033 **** (let ((data gnus-newsgroup-data) articles) ;; Find all articles that are either not dormant or have ! ;; children. (while data (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark)) (gnus-article-parent-p (gnus-data-number (car data)))) --- 10142,10148 ---- (let ((data gnus-newsgroup-data) articles) ;; Find all articles that are either not dormant or have ! ;; children. (while data (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark)) (gnus-article-parent-p (gnus-data-number (car data)))) *************** *** 10038,10051 **** (prog1 (gnus-summary-limit articles) (gnus-summary-position-point)))) ! (defun gnus-summary-limit (articles &optional pop) (if pop ;; We pop the previous limit off the stack and use that. (setq articles (car gnus-newsgroup-limits) gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) ! ;; We use the new limit, so we push the old limit on the stack. ! (setq gnus-newsgroup-limits (cons gnus-newsgroup-limit gnus-newsgroup-limits))) ;; Set the limit. (setq gnus-newsgroup-limit articles) --- 10153,10191 ---- (prog1 (gnus-summary-limit articles) (gnus-summary-position-point)))) ! ! (defun gnus-summary-limit-mark-excluded-as-read (&optional all) ! "Mark all unread excluded articles as read. ! If ALL, mark even excluded ticked and dormants as read." ! (interactive "P") ! (let ((articles (gnus-sorted-complement ! (sort ! (mapcar (lambda (h) (mail-header-number h)) ! gnus-newsgroup-headers) ! '<) ! (sort gnus-newsgroup-limit '<))) ! article) ! (setq gnus-newsgroup-unreads nil) ! (if all ! (setq gnus-newsgroup-dormant nil ! gnus-newsgroup-marked nil ! gnus-newsgroup-reads ! (nconc ! (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) ! gnus-newsgroup-reads)) ! (while (setq article (pop articles)) ! (unless (or (memq article gnus-newsgroup-dormant) ! (memq article gnus-newsgroup-marked)) ! (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) ! ! (defun gnus-summary-limit (articles &optional pop) (if pop ;; We pop the previous limit off the stack and use that. (setq articles (car gnus-newsgroup-limits) gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) ! ;; We use the new limit, so we push the old limit on the stack. ! (setq gnus-newsgroup-limits (cons gnus-newsgroup-limit gnus-newsgroup-limits))) ;; Set the limit. (setq gnus-newsgroup-limit articles) *************** *** 10056,10066 **** ;; according to the new limit. (gnus-summary-prepare) ;; Try to return to the article you were at, or on in the ! ;; neighborhood. (if data ;; We try to find some article after the current one. (while data ! (and (gnus-summary-goto-subject (gnus-data-number (car data)) nil t) (setq data nil found t)) --- 10196,10206 ---- ;; according to the new limit. (gnus-summary-prepare) ;; Try to return to the article you were at, or on in the ! ;; neighborhood. (if data ;; We try to find some article after the current one. (while data ! (and (gnus-summary-goto-subject (gnus-data-number (car data)) nil t) (setq data nil found t)) *************** *** 10076,10082 **** ;; buffer as a result of the new limit. (- total (length gnus-newsgroup-data)))) ! (defun gnus-summary-initial-limit () "Figure out what the initial limit is supposed to be on group entry. This entails weeding out unwanted dormants, low-scored articles, fetch-old-headers verbiage, and so on." --- 10216,10246 ---- ;; buffer as a result of the new limit. (- total (length gnus-newsgroup-data)))) ! (defsubst gnus-cut-thread (thread) ! "Go forwards in the thread until we find an article that we want to display." ! (if (eq gnus-fetch-old-headers 'some) ! (while (and thread ! (memq (mail-header-number (car thread)) ! gnus-newsgroup-ancient) ! (<= (length (cdr thread)) 1)) ! (setq thread (cadr thread))) ! (while (and thread ! (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) ! (= (length (cdr thread)) 1)) ! (setq thread (cadr thread)))) ! thread) ! ! (defun gnus-cut-threads (threads) ! "Cut off all uninteresting articles from the beginning of threads." ! (when (or (eq gnus-fetch-old-headers 'some) ! (eq gnus-build-sparse-threads 'some)) ! (let ((th threads)) ! (while th ! (setcar th (gnus-cut-thread (car th))) ! (setq th (cdr th))))) ! threads) ! ! (defun gnus-summary-initial-limit (&optional show-if-empty) "Figure out what the initial limit is supposed to be on group entry. This entails weeding out unwanted dormants, low-scored articles, fetch-old-headers verbiage, and so on." *************** *** 10085,10090 **** --- 10249,10255 ---- (and (null gnus-newsgroup-dormant) (not (eq gnus-fetch-old-headers 'some)) (null gnus-summary-expunge-below) + (not (eq gnus-build-sparse-threads 'some)) (null gnus-thread-expunge-below))) () ; Do nothing. (push gnus-newsgroup-limit gnus-newsgroup-limits) *************** *** 10093,10107 **** (lambda (node) (unless (car (symbol-value node)) ;; These threads have no parents -- they are roots. ! (let ((nodes (cdr (symbol-value node)))) (while nodes (if (and gnus-thread-expunge-below (< (gnus-thread-total-score (car nodes)) gnus-thread-expunge-below)) (gnus-expunge-thread (pop nodes)) ! (gnus-summary-limit-children (pop nodes))))))) gnus-newsgroup-dependencies) ! (when (not gnus-newsgroup-limit) (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) gnus-newsgroup-limit)) --- 10258,10280 ---- (lambda (node) (unless (car (symbol-value node)) ;; These threads have no parents -- they are roots. ! (let ((nodes (cdr (symbol-value node))) ! thread) (while nodes (if (and gnus-thread-expunge-below (< (gnus-thread-total-score (car nodes)) gnus-thread-expunge-below)) (gnus-expunge-thread (pop nodes)) ! (setq thread (pop nodes)) ! ;(when (or (eq gnus-fetch-old-headers 'some) ! ; (eq gnus-build-sparse-threads 'some)) ! ; (setq thread (gnus-cut-thread thread))) ! (gnus-summary-limit-children thread)))))) gnus-newsgroup-dependencies) ! ;; If this limitation resulted in an empty group, we might ! ;; pop the previous limit and use it instead. ! (when (and (not gnus-newsgroup-limit) ! show-if-empty) (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) gnus-newsgroup-limit)) *************** *** 10111,10166 **** ;; is done by recursing down the thread using this function, so this ;; will really go down to a leaf article first, before slowly ;; working its way up towards the root. ! (let ((children ! (if (cdr thread) ! (apply '+ (mapcar 'gnus-summary-limit-children ! (cdr thread))) ! 0)) ! (number (mail-header-number (car thread))) ! score) ! (if (or ! ;; If this article is dormant and has absolutely no visible ! ;; children, then this article isn't visible. ! (and (memq number gnus-newsgroup-dormant) ! (= children 0)) ! ;; If this is a "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) ! (<= children 1)) ! ;; If we use expunging, and this article is really ! ;; low-scored, then we don't want this article. ! (when (and gnus-summary-expunge-below ! (< (setq score ! (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score)) ! gnus-summary-expunge-below)) ! ;; We increase the expunge-tally here, but that has ! ;; nothing to do with the limits, really. ! (incf gnus-newsgroup-expunged-tally) ! ;; We also mark as read here, if that's wanted. ! (when (and gnus-summary-mark-below ! (< score gnus-summary-mark-below)) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (push number gnus-newsgroup-expirable) ! (push (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))) ! t)) ! ;; Nope, invisible article. ! 0 ! ;; Ok, this article is to be visible, so we add it to the limit ! ;; and return 1. ! (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit)) ! 1))) (defun gnus-expunge-thread (thread) "Mark all articles in THREAD as read." (let* ((number (mail-header-number (car thread)))) (incf gnus-newsgroup-expunged-tally) ;; We also mark as read here, if that's wanted. ! (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire (push number gnus-newsgroup-expirable) --- 10284,10345 ---- ;; is done by recursing down the thread using this function, so this ;; will really go down to a leaf article first, before slowly ;; working its way up towards the root. ! (when thread ! (let ((children ! (if (cdr thread) ! (apply '+ (mapcar 'gnus-summary-limit-children ! (cdr thread))) ! 0)) ! (number (mail-header-number (car thread))) ! score) ! (if (or ! ;; If this article is dormant and has absolutely no visible ! ;; children, then this article isn't visible. ! (and (memq number gnus-newsgroup-dormant) ! (= children 0)) ! ;; If this is a "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 gnus-build-sparse-threads ! (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. ! (when (and gnus-summary-expunge-below ! (< (setq score ! (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score)) ! gnus-summary-expunge-below)) ! ;; We increase the expunge-tally here, but that has ! ;; nothing to do with the limits, really. ! (incf gnus-newsgroup-expunged-tally) ! ;; We also mark as read here, if that's wanted. ! (when (and gnus-summary-mark-below ! (< score gnus-summary-mark-below)) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (push number gnus-newsgroup-expirable) ! (push (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))) ! t)) ! ;; Nope, invisible article. ! 0 ! ;; Ok, this article is to be visible, so we add it to the limit ! ;; and return 1. ! (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit)) ! 1)))) (defun gnus-expunge-thread (thread) "Mark all articles in THREAD as read." (let* ((number (mail-header-number (car thread)))) (incf gnus-newsgroup-expunged-tally) ;; We also mark as read here, if that's wanted. ! (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire (push number gnus-newsgroup-expirable) *************** *** 10176,10203 **** The difference between N and the number of articles fetched is returned." (interactive "p") (gnus-set-global-variables) ! (while ! (and (> n 0) (let* ((header (gnus-summary-article-header)) ! (ref ;; If we try to find the parent of the currently ;; displayed article, then we take a look at the actual ;; References header, since this is slightly more ;; reliable than the References field we got from the ! ;; server. ! (if (and (eq (mail-header-number header) (cdr gnus-article-current)) ! (equal gnus-newsgroup-name (car gnus-article-current))) (save-excursion (set-buffer gnus-original-article-buffer) ! (gnus-narrow-to-headers) (prog1 (mail-fetch-field "references") (widen))) ;; It's not the current article, so we take a bet on ! ;; the value we got from the server. (mail-header-references header)))) (if ref (or (gnus-summary-refer-article (gnus-parent-id ref)) --- 10355,10382 ---- The difference between N and the number of articles fetched is returned." (interactive "p") (gnus-set-global-variables) ! (while ! (and (> n 0) (let* ((header (gnus-summary-article-header)) ! (ref ;; If we try to find the parent of the currently ;; displayed article, then we take a look at the actual ;; References header, since this is slightly more ;; reliable than the References field we got from the ! ;; server. ! (if (and (eq (mail-header-number header) (cdr gnus-article-current)) ! (equal gnus-newsgroup-name (car gnus-article-current))) (save-excursion (set-buffer gnus-original-article-buffer) ! (nnheader-narrow-to-headers) (prog1 (mail-fetch-field "references") (widen))) ;; It's not the current article, so we take a bet on ! ;; the value we got from the server. (mail-header-references header)))) (if ref (or (gnus-summary-refer-article (gnus-parent-id ref)) *************** *** 10221,10233 **** (while (string-match "<[^>]*>" ref) (incf n) ;; ... fetch that article. ! (gnus-summary-refer-article (prog1 (match-string 0 ref) (setq ref (substring ref (match-end 0)))))) (gnus-summary-goto-subject current) (gnus-summary-position-point) n)) ! (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") --- 10400,10412 ---- (while (string-match "<[^>]*>" ref) (incf n) ;; ... fetch that article. ! (gnus-summary-refer-article (prog1 (match-string 0 ref) (setq ref (substring ref (match-end 0)))))) (gnus-summary-goto-subject current) (gnus-summary-position-point) n)) ! (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") *************** *** 10259,10267 **** (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) ! (let ((name (format "%s-%d" ! (gnus-group-prefixed-name ! gnus-newsgroup-name (list 'nndoc "")) gnus-current-article)) (ogroup gnus-newsgroup-name) (buf (current-buffer))) --- 10438,10446 ---- (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) ! (let ((name (format "%s-%d" ! (gnus-group-prefixed-name ! gnus-newsgroup-name (list 'nndoc "")) gnus-current-article)) (ogroup gnus-newsgroup-name) (buf (current-buffer))) *************** *** 10271,10278 **** (search-forward "\n\n" nil t) (narrow-to-region (point) (point-max))) (unwind-protect ! (if (gnus-group-read-ephemeral-group ! name `(nndoc ,name (nndoc-address ,(get-buffer gnus-original-article-buffer)) (nndoc-article-type ,(if force 'digest 'guess))) t) ;; Make all postings to this group go to the parent group. --- 10450,10457 ---- (search-forward "\n\n" nil t) (narrow-to-region (point) (point-max))) (unwind-protect ! (if (gnus-group-read-ephemeral-group ! name `(nndoc ,name (nndoc-address ,(get-buffer gnus-original-article-buffer)) (nndoc-article-type ,(if force 'digest 'guess))) t) ;; Make all postings to this group go to the parent group. *************** *** 10293,10299 **** (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) ! (gnus-eval-in-buffer-window gnus-article-buffer (goto-char (point-min)) (isearch-forward regexp-p))) --- 10472,10479 ---- (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) ! (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window gnus-article-buffer (goto-char (point-min)) (isearch-forward regexp-p))) *************** *** 10314,10320 **** (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp)) (if (gnus-summary-search-article regexp backward) ! (gnus-article-set-window-start (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks))) (error "Search failed: \"%s\"" regexp))) --- 10494,10500 ---- (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp)) (if (gnus-summary-search-article regexp backward) ! (gnus-article-set-window-start (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks))) (error "Search failed: \"%s\"" regexp))) *************** *** 10355,10361 **** (setq found (funcall re-search regexp nil t)))) ;; Then search next articles. (while (and (not found) ! (gnus-summary-display-article (if backward (gnus-summary-find-prev) (gnus-summary-find-next)))) (gnus-message 9 "Searching article: %d..." gnus-current-article) --- 10535,10541 ---- (setq found (funcall re-search regexp nil t)))) ;; Then search next articles. (while (and (not found) ! (gnus-summary-display-article (if backward (gnus-summary-find-prev) (gnus-summary-find-next)))) (gnus-message 9 "Searching article: %d..." gnus-current-article) *************** *** 10381,10389 **** be taken into consideration. If NOT-CASE-FOLD, case won't be folded in the comparisons." (let ((data (if (eq backward 'all) gnus-newsgroup-data ! (gnus-data-find-list (gnus-summary-article-number) (gnus-data-list backward)))) ! (func (intern (concat "gnus-header-" header))) (case-fold-search (not not-case-fold)) articles d) (or (fboundp func) (error "%s is not a valid header" header)) --- 10561,10569 ---- be taken into consideration. If NOT-CASE-FOLD, case won't be folded in the comparisons." (let ((data (if (eq backward 'all) gnus-newsgroup-data ! (gnus-data-find-list (gnus-summary-article-number) (gnus-data-list backward)))) ! (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) articles d) (or (fboundp func) (error "%s is not a valid header" header)) *************** *** 10396,10409 **** (setq articles (cons (gnus-data-number d) articles))) ; Success! (setq data (cdr data))) (nreverse articles))) ! (defun gnus-summary-execute-command (header regexp command &optional backward) "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list (let ((completion-ignore-case t)) ! (completing-read "Header name: " (mapcar (lambda (string) (list string)) '("Number" "Subject" "From" "Lines" "Date" --- 10576,10589 ---- (setq articles (cons (gnus-data-number d) articles))) ; Success! (setq data (cdr data))) (nreverse articles))) ! (defun gnus-summary-execute-command (header regexp command &optional backward) "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list (let ((completion-ignore-case t)) ! (completing-read "Header name: " (mapcar (lambda (string) (list string)) '("Number" "Subject" "From" "Lines" "Date" *************** *** 10443,10449 **** (gnus-set-global-variables) (gnus-summary-select-article) (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-max)) --- 10623,10629 ---- (gnus-set-global-variables) (gnus-summary-select-article) (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-max)) *************** *** 10465,10471 **** gnus-article-prepare-hook gnus-visual) (gnus-summary-select-article nil 'force))) ! (gnus-configure-windows 'article) (gnus-summary-position-point)) (defun gnus-summary-verbose-headers (&optional arg) --- 10645,10651 ---- gnus-article-prepare-hook gnus-visual) (gnus-summary-select-article nil 'force))) ! ; (gnus-configure-windows 'article) (gnus-summary-position-point)) (defun gnus-summary-verbose-headers (&optional arg) *************** *** 10491,10498 **** (save-excursion (set-buffer gnus-article-buffer) (let* ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (hidden (text-property-any (goto-char (point-min)) (search-forward "\n\n") 'invisible t)) e) --- 10671,10678 ---- (save-excursion (set-buffer gnus-article-buffer) (let* ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (hidden (text-property-any (goto-char (point-min)) (search-forward "\n\n") 'invisible t)) e) *************** *** 10500,10506 **** (when (search-forward "\n\n" nil t) (delete-region (point-min) (1- (point)))) (goto-char (point-min)) ! (save-excursion (set-buffer gnus-original-article-buffer) (goto-char (point-min)) (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) --- 10680,10686 ---- (when (search-forward "\n\n" nil t) (delete-region (point-min) (1- (point)))) (goto-char (point-min)) ! (save-excursion (set-buffer gnus-original-article-buffer) (goto-char (point-min)) (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) *************** *** 10534,10540 **** (gnus-set-global-variables) (gnus-summary-select-article) (let ((mail-header-separator "")) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) --- 10714,10720 ---- (gnus-set-global-variables) (gnus-summary-select-article) (let ((mail-header-separator "")) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) *************** *** 10549,10657 **** (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen))) ! ;; Suggested by Brian Edmonds . ! ! (defun gnus-summary-move-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. If N is a negative number, move the N previous articles. If N is nil and any articles have been marked with the process mark, move those articles instead. ! If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' ! and `request-accept' functions. (Ie. mail newsgroups at present.)" ! (interactive "P") (gnus-set-global-variables) ! (unless (gnus-check-backend-function ! 'request-move-article gnus-newsgroup-name) ! (error "The current newsgroup does not support article moving")) (let ((articles (gnus-summary-work-articles n)) (prefix (gnus-group-real-prefix gnus-newsgroup-name)) ! art-group to-method sel-met) (when (and (not to-newsgroup) (not select-method)) ! (setq to-newsgroup ! (gnus-read-move-group-name ! "move" gnus-current-move-group articles prefix)) ! (setq gnus-current-move-group to-newsgroup)) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) ! (gnus-message 6 "Moving to %s: %s..." (or select-method to-newsgroup) articles) (while articles ! (if (setq art-group ! (gnus-request-move-article ! (car articles) ; Article to move ! gnus-newsgroup-name ; From newsgrouo ! (nth 1 (gnus-find-method-for-group ! gnus-newsgroup-name)) ; Server ! (list 'gnus-request-accept-article ! (if select-method ! (list 'quote select-method) ! to-newsgroup) ! (not (cdr articles))) ; Accept form ! (not (cdr articles)))) ; Only save nov last time ! (let* ((buffer-read-only nil) ! (entry ! (or ! (gnus-gethash (car art-group) gnus-newsrc-hashtb) ! (gnus-gethash ! (gnus-group-prefixed-name ! (car art-group) ! (if select-method (list select-method "") ! (gnus-find-method-for-group to-newsgroup))) ! gnus-newsrc-hashtb))) ! (info (nth 2 entry)) ! (article (car articles))) ! ;; Update the group that has been moved to. ! (if (not info) ! () ; This group does not exist yet. ! (unless (memq article gnus-newsgroup-unreads) ! (gnus-info-set-read ! info (gnus-add-to-range (gnus-info-read info) ! (list (cdr art-group))))) ! ! ;; Copy any marks over to the new group. ! (let ((marks '((tick . gnus-newsgroup-marked) ! (dormant . gnus-newsgroup-dormant) ! (expire . gnus-newsgroup-expirable) ! (bookmark . gnus-newsgroup-bookmarks) ! (save . gnus-newsgroup-saved) ! (reply . gnus-newsgroup-replied))) ! (to-article (cdr art-group))) ! ! ;; See whether the article is to be put in the cache. ! (when gnus-use-cache ! (gnus-cache-possibly-enter-article ! (gnus-info-group info) to-article ! (let ((header (copy-sequence ! (gnus-summary-article-header article)))) ! (mail-header-set-number header to-article) ! header) ! (memq article gnus-newsgroup-marked) ! (memq article gnus-newsgroup-dormant) ! (memq article gnus-newsgroup-unreads))) (while marks ! (if (memq article (symbol-value (cdr (car marks)))) ! (gnus-add-marked-articles ! (gnus-info-group info) (car (car marks)) ! (list to-article) info)) (setq marks (cdr marks))))) ! (gnus-summary-goto-subject article) ! (gnus-summary-mark-article article gnus-canceled-mark)) ! (gnus-message 1 "Couldn't move article %s" (car articles))) ! (gnus-summary-remove-process-mark (car articles)) ! (setq articles (cdr articles))) (gnus-set-mode-line 'summary))) (defun gnus-summary-respool-article (&optional n respool-method) "Respool the current article. The article will be squeezed through the mail spooling process again, --- 10729,10907 ---- (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen))) ! (defun gnus-summary-move-article (&optional n to-newsgroup select-method action) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. If N is a negative number, move the N previous articles. If N is nil and any articles have been marked with the process mark, move those articles instead. ! If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method. + For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' ! and `request-accept' functions." ! (interactive (list current-prefix-arg nil nil 'move)) (gnus-set-global-variables) ! ;; Check whether the source group supports the required functions. ! (cond ((and (eq action 'move) ! (gnus-check-backend-function ! 'request-move-article gnus-newsgroup-name)) ! (error "The current group does not support article moving")) ! ((and (eq action 'crosspost) ! (gnus-check-backend-function ! 'request-replace-article gnus-newsgroup-name)) ! (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) (prefix (gnus-group-real-prefix gnus-newsgroup-name)) ! (names '((move "move" "Moving") ! (copy "copy" "Copying") ! (crosspost "crosspost" "Crossposting"))) ! (copy-buf (save-excursion ! (nnheader-set-temp-buffer " *copy article*"))) ! art-group to-method new-xref article) ! (unless (assq action names) ! (error "Unknown action %s" action)) ! ;; Read the newsgroup name. (when (and (not to-newsgroup) (not select-method)) ! (setq to-newsgroup ! (gnus-read-move-group-name ! (cadr (assq action names)) ! gnus-current-move-group articles prefix)) ! (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) + ;; Check the method we are to move this article to... (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) ! (gnus-message 6 "%s to %s: %s..." ! (caddr (assq action names)) (or select-method to-newsgroup) articles) (while articles ! (setq article (pop articles)) ! (setq ! art-group ! (cond ! ;; Move the article. ! ((eq action 'move) ! (gnus-request-move-article ! article ; Article to move ! gnus-newsgroup-name ; From newsgrouo ! (nth 1 (gnus-find-method-for-group ! gnus-newsgroup-name)) ; Server ! (list 'gnus-request-accept-article ! (if select-method ! (list 'quote select-method) ! to-newsgroup) ! (not articles)) ; Accept form ! (not articles))) ; Only save nov last time ! ;; Copy the article. ! ((eq action 'copy) ! (save-excursion ! (set-buffer copy-buf) ! (gnus-request-article-this-buffer article gnus-newsgroup-name) ! (gnus-request-accept-article ! (if select-method select-method to-newsgroup) ! (not articles)))) ! ;; Crosspost the article. ! ((eq action 'crosspost) ! (let ((xref (mail-header-xref (gnus-summary-article-header article)))) ! (setq new-xref (concat gnus-newsgroup-name ":" article)) ! (if (and xref (not (string= xref ""))) ! (progn ! (when (string-match "^Xref: " xref) ! (setq xref (substring xref (match-end 0)))) ! (setq new-xref (concat xref " " new-xref))) ! (setq new-xref (concat (system-name) " " new-xref))) ! (save-excursion ! (set-buffer copy-buf) ! (gnus-request-article-this-buffer article gnus-newsgroup-name) ! (nnheader-replace-header "xref" new-xref) ! (gnus-request-accept-article ! (if select-method select-method to-newsgroup) ! (not articles))))))) ! (if (not art-group) ! (gnus-message 1 "Couldn't %s article %s" ! (cadr (assq action names)) article) ! (let* ((entry ! (or ! (gnus-gethash (car art-group) gnus-newsrc-hashtb) ! (gnus-gethash ! (gnus-group-prefixed-name ! (car art-group) ! (if select-method (list select-method "") ! (gnus-find-method-for-group to-newsgroup))) ! gnus-newsrc-hashtb))) ! (info (nth 2 entry))) ! ;; Update the group that has been moved to. ! (when (and info ! (memq action '(move copy))) ! (unless (memq article gnus-newsgroup-unreads) ! (gnus-info-set-read ! info (gnus-add-to-range (gnus-info-read info) ! (list (cdr art-group))))) ! ! ;; Copy any marks over to the new group. ! (let ((marks gnus-article-mark-lists) ! (to-article (cdr art-group))) ! ! ;; See whether the article is to be put in the cache. ! (when gnus-use-cache ! (gnus-cache-possibly-enter-article ! (gnus-info-group info) to-article ! (let ((header (copy-sequence ! (gnus-summary-article-header article)))) ! (mail-header-set-number header to-article) ! header) ! (memq article gnus-newsgroup-marked) ! (memq article gnus-newsgroup-dormant) ! (memq article gnus-newsgroup-unreads))) (while marks ! (when (memq article (symbol-value ! (intern (format "gnus-newsgroup-%s" ! (caar marks))))) ! (gnus-add-marked-articles ! (gnus-info-group info) (cadr marks) ! (list to-article) info)) (setq marks (cdr marks))))) ! ! ;; Update the Xref header in this article to point to ! ;; the new crossposted article we have just created. ! (when (eq action 'crosspost) ! (save-excursion ! (set-buffer copy-buf) ! (gnus-request-article-this-buffer article gnus-newsgroup-name) ! (nnheader-replace-header ! "xref" (concat new-xref " " (gnus-group-prefixed-name ! (car art-group) to-method) ! ":" (cdr art-group))) ! (gnus-request-replace-article ! article gnus-newsgroup-name (current-buffer))))) ! ! (gnus-summary-goto-subject article) ! (gnus-summary-mark-article article gnus-canceled-mark)) ! (gnus-summary-remove-process-mark (car articles))) ! (gnus-kill-buffer copy-buf) (gnus-set-mode-line 'summary))) + (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) + "Move the current article to a different newsgroup. + If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. + If SELECT-METHOD is symbol, do not move to a specific newsgroup, but + re-spool using this method." + (interactive "P") + (gnus-summary-move-article n nil nil 'copy)) + + (defun gnus-summary-crosspost-article (&optional n) + "Crosspost the current article to some other group." + (interactive "P") + (gnus-summary-move-article n nil nil 'crosspost)) + (defun gnus-summary-respool-article (&optional n respool-method) "Respool the current article. The article will be squeezed through the mail spooling process again, *************** *** 10669,10675 **** (interactive "P") (gnus-set-global-variables) (let ((respool-methods (gnus-methods-using 'respool)) ! (methname (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name))))) (or respool-method (setq respool-method --- 10919,10925 ---- (interactive "P") (gnus-set-global-variables) (let ((respool-methods (gnus-methods-using 'respool)) ! (methname (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name))))) (or respool-method (setq respool-method *************** *** 10683,10787 **** (gnus-summary-move-article n nil (intern respool-method)) (gnus-summary-copy-article n nil (intern respool-method)))))) - ;; Suggested by gregj@unidata.com (Gregory J. Grubbs). - (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) - "Move the current article to a different newsgroup. - If N is a positive number, move the N next articles. - If N is a negative number, move the N previous articles. - If N is nil and any articles have been marked with the process mark, - move those articles instead. - If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. - If SELECT-METHOD is symbol, do not move to a specific newsgroup, but - re-spool using this method. - For this function to work, the newsgroup that you want to move to have - to support the `request-move' and `request-accept' - functions. (Ie. mail newsgroups at present.)" - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles n)) - (copy-buf (get-buffer-create "*copy work*")) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) - art-group to-method) - (buffer-disable-undo copy-buf) - (when (and (not to-newsgroup) - (not select-method)) - (setq to-newsgroup - (gnus-read-move-group-name - "copy" gnus-current-move-group articles prefix)) - (setq gnus-current-move-group to-newsgroup)) - (setq to-method (if select-method (list select-method "") - (gnus-find-method-for-group to-newsgroup))) - (or (gnus-check-backend-function 'request-accept-article (car to-method)) - (error "%s does not support article copying" (car to-method))) - (or (gnus-check-server to-method) - (error "Can't open server %s" (car to-method))) - (while articles - (gnus-message 6 "Copying to %s: %s..." - (or select-method to-newsgroup) articles) - (if (setq art-group - (save-excursion - (set-buffer copy-buf) - (gnus-request-article-this-buffer - (car articles) gnus-newsgroup-name) - (gnus-request-accept-article - (if select-method select-method to-newsgroup) - (not (cdr articles))))) - (let* ((entry - (or - (gnus-gethash (car art-group) gnus-newsrc-hashtb) - (gnus-gethash - (gnus-group-prefixed-name - (car art-group) - (if select-method (list select-method "") - (gnus-find-method-for-group to-newsgroup))) - gnus-newsrc-hashtb))) - (info (nth 2 entry)) - (article (car articles))) - ;; We copy the info over to the new group. - (if (not info) - () ; This group does not exist (yet). - (if (not (memq article gnus-newsgroup-unreads)) - (gnus-info-set-read - info (gnus-add-to-range (gnus-info-read info) - (list (cdr art-group))))) - - ;; Copy any marks over to the new group. - (let ((marks '((tick . gnus-newsgroup-marked) - (dormant . gnus-newsgroup-dormant) - (expire . gnus-newsgroup-expirable) - (bookmark . gnus-newsgroup-bookmarks) - (save . gnus-newsgroup-saved) - (reply . gnus-newsgroup-replied))) - (to-article (cdr art-group))) - - ;; See whether the article is to be put in the cache. - (when gnus-use-cache - (gnus-cache-possibly-enter-article - (gnus-info-group info) to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))) - - (while marks - (if (memq article (symbol-value (cdr (car marks)))) - (gnus-add-marked-articles - (gnus-info-group info) (car (car marks)) - (list to-article) info)) - (setq marks (cdr marks)))))) - (gnus-message 1 "Couldn't copy article %s" (car articles))) - (gnus-summary-remove-process-mark (car articles)) - (setq articles (cdr articles))) - (kill-buffer copy-buf))) - (defun gnus-summary-import-article (file) "Import a random file into a mail newsgroup." (interactive "fImport file: ") (gnus-set-global-variables) (let ((group gnus-newsgroup-name) atts lines) (or (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) --- 10933,10944 ---- (gnus-summary-move-article n nil (intern respool-method)) (gnus-summary-copy-article n nil (intern respool-method)))))) (defun gnus-summary-import-article (file) "Import a random file into a mail newsgroup." (interactive "fImport file: ") (gnus-set-global-variables) (let ((group gnus-newsgroup-name) + (now (current-time)) atts lines) (or (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) *************** *** 10794,10806 **** (erase-buffer) (insert-file-contents file) (goto-char (point-min)) ! (if (nnheader-article-p) ! () (setq atts (file-attributes file) lines (count-lines (point-min) (point-max))) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" ! "Date: " (current-time-string (nth 5 atts)) "\n" "Message-ID: " (gnus-inews-message-id) "\n" "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) --- 10951,10966 ---- (erase-buffer) (insert-file-contents file) (goto-char (point-min)) ! (unless (nnheader-article-p) ! ;; This doesn't look like an article, so we fudge some headers. (setq atts (file-attributes file) lines (count-lines (point-min) (point-max))) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" ! "Date: " (timezone-make-date-arpa-standard ! (current-time-string (nth 5 atts)) ! (current-time-zone now) ! (current-time-zone now)) "\n" "Message-ID: " (gnus-inews-message-id) "\n" "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) *************** *** 10811,10817 **** "Expire all articles that are marked as expirable in the current group." (interactive) (gnus-set-global-variables) ! (when (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) ;; This backend supports expiry. (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) --- 10971,10977 ---- "Expire all articles that are marked as expirable in the current group." (interactive) (gnus-set-global-variables) ! (when (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) ;; This backend supports expiry. (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) *************** *** 10819,10825 **** (gnus-list-of-read-articles gnus-newsgroup-name) (setq gnus-newsgroup-expirable (sort gnus-newsgroup-expirable '<)))) ! (expiry-wait (gnus-group-get-parameter gnus-newsgroup-name 'expiry-wait)) es) (when expirable --- 10979,10985 ---- (gnus-list-of-read-articles gnus-newsgroup-name) (setq gnus-newsgroup-expirable (sort gnus-newsgroup-expirable '<)))) ! (expiry-wait (gnus-group-get-parameter gnus-newsgroup-name 'expiry-wait)) es) (when expirable *************** *** 10864,10896 **** ;; Suggested by Jack Vinson . (defun gnus-summary-delete-article (&optional n) "Delete the N next (mail) articles. ! This command actually deletes articles. This is not a marking command. The article will disappear forever from your life, never to ! return. If N is negative, delete backwards. If N is nil and articles have been marked with the process mark, delete these instead." (interactive "P") (gnus-set-global-variables) ! (or (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion.")) ;; Compute the list of articles to delete. (let ((articles (gnus-summary-work-articles n)) not-deleted) (if (and gnus-novice-user ! (not (gnus-y-or-n-p (format "Do you really want to delete %s forever? " (if (> (length articles) 1) "these articles" "this article"))))) () ;; Delete the articles. ! (setq not-deleted (gnus-request-expire-articles articles gnus-newsgroup-name 'force)) (while articles ! (gnus-summary-remove-process-mark (car articles)) ;; The backend might not have been able to delete the article ! ;; after all. (or (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (setq articles (cdr articles)))) --- 11024,11056 ---- ;; Suggested by Jack Vinson . (defun gnus-summary-delete-article (&optional n) "Delete the N next (mail) articles. ! This command actually deletes articles. This is not a marking command. The article will disappear forever from your life, never to ! return. If N is negative, delete backwards. If N is nil and articles have been marked with the process mark, delete these instead." (interactive "P") (gnus-set-global-variables) ! (or (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion.")) ;; Compute the list of articles to delete. (let ((articles (gnus-summary-work-articles n)) not-deleted) (if (and gnus-novice-user ! (not (gnus-y-or-n-p (format "Do you really want to delete %s forever? " (if (> (length articles) 1) "these articles" "this article"))))) () ;; Delete the articles. ! (setq not-deleted (gnus-request-expire-articles articles gnus-newsgroup-name 'force)) (while articles ! (gnus-summary-remove-process-mark (car articles)) ;; The backend might not have been able to delete the article ! ;; after all. (or (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (setq articles (cdr articles)))) *************** *** 10927,10947 **** (if (gnus-group-read-only-p) (progn (gnus-summary-edit-article-postpone) ! (gnus-message 1 "The current newsgroup does not support article editing.") (ding)) (let ((buf (buffer-substring-no-properties (point-min) (point-max)))) (erase-buffer) (insert buf) ! (if (not (gnus-request-replace-article ! (cdr gnus-article-current) (car gnus-article-current) (current-buffer))) (error "Couldn't replace article.") (gnus-article-mode) (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary)) (and (gnus-visual-p 'summary-highlight 'highlight) (run-hooks 'gnus-visual-mark-article-hook))))) --- 11087,11108 ---- (if (gnus-group-read-only-p) (progn (gnus-summary-edit-article-postpone) ! (gnus-message 1 "The current newsgroup does not support article editing.") (ding)) (let ((buf (buffer-substring-no-properties (point-min) (point-max)))) (erase-buffer) (insert buf) ! (if (not (gnus-request-replace-article ! (cdr gnus-article-current) (car gnus-article-current) (current-buffer))) (error "Couldn't replace article.") (gnus-article-mode) (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary) ! (gnus-summary-update-article (cdr gnus-article-current))) (and (gnus-visual-p 'summary-highlight 'highlight) (run-hooks 'gnus-visual-mark-article-hook))))) *************** *** 10990,11001 **** ;; Set score. (gnus-summary-update-mark (if (= n (or gnus-summary-default-score 0)) ? ! (if (< n (or gnus-summary-default-score 0)) gnus-score-below-mark gnus-score-over-mark)) 'score)) (let* ((article (gnus-summary-article-number)) (score (assq article gnus-newsgroup-scored))) (if score (setcdr score n) ! (setq gnus-newsgroup-scored (cons (cons article n) gnus-newsgroup-scored)))) (gnus-summary-update-line))) --- 11151,11162 ---- ;; Set score. (gnus-summary-update-mark (if (= n (or gnus-summary-default-score 0)) ? ! (if (< n (or gnus-summary-default-score 0)) gnus-score-below-mark gnus-score-over-mark)) 'score)) (let* ((article (gnus-summary-article-number)) (score (assq article gnus-newsgroup-scored))) (if score (setcdr score n) ! (setq gnus-newsgroup-scored (cons (cons article n) gnus-newsgroup-scored)))) (gnus-summary-update-line))) *************** *** 11027,11033 **** (if unmark "unread" "read")))) (defun gnus-summary-kill-same-subject (&optional unmark) ! "Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") --- 11188,11194 ---- (if unmark "unread" "read")))) (defun gnus-summary-kill-same-subject (&optional unmark) ! "Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") *************** *** 11050,11058 **** If optional argument UNMARK is negative, mark articles as unread instead." (let ((count 1)) (save-excursion ! (cond ((null unmark) ; Mark as read. ! (while (and (progn (gnus-summary-mark-article-as-read gnus-killed-mark) (gnus-summary-show-thread) t) --- 11211,11219 ---- If optional argument UNMARK is negative, mark articles as unread instead." (let ((count 1)) (save-excursion ! (cond ((null unmark) ; Mark as read. ! (while (and (progn (gnus-summary-mark-article-as-read gnus-killed-mark) (gnus-summary-show-thread) t) *************** *** 11085,11091 **** (gnus-set-global-variables) (let ((backward (< n 0)) (n (abs n))) ! (while (and (> n 0) (if unmark (gnus-summary-remove-process-mark --- 11246,11252 ---- (gnus-set-global-variables) (let ((backward (< n 0)) (n (abs n))) ! (while (and (> n 0) (if unmark (gnus-summary-remove-process-mark *************** *** 11141,11153 **** (error "No current article selected")) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)))) ! ;; Set the new bookmark, which is on the form ;; (article-number . line-number-in-body). ! (setq gnus-newsgroup-bookmarks ! (cons ! (cons article (save-excursion (set-buffer gnus-article-buffer) (count-lines --- 11302,11314 ---- (error "No current article selected")) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)))) ! ;; Set the new bookmark, which is on the form ;; (article-number . line-number-in-body). ! (setq gnus-newsgroup-bookmarks ! (cons ! (cons article (save-excursion (set-buffer gnus-article-buffer) (count-lines *************** *** 11166,11174 **** (gnus-set-global-variables) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (progn ! (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)) (gnus-message 6 "Removed bookmark.")) (gnus-message 6 "No bookmark in current article.")))) --- 11327,11335 ---- (gnus-set-global-variables) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (progn ! (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)) (gnus-message 6 "Removed bookmark.")) (gnus-message 6 "No bookmark in current article.")))) *************** *** 11184,11191 **** (defun gnus-summary-set-process-mark (article) "Set the process mark on ARTICLE and update the summary line." ! (setq gnus-newsgroup-processable ! (cons article (delq article gnus-newsgroup-processable))) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) --- 11345,11352 ---- (defun gnus-summary-set-process-mark (article) "Set the process mark on ARTICLE and update the summary line." ! (setq gnus-newsgroup-processable ! (cons article (delq article gnus-newsgroup-processable))) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) *************** *** 11207,11214 **** (defun gnus-summary-mark-forward (n &optional mark no-expire) "Mark N articles as read forwards. If N is negative, mark backwards instead. ! Mark with MARK. If MARK is ? , ?! or ??, articles will be ! marked as unread. The difference between N and the actual number of articles marked is returned." (interactive "p") --- 11368,11375 ---- (defun gnus-summary-mark-forward (n &optional mark no-expire) "Mark N articles as read forwards. If N is negative, mark backwards instead. ! Mark with MARK. If MARK is ? , ?! or ??, articles will be ! marked as unread. The difference between N and the actual number of articles marked is returned." (interactive "p") *************** *** 11216,11229 **** (let ((backward (< n 0)) (gnus-summary-goto-unread (and gnus-summary-goto-unread (not (memq mark (list gnus-unread-mark gnus-ticked-mark gnus-dormant-mark))))) (n (abs n)) (mark (or mark gnus-del-mark))) (while (and (> n 0) (gnus-summary-mark-article nil mark no-expire) ! (zerop (gnus-summary-next-subject ! (if backward -1 1) gnus-summary-goto-unread t))) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) (gnus-summary-recenter) --- 11377,11394 ---- (let ((backward (< n 0)) (gnus-summary-goto-unread (and gnus-summary-goto-unread + (not (eq gnus-summary-goto-unread 'never)) (not (memq mark (list gnus-unread-mark gnus-ticked-mark gnus-dormant-mark))))) (n (abs n)) (mark (or mark gnus-del-mark))) (while (and (> n 0) (gnus-summary-mark-article nil mark no-expire) ! (zerop (gnus-summary-next-subject ! (if backward -1 1) ! (and gnus-summary-goto-unread ! (not (eq gnus-summary-goto-unread 'never))) ! t))) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) (gnus-summary-recenter) *************** *** 11239,11255 **** (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-reads (cons (cons article mark) gnus-newsgroup-reads)) ! ;; Possibly remove from cache, if that is used. (and gnus-use-cache (gnus-cache-enter-remove-article article)) ! (and gnus-newsgroup-auto-expire ! (or (= mark gnus-killed-mark) (= mark gnus-del-mark) ! (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark)) ! (progn ! (setq mark gnus-expirable-mark) ! (setq gnus-newsgroup-expirable ! (cons article gnus-newsgroup-expirable)))) ! ;; Fix the mark. (gnus-summary-update-mark mark 'unread) t)) --- 11404,11422 ---- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-reads (cons (cons article mark) gnus-newsgroup-reads)) ! ;; Possibly remove from cache, if that is used. (and gnus-use-cache (gnus-cache-enter-remove-article article)) ! ;; Allow the backend to change the mark. ! (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) ! ;; Check for auto-expiry. ! (when (and gnus-newsgroup-auto-expire ! (or (= mark gnus-killed-mark) (= mark gnus-del-mark) ! (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-ancient-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark))) ! (setq mark gnus-expirable-mark) ! (push article gnus-newsgroup-expirable)) ! ;; Set the mark in the buffer. (gnus-summary-update-mark mark 'unread) t)) *************** *** 11264,11270 **** (push article gnus-newsgroup-marked)) ((= mark gnus-dormant-mark) (push article gnus-newsgroup-dormant)) ! (t (push article gnus-newsgroup-unreads))) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) --- 11431,11437 ---- (push article gnus-newsgroup-marked)) ((= mark gnus-dormant-mark) (push article gnus-newsgroup-dormant)) ! (t (push article gnus-newsgroup-unreads))) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) *************** *** 11274,11281 **** (and gnus-use-cache (vectorp (gnus-summary-article-header article)) (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) --- 11441,11448 ---- (and gnus-use-cache (vectorp (gnus-summary-article-header article)) (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) *************** *** 11286,11304 **** (defun gnus-summary-mark-article (&optional article mark no-expire) "Mark ARTICLE with MARK. MARK can be any character. ! Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?D' is used. If ARTICLE is nil, then the article on the current line will be ! marked." ;; The mark might be a string. (and (stringp mark) (setq mark (aref mark 0))) ;; If no mark is given, then we check auto-expiring. (and (not no-expire) ! gnus-newsgroup-auto-expire (or (not mark) ! (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-read-mark) (= mark gnus-souped-mark)))) --- 11453,11471 ---- (defun gnus-summary-mark-article (&optional article mark no-expire) "Mark ARTICLE with MARK. MARK can be any character. ! Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?D' is used. If ARTICLE is nil, then the article on the current line will be ! marked." ;; The mark might be a string. (and (stringp mark) (setq mark (aref mark 0))) ;; If no mark is given, then we check auto-expiring. (and (not no-expire) ! gnus-newsgroup-auto-expire (or (not mark) ! (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-read-mark) (= mark gnus-souped-mark)))) *************** *** 11306,11313 **** (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) (or article (error "No article on current line")) ! (if (or (= mark gnus-unread-mark) ! (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) (gnus-mark-article-as-read article mark)) --- 11473,11480 ---- (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) (or article (error "No article on current line")) ! (if (or (= mark gnus-unread-mark) ! (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) (gnus-mark-article-as-read article mark)) *************** *** 11317,11324 **** (not (= mark gnus-canceled-mark)) (vectorp (gnus-summary-article-header article)) (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) --- 11484,11491 ---- (not (= mark gnus-canceled-mark)) (vectorp (gnus-summary-article-header article)) (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) *************** *** 11358,11367 **** (subst-char-in-region (point) (1+ (point)) (following-char) mark) ;; Optionally update the marks by some user rule. (when (eq type 'unread) ! (gnus-data-set-mark (gnus-data-find (gnus-summary-article-number)) mark) (gnus-summary-update-line (eq mark gnus-unread-mark)))))) ! (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." ;; Make the article expirable. --- 11525,11534 ---- (subst-char-in-region (point) (1+ (point)) (following-char) mark) ;; Optionally update the marks by some user rule. (when (eq type 'unread) ! (gnus-data-set-mark (gnus-data-find (gnus-summary-article-number)) mark) (gnus-summary-update-line (eq mark gnus-unread-mark)))))) ! (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." ;; Make the article expirable. *************** *** 11374,11381 **** (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ! ;; Possibly remove from cache, if that is used. ! (when gnus-use-cache (gnus-cache-enter-remove-article article)))) (defun gnus-mark-article-as-unread (article &optional mark) --- 11541,11548 ---- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ! ;; Possibly remove from cache, if that is used. ! (when gnus-use-cache (gnus-cache-enter-remove-article article)))) (defun gnus-mark-article-as-unread (article &optional mark) *************** *** 11389,11403 **** (push article gnus-newsgroup-marked)) ((= mark gnus-dormant-mark) (push article gnus-newsgroup-dormant)) ! (t (push article gnus-newsgroup-unreads))) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) gnus-newsgroup-reads)))) ! (defalias 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) ! (make-obsolete 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) (defun gnus-summary-tick-article-forward (n) "Tick N articles forwards. --- 11556,11570 ---- (push article gnus-newsgroup-marked)) ((= mark gnus-dormant-mark) (push article gnus-newsgroup-dormant)) ! (t (push article gnus-newsgroup-unreads))) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) gnus-newsgroup-reads)))) ! (defalias 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) ! (make-obsolete 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) (defun gnus-summary-tick-article-forward (n) "Tick N articles forwards. *************** *** 11406,11414 **** (interactive "p") (gnus-summary-mark-forward n gnus-ticked-mark)) ! (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) ! (make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) (defun gnus-summary-tick-article-backward (n) "Tick N articles backwards. --- 11573,11581 ---- (interactive "p") (gnus-summary-mark-forward n gnus-ticked-mark)) ! (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) ! (make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) (defun gnus-summary-tick-article-backward (n) "Tick N articles backwards. *************** *** 11473,11482 **** (let (article) (goto-char point) (beginning-of-line) ! (while (and (< (point) mark) (progn ! (when (or all (memq (setq article (gnus-summary-article-number)) gnus-newsgroup-unreads)) (gnus-summary-mark-article article gnus-del-mark)) --- 11640,11649 ---- (let (article) (goto-char point) (beginning-of-line) ! (while (and (< (point) mark) (progn ! (when (or all (memq (setq article (gnus-summary-article-number)) gnus-newsgroup-unreads)) (gnus-summary-mark-article article gnus-del-mark)) *************** *** 11532,11538 **** t) (gnus-summary-find-next))))) ! ;; Suggested by Daniel Quinlan . (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) (defun gnus-summary-limit-include-expunged () "Display all the hidden articles that were expunged for low scores." --- 11699,11705 ---- t) (gnus-summary-find-next))))) ! ;; Suggested by Daniel Quinlan . (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) (defun gnus-summary-limit-include-expunged () "Display all the hidden articles that were expunged for low scores." *************** *** 11570,11576 **** (if all "Mark absolutely all articles as read? " "Mark all unread articles as read? "))) ! (if (and not-mark (not gnus-newsgroup-adaptive) (not gnus-newsgroup-auto-expire)) (progn --- 11737,11743 ---- (if all "Mark absolutely all articles as read? " "Mark all unread articles as read? "))) ! (if (and not-mark (not gnus-newsgroup-adaptive) (not gnus-newsgroup-auto-expire)) (progn *************** *** 11579,11588 **** gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads nil)) ;; We actually mark all articles as canceled, which we ! ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) (if (gnus-summary-first-subject (not all)) ! (while (and (if to-here (< (point) to-here) t) (gnus-summary-mark-article-as-read gnus-catchup-mark) (gnus-summary-find-next (not all))))) --- 11746,11755 ---- gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads nil)) ;; We actually mark all articles as canceled, which we ! ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) (if (gnus-summary-first-subject (not all)) ! (while (and (if to-here (< (point) to-here) t) (gnus-summary-mark-article-as-read gnus-catchup-mark) (gnus-summary-find-next (not all))))) *************** *** 11634,11640 **** (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as ! read." (interactive "P") (gnus-set-global-variables) (save-excursion --- 11801,11807 ---- (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as ! read." (interactive "P") (gnus-set-global-variables) (save-excursion *************** *** 11650,11656 **** (let* ((article (or article (gnus-summary-article-number))) (data (gnus-data-find-list article)) (top-level (gnus-data-level (car data))) ! (top-subject (cond ((null gnus-thread-operation-ignore-subject) (gnus-simplify-subject-re (mail-header-subject (gnus-data-header (car data))))) --- 11817,11823 ---- (let* ((article (or article (gnus-summary-article-number))) (data (gnus-data-find-list article)) (top-level (gnus-data-level (car data))) ! (top-subject (cond ((null gnus-thread-operation-ignore-subject) (gnus-simplify-subject-re (mail-header-subject (gnus-data-header (car data))))) *************** *** 11666,11675 **** (string= top-subject (if (eq gnus-thread-operation-ignore-subject 'fuzzy) (gnus-simplify-subject-fuzzy ! (mail-header-subject (gnus-data-header (car data)))) (gnus-simplify-subject-re ! (mail-header-subject (gnus-data-header (car data))))))) (setq articles (cons (gnus-data-number (car data)) articles))) (if (and (setq data (cdr data)) --- 11833,11842 ---- (string= top-subject (if (eq gnus-thread-operation-ignore-subject 'fuzzy) (gnus-simplify-subject-fuzzy ! (mail-header-subject (gnus-data-header (car data)))) (gnus-simplify-subject-re ! (mail-header-subject (gnus-data-header (car data))))))) (setq articles (cons (gnus-data-number (car data)) articles))) (if (and (setq data (cdr data)) *************** *** 11752,11762 **** (article (gnus-summary-article-number)) end) ;; Go forward until either the buffer ends or the subthread ! ;; ends. (when (and (not (eobp)) (or (and (zerop (gnus-summary-next-thread 1 t)) (gnus-summary-find-prev)) ! (goto-char (gnus-data-pos (car (gnus-data-list 'rev)))))) (setq end (point)) (prog1 (if (and (> (point) start) --- 11919,11929 ---- (article (gnus-summary-article-number)) end) ;; Go forward until either the buffer ends or the subthread ! ;; ends. (when (and (not (eobp)) (or (and (zerop (gnus-summary-next-thread 1 t)) (gnus-summary-find-prev)) ! (goto-char (gnus-data-pos (car (gnus-data-list 'rev)))))) (setq end (point)) (prog1 (if (and (> (point) start) *************** *** 11781,11787 **** (setq oart (gnus-data-number (car data)) data nil) (setq data (cdr data)))) ! (and oart (gnus-summary-goto-subject oart)))) (defun gnus-summary-next-thread (n &optional silent) --- 11948,11954 ---- (setq oart (gnus-data-number (car data)) data nil) (setq data (cdr data)))) ! (and oart (gnus-summary-goto-subject oart)))) (defun gnus-summary-next-thread (n &optional silent) *************** *** 11794,11802 **** (interactive "p") (gnus-set-global-variables) (let ((backward (< n 0)) ! (n (abs n))) (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) (decf n)) (gnus-summary-position-point) (when (and (not silent) (/= 0 n)) --- 11961,11975 ---- (interactive "p") (gnus-set-global-variables) (let ((backward (< n 0)) ! (n (abs n)) ! old dum) (while (and (> n 0) + (setq old (save-excursion (forward-line 1) (point))) (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)) (decf n)) (gnus-summary-position-point) (when (and (not silent) (/= 0 n)) *************** *** 11849,11854 **** --- 12022,12034 ---- (gnus-set-global-variables) (gnus-summary-down-thread (- n))) + (defun gnus-summary-top-thread () + "Go to the top of the thread." + (interactive) + (gnus-set-global-variables) + (while (gnus-summary-go-up-thread)) + (gnus-summary-article-number)) + (defun gnus-summary-kill-thread (&optional unmark) "Mark articles under current thread as read. If the prefix argument is positive, remove any kinds of marks. *************** *** 11864,11874 **** ;; Mark all the articles. (while articles (gnus-summary-goto-subject (car articles)) ! (cond ((null unmark) (gnus-summary-mark-article-as-read gnus-killed-mark)) ! ((> unmark 0) (gnus-summary-mark-article-as-unread gnus-unread-mark)) ! (t (gnus-summary-mark-article-as-unread gnus-ticked-mark))) (setq articles (cdr articles)))) ;; Hide killed subtrees. --- 12044,12054 ---- ;; Mark all the articles. (while articles (gnus-summary-goto-subject (car articles)) ! (cond ((null unmark) (gnus-summary-mark-article-as-read gnus-killed-mark)) ! ((> unmark 0) (gnus-summary-mark-article-as-unread gnus-unread-mark)) ! (t (gnus-summary-mark-article-as-unread gnus-ticked-mark))) (setq articles (cdr articles)))) ;; Hide killed subtrees. *************** *** 11918,11924 **** (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." (gnus-set-global-variables) ! (let* ((gnus-thread-sort-functions (list (intern (format "gnus-thread-sort-by-%s" predicate)))) (gnus-article-sort-functions (list (intern (format "gnus-article-sort-by-%s" predicate)))) --- 12098,12104 ---- (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." (gnus-set-global-variables) ! (let* ((gnus-thread-sort-functions (list (intern (format "gnus-thread-sort-by-%s" predicate)))) (gnus-article-sort-functions (list (intern (format "gnus-article-sort-by-%s" predicate)))) *************** *** 11931,11939 **** (gnus-summary-hide-all-threads))) ;; If in async mode, we send some info to the backend. (when gnus-newsgroup-async ! (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))) ! (defun gnus-sortable-date (date) "Make sortable string by string-lessp from DATE. Timezone package is used." --- 12111,12119 ---- (gnus-summary-hide-all-threads))) ;; If in async mode, we send some info to the backend. (when gnus-newsgroup-async ! (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))) ! (defun gnus-sortable-date (date) "Make sortable string by string-lessp from DATE. Timezone package is used." *************** *** 11941,11948 **** (year (aref date 0)) (month (aref date 1)) (day (aref date 2))) ! (timezone-make-sortable-date ! year month day (timezone-make-time-string (aref date 3) (aref date 4) (aref date 5))))) --- 12121,12128 ---- (year (aref date 0)) (month (aref date 1)) (day (aref date 2))) ! (timezone-make-sortable-date ! year month day (timezone-make-time-string (aref date 3) (aref date 4) (aref date 5))))) *************** *** 11973,11979 **** (gnus-summary-select-article t nil nil article)) (unless gnus-save-all-headers ;; Remove headers accoring to `gnus-saved-headers'. ! (let ((gnus-visible-headers (or gnus-saved-headers gnus-visible-headers))) (gnus-article-hide-headers nil t))) ;; Remove any X-Gnus lines. --- 12153,12159 ---- (gnus-summary-select-article t nil nil article)) (unless gnus-save-all-headers ;; Remove headers accoring to `gnus-saved-headers'. ! (let ((gnus-visible-headers (or gnus-saved-headers gnus-visible-headers))) (gnus-article-hide-headers nil t))) ;; Remove any X-Gnus lines. *************** *** 11981,11987 **** (set-buffer gnus-article-buffer) (save-restriction (let ((buffer-read-only nil)) ! (gnus-narrow-to-headers) (while (re-search-forward "^X-Gnus" nil t) (gnus-delete-line))))) (save-window-excursion --- 12161,12167 ---- (set-buffer gnus-article-buffer) (save-restriction (let ((buffer-read-only nil)) ! (nnheader-narrow-to-headers) (while (re-search-forward "^X-Gnus" nil t) (gnus-delete-line))))) (save-window-excursion *************** *** 12064,12070 **** (save-excursion (set-buffer gnus-original-article-buffer) (save-restriction ! (gnus-narrow-to-headers) (while methods (goto-char (point-min)) (setq method (pop methods)) --- 12244,12250 ---- (save-excursion (set-buffer gnus-original-article-buffer) (save-restriction ! (nnheader-narrow-to-headers) (while methods (goto-char (point-min)) (setq method (pop methods)) *************** *** 12072,12085 **** (when (cond ((stringp match) ;; Regular expression. ! (condition-case () (re-search-forward match nil t) (error nil))) ((gnus-functionp match) (save-restriction (widen) (setq result (funcall match gnus-newsgroup-name)))) ((consp match) (save-restriction (widen) (setq result (eval match))))) --- 12252,12267 ---- (when (cond ((stringp match) ;; Regular expression. ! (condition-case () (re-search-forward match nil t) (error nil))) ((gnus-functionp match) + ;; Function. (save-restriction (widen) (setq result (funcall match gnus-newsgroup-name)))) ((consp match) + ;; Form. (save-restriction (widen) (setq result (eval match))))) *************** *** 12102,12122 **** (to-newsgroup (cond ((null split-name) ! (completing-read ! (concat prom (if default (format "(default %s) " default) "")) gnus-active-hashtb nil nil prefix)) ((= 1 (length split-name)) ! (completing-read prom gnus-active-hashtb nil nil (cons (car split-name) 0))) (t ! (completing-read prom (mapcar (lambda (el) (list el)) (nreverse split-name))))))) ! (when to-newsgroup ! (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or default ""))) (or (gnus-active to-newsgroup) --- 12284,12304 ---- (to-newsgroup (cond ((null split-name) ! (completing-read ! (concat prom (if default (format "(default %s) " default) "")) gnus-active-hashtb nil nil prefix)) ((= 1 (length split-name)) ! (completing-read prom gnus-active-hashtb nil nil (cons (car split-name) 0))) (t ! (completing-read prom (mapcar (lambda (el) (list el)) (nreverse split-name))))))) ! (when to-newsgroup ! (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or default ""))) (or (gnus-active to-newsgroup) *************** *** 12125,12153 **** to-newsgroup)) (defun gnus-read-save-file-name (prompt default-name) ! (let ((split-name (gnus-get-split-value gnus-split-methods))) ! ;; Let the split methods have their say. ! (cond ! ;; No split name was found. ! ((null split-name) ! (read-file-name ! (concat prompt " (default " (file-name-nondirectory default-name) ") ") ! (file-name-directory default-name) ! default-name)) ! ;; A single split name was found ! ((= 1 (length split-name)) ! (read-file-name ! (concat prompt " (default " (car split-name) ") ") ! gnus-article-save-directory ! (concat gnus-article-save-directory (car split-name)))) ! ;; A list of splits was found. ! (t ! (setq split-name (mapcar (lambda (el) (list el)) (nreverse split-name))) ! (let ((result (completing-read (concat prompt " ") split-name nil nil))) ! (concat gnus-article-save-directory ! (if (string= result "") ! (car (car split-name)) ! result))))))) (defun gnus-article-archive-name (group) "Return the first instance of an \"Archive-name\" in the current buffer." --- 12307,12345 ---- to-newsgroup)) (defun gnus-read-save-file-name (prompt default-name) ! (let* ((split-name (gnus-get-split-value gnus-split-methods)) ! (file ! ;; Let the split methods have their say. ! (cond ! ;; No split name was found. ! ((null split-name) ! (read-file-name ! (concat prompt " (default " ! (file-name-nondirectory default-name) ") ") ! (file-name-directory default-name) ! default-name)) ! ;; A single split name was found ! ((= 1 (length split-name)) ! (read-file-name ! (concat prompt " (default " (car split-name) ") ") ! gnus-article-save-directory ! (concat gnus-article-save-directory (car split-name)))) ! ;; A list of splits was found. ! (t ! (setq split-name (mapcar (lambda (el) (list el)) ! (nreverse split-name))) ! (let ((result (completing-read ! (concat prompt " ") split-name nil nil))) ! (concat gnus-article-save-directory ! (if (string= result "") ! (car (car split-name)) ! result))))))) ! ;; If we have read a directory, we append the default file name. ! (when (file-directory-p file) ! (setq file (concat (file-name-as-directory file) ! (file-name-nondirectory default-name)))) ! ;; Possibly translate some charaters. ! (nnheader-translate-file-chars file))) (defun gnus-article-archive-name (group) "Return the first instance of an \"Archive-name\" in the current buffer." *************** *** 12169,12178 **** (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save in rmail file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer (save-excursion (save-restriction --- 12361,12370 ---- (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save in rmail file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer (save-excursion (save-restriction *************** *** 12195,12208 **** (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save in Unix mail file:" default-name)))) (setq filename (expand-file-name filename (and default-name (file-name-directory default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer (save-excursion (save-restriction --- 12387,12400 ---- (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save in Unix mail file:" default-name)))) (setq filename (expand-file-name filename (and default-name (file-name-directory default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer (save-excursion (save-restriction *************** *** 12228,12237 **** (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save in file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction --- 12420,12429 ---- (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save in file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction *************** *** 12254,12263 **** (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save body in file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction --- 12446,12455 ---- (cond ((eq filename 'default) default-name) (filename filename) ! (t (gnus-read-save-file-name "Save body in file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction *************** *** 12281,12287 **** gnus-last-shell-command)))) (if (string-equal command "") (setq command gnus-last-shell-command)) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) --- 12473,12479 ---- gnus-last-shell-command)))) (if (string-equal command "") (setq command gnus-last-shell-command)) ! (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) *************** *** 12293,12304 **** (defun gnus-summary-insert-pseudos (pslist &optional not-view) (let ((buffer-read-only nil) (article (gnus-summary-article-number)) ! after-article b e) (or (gnus-summary-goto-subject article) (error (format "No such article: %d" article))) (gnus-summary-position-point) ;; If all commands are to be bunched up on one line, we collect ! ;; them here. (if gnus-view-pseudos-separately () (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) --- 12485,12496 ---- (defun gnus-summary-insert-pseudos (pslist &optional not-view) (let ((buffer-read-only nil) (article (gnus-summary-article-number)) ! after-article b e) (or (gnus-summary-goto-subject article) (error (format "No such article: %d" article))) (gnus-summary-position-point) ;; If all commands are to be bunched up on one line, we collect ! ;; them here. (if gnus-view-pseudos-separately () (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) *************** *** 12320,12326 **** (setcdr (assq 'execute (car ps)) (funcall (if (string-match "%s" action) 'format 'concat) ! action (mapconcat (lambda (f) f) files " "))))) (setq ps (cdr ps))))) (if (and gnus-view-pseudos (not not-view)) --- 12512,12518 ---- (setcdr (assq 'execute (car ps)) (funcall (if (string-match "%s" action) 'format 'concat) ! action (mapconcat (lambda (f) f) files " "))))) (setq ps (cdr ps))))) (if (and gnus-view-pseudos (not not-view)) *************** *** 12335,12353 **** (gnus-summary-article-number))) (gnus-summary-goto-subject after-article) (forward-line 1) ! (setq b (point)) ! (insert " " (file-name-nondirectory (cdr (assq 'name (car pslist)))) ": " (or (cdr (assq 'execute (car pslist))) "") "\n") (setq e (point)) (forward-line -1) ; back to `b' ! (put-text-property b e 'gnus-number gnus-reffed-article-number) (gnus-data-enter after-article gnus-reffed-article-number ! gnus-unread-mark b ! (car pslist) ! 0 (- e b)) (setq gnus-newsgroup-unreads (cons gnus-reffed-article-number gnus-newsgroup-unreads)) --- 12527,12547 ---- (gnus-summary-article-number))) (gnus-summary-goto-subject after-article) (forward-line 1) ! (setq b (point)) ! (insert " " (file-name-nondirectory (cdr (assq 'name (car pslist)))) ": " (or (cdr (assq 'execute (car pslist))) "") "\n") (setq e (point)) (forward-line -1) ; back to `b' ! (add-text-properties ! b e (list 'gnus-number gnus-reffed-article-number ! gnus-mouse-face-prop gnus-mouse-face)) (gnus-data-enter after-article gnus-reffed-article-number ! gnus-unread-mark b ! (car pslist) ! 0 (- e b)) (setq gnus-newsgroup-unreads (cons gnus-reffed-article-number gnus-newsgroup-unreads)) *************** *** 12384,12390 **** (read-file-name "Copy file to: " default-directory))) (gnus-set-global-variables) (or to (setq to (read-file-name "Copy file to: " default-directory))) ! (and (file-directory-p to) (setq to (concat (file-name-as-directory to) (file-name-nondirectory file)))) (copy-file file to)) --- 12578,12584 ---- (read-file-name "Copy file to: " default-directory))) (gnus-set-global-variables) (or to (setq to (read-file-name "Copy file to: " default-directory))) ! (and (file-directory-p to) (setq to (concat (file-name-as-directory to) (file-name-nondirectory file)))) (copy-file file to)) *************** *** 12403,12409 **** (gnus-set-global-variables) (setq gnus-current-headers (gnus-summary-article-header)) (gnus-set-global-variables) ! (gnus-group-edit-local-kill (gnus-summary-article-number) gnus-newsgroup-name)) --- 12597,12603 ---- (gnus-set-global-variables) (setq gnus-current-headers (gnus-summary-article-header)) (gnus-set-global-variables) ! (gnus-group-edit-local-kill (gnus-summary-article-number) gnus-newsgroup-name)) *************** *** 12417,12474 **** nil (setq gnus-article-mode-map (make-keymap)) (suppress-keymap gnus-article-mode-map) ! (define-key gnus-article-mode-map " " 'gnus-article-next-page) ! (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page) ! (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article) ! (define-key gnus-article-mode-map "h" 'gnus-article-show-summary) ! (define-key gnus-article-mode-map "s" 'gnus-article-show-summary) ! (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail) ! (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly) ! (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button) ! (define-key gnus-article-mode-map "\r" 'gnus-article-press-button) ! (define-key gnus-article-mode-map "\t" 'gnus-article-next-button) ! (define-key gnus-article-mode-map "\M-\t" 'gnus-article-prev-button) ! (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug) ! ! ;; Duplicate almost all summary keystrokes in the article mode map. ! (let ((commands ! (list ! "p" "N" "P" "\M-\C-n" "\M-\C-p" ! "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j" ! "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" ! "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h" ! "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w" ! "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a" ! "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s" ! "\M-g" "w" "\C-c\C-r" "\M-t" "C" ! "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d" ! "\C-c\C-i" "x" "X" "t" "g" "?" "l" ! "\C-c\C-v\C-v" "\C-d" "v" ! ;; "Mt" "M!" "Md" "Mr" ! ;; "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r" ! ;; "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK" ! ;; "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p" ! ;; "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT" ! ;; "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap" ! ;; "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am" ! ;; "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t" ! ;; "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi" ! ;; "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or" ! ;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve" ! ;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi" ! ))) ! (while commands ! (define-key gnus-article-mode-map (car commands) ! 'gnus-article-summary-command) ! (setq commands (cdr commands)))) ! ! (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" ! ;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" ! "=" "n" "^" "\M-^"))) ! (while commands ! (define-key gnus-article-mode-map (car commands) ! 'gnus-article-summary-command-nosave) ! (setq commands (cdr commands))))) (defun gnus-article-mode () --- 12611,12634 ---- nil (setq gnus-article-mode-map (make-keymap)) (suppress-keymap gnus-article-mode-map) ! ! (gnus-define-keys ! gnus-article-mode-map ! " " gnus-article-goto-next-page ! "\177" gnus-article-goto-prev-page ! "\C-c^" gnus-article-refer-article ! "h" gnus-article-show-summary ! "s" gnus-article-show-summary ! "\C-c\C-m" gnus-article-mail ! "?" gnus-article-describe-briefly ! gnus-mouse-2 gnus-article-push-button ! "\r" gnus-article-press-button ! "\t" gnus-article-next-button ! "\M-\t" gnus-article-prev-button ! "\C-c\C-b" gnus-bug) ! ! (substitute-key-definition ! 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) (defun gnus-article-mode () *************** *** 12507,12521 **** (defun gnus-article-setup-buffer () "Initialize the article buffer." ! ;; Returns the article buffer. ! (let ((name (if gnus-single-article-buffer "*Article*" ! (concat "*Article " gnus-newsgroup-name "*")))) (setq gnus-article-buffer name) ;; This might be a variable local to the summary buffer. (unless gnus-single-article-buffer (save-excursion (set-buffer gnus-summary-buffer) ! (setq gnus-article-buffer name)) (make-local-variable 'gnus-summary-buffer)) (if (get-buffer name) (save-excursion --- 12667,12686 ---- (defun gnus-article-setup-buffer () "Initialize the article buffer." ! (let* ((name (if gnus-single-article-buffer "*Article*" ! (concat "*Article " gnus-newsgroup-name "*"))) ! (original ! (progn (string-match "\\*Article" name) ! (concat " *Original Article" ! (substring name (match-end 0)))))) (setq gnus-article-buffer name) + (setq gnus-original-article-buffer original) ;; This might be a variable local to the summary buffer. (unless gnus-single-article-buffer (save-excursion (set-buffer gnus-summary-buffer) ! (setq gnus-article-buffer name) ! (setq gnus-original-article-buffer original)) (make-local-variable 'gnus-summary-buffer)) (if (get-buffer name) (save-excursion *************** *** 12535,12541 **** ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) ! (set-window-start (get-buffer-window gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) --- 12700,12706 ---- ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) ! (set-window-start (get-buffer-window gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) *************** *** 12558,12650 **** (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." ! (prog1 ! (save-excursion ! (if (get-buffer gnus-original-article-buffer) ! (set-buffer (get-buffer gnus-original-article-buffer)) ! (set-buffer (get-buffer-create gnus-original-article-buffer)) ! (buffer-disable-undo (current-buffer)) ! (setq major-mode 'gnus-original-article-mode) ! (setq buffer-read-only t) ! (gnus-add-current-to-buffer-list)) ! ! (setq group (or group gnus-newsgroup-name)) ! ! ;; Open server if it has closed. ! (gnus-check-server (gnus-find-method-for-group group)) ! ! ;; Using `gnus-request-article' directly will insert the article into ! ;; `nntp-server-buffer' - so we'll save some time by not having to ! ;; copy it from the server buffer into the article buffer. ! ! ;; We only request an article by message-id when we do not have the ! ;; headers for it, so we'll have to get those. ! (and (stringp article) ! (let ((gnus-override-method gnus-refer-article-method)) ! (gnus-read-header article))) ! ! ;; If the article number is negative, that means that this article ! ;; doesn't belong in this newsgroup (possibly), so we find its ! ;; message-id and request it by id instead of number. ! (if (not (numberp article)) ! () ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let ((header (gnus-summary-article-header article))) ! (if (< article 0) ! (if (vectorp header) ;; It's a real article. ! (setq article (mail-header-id header)) ! ;; It is an extracted pseudo-article. ! (setq article 'pseudo) ! (gnus-request-pseudo-article header))) ! ! (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) ! (if (not (eq (car method) 'nneething)) ! () ! (let ((dir (concat (file-name-as-directory (nth 1 method)) ! (mail-header-subject header)))) ! (if (file-directory-p dir) ! (progn ! (setq article 'nneething) ! (gnus-group-enter-directory dir))))))))) ! (cond ! ;; We first check `gnus-original-article-buffer'. ! ((and (equal (car gnus-original-article) group) ! (eq (cdr gnus-original-article) article)) ! ;; We don't have to do anything, since it's already where we ! ;; want it. ! 'article) ! ;; Check the backlog. ! ((and gnus-keep-backlog ! (gnus-backlog-request-article group article (current-buffer))) ! 'article) ! ;; Check the cache. ! ((and gnus-use-cache ! (numberp article) ! (gnus-cache-request-article article group)) ! 'article) ! ;; Get the article and put into the article buffer. ! ((or (stringp article) (numberp article)) ! (let ((gnus-override-method ! (and (stringp article) gnus-refer-article-method)) ! (buffer-read-only nil)) (erase-buffer) (gnus-kill-all-overlays) ! (if (gnus-request-article article group (current-buffer)) ! (progn ! (and gnus-keep-backlog ! (gnus-backlog-enter-article ! group article (current-buffer))) ! 'article)))) ! ;; It was a pseudo. ! (t article))) ! (setq gnus-original-article (cons group article)) ! (let (buffer-read-only) ! (erase-buffer) ! (gnus-kill-all-overlays) ! (insert-buffer-substring gnus-original-article-buffer)))) (defun gnus-read-header (id) "Read the headers of article ID and enter them into the Gnus system." --- 12723,12825 ---- (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." ! (let (sparse) ! (prog1 ! (save-excursion ! (if (get-buffer gnus-original-article-buffer) ! (set-buffer (get-buffer gnus-original-article-buffer)) ! (set-buffer (get-buffer-create gnus-original-article-buffer)) ! (buffer-disable-undo (current-buffer)) ! (setq major-mode 'gnus-original-article-mode) ! (setq buffer-read-only t) ! (gnus-add-current-to-buffer-list)) ! ! (setq group (or group gnus-newsgroup-name)) ! ! ;; Open server if it has closed. ! (gnus-check-server (gnus-find-method-for-group group)) ! ! ;; Using `gnus-request-article' directly will insert the article into ! ;; `nntp-server-buffer' - so we'll save some time by not having to ! ;; copy it from the server buffer into the article buffer. ! ! ;; We only request an article by message-id when we do not have the ! ;; headers for it, so we'll have to get those. ! (and (stringp article) ! (let ((gnus-override-method gnus-refer-article-method)) ! (gnus-read-header article))) ! ! ;; If the article number is negative, that means that this article ! ;; doesn't belong in this newsgroup (possibly), so we find its ! ;; message-id and request it by id instead of number. ! (if (not (numberp article)) ! () ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let ((header (gnus-summary-article-header article))) ! (if (< article 0) ! (cond ! ((memq article gnus-newsgroup-sparse) ! ;; This is a sparse gap article. ! (setq article (mail-header-id header))) ! ((vectorp header) ;; It's a real article. ! (setq article (mail-header-id header))) ! (t ! ;; It is an extracted pseudo-article. ! (setq article 'pseudo) ! (gnus-request-pseudo-article header)))) ! ! (let ((method (gnus-find-method-for-group ! gnus-newsgroup-name))) ! (if (not (eq (car method) 'nneething)) ! () ! (let ((dir (concat (file-name-as-directory (nth 1 method)) ! (mail-header-subject header)))) ! (if (file-directory-p dir) ! (progn ! (setq article 'nneething) ! (gnus-group-enter-directory dir))))))))) ! (cond ! ;; We first check `gnus-original-article-buffer'. ! ((and (equal (car gnus-original-article) group) ! (eq (cdr gnus-original-article) article)) ! ;; We don't have to do anything, since it's already where we ! ;; want it. ! 'article) ! ;; Check the backlog. ! ((and gnus-keep-backlog ! (gnus-backlog-request-article group article (current-buffer))) ! 'article) ! ;; Check the cache. ! ((and gnus-use-cache ! (numberp article) ! (gnus-cache-request-article article group)) ! 'article) ! ;; Get the article and put into the article buffer. ! ((or (stringp article) (numberp article)) ! (let ((gnus-override-method ! (and (stringp article) gnus-refer-article-method)) ! (buffer-read-only nil)) ! (erase-buffer) ! (gnus-kill-all-overlays) ! (if (gnus-request-article article group (current-buffer)) ! (progn ! (and gnus-keep-backlog ! (gnus-backlog-enter-article ! group article (current-buffer))) ! 'article)))) ! ;; It was a pseudo. ! (t article))) ! (unless sparse ! (setq gnus-original-article (cons group article)) ! (unless (equal (buffer-name (current-buffer)) ! (buffer-name (get-buffer gnus-original-article-buffer))) ! (let (buffer-read-only) (erase-buffer) (gnus-kill-all-overlays) ! (insert-buffer-substring gnus-original-article-buffer))))))) (defun gnus-read-header (id) "Read the headers of article ID and enter them into the Gnus system." *************** *** 12652,12671 **** (headers gnus-newsgroup-headers) header where) ;; First we check to see whether the header in question is already ! ;; fetched. (if (stringp id) ;; This is a Message-ID. ! (while headers ! (if (string= id (mail-header-id (car headers))) ! (setq header (car headers) ! headers nil) ! (setq headers (cdr headers)))) ;; This is an article number. ! (while headers ! (if (= id (mail-header-number (car headers))) ! (setq header (car headers) ! headers nil) ! (setq headers (cdr headers))))) (if header ;; We have found the header. header --- 12827,12838 ---- (headers gnus-newsgroup-headers) header where) ;; First we check to see whether the header in question is already ! ;; fetched. (if (stringp id) ;; This is a Message-ID. ! (setq header (gnus-id-to-header id)) ;; This is an article number. ! (setq header (gnus-summary-article-header id))) (if header ;; We have found the header. header *************** *** 12734,12754 **** transient-mark-mode) (setq mark-active nil)) (if (not (setq result (let ((buffer-read-only nil)) ! (gnus-request-article-this-buffer article group)))) ;; There is no such article. (save-excursion ! (if (not (numberp article)) ! () ! (setq gnus-article-current (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) (gnus-summary-mark-article article gnus-canceled-mark)) ! (gnus-message ! 1 "No such article (may have expired or been canceled)") ! (ding) ! nil) (if (or (eq result 'pseudo) (eq result 'nneething)) (progn (save-excursion --- 12901,12922 ---- transient-mark-mode) (setq mark-active nil)) (if (not (setq result (let ((buffer-read-only nil)) ! (gnus-request-article-this-buffer article group)))) ;; There is no such article. (save-excursion ! (when (and (numberp article) ! (not (memq article gnus-newsgroup-sparse))) ! (setq gnus-article-current (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) (gnus-summary-mark-article article gnus-canceled-mark)) ! (unless (memq article gnus-newsgroup-sparse) ! (gnus-message ! 1 "No such article (may have expired or been canceled)") ! (ding) ! nil)) (if (or (eq result 'pseudo) (eq result 'nneething)) (progn (save-excursion *************** *** 12777,12785 **** gnus-newsgroup-history (cons gnus-current-article gnus-newsgroup-history) gnus-current-article article ! gnus-current-headers (gnus-summary-article-header gnus-current-article) ! gnus-article-current (cons gnus-newsgroup-name gnus-current-article)) (unless (vectorp gnus-current-headers) (setq gnus-current-headers nil)) --- 12945,12953 ---- gnus-newsgroup-history (cons gnus-current-article gnus-newsgroup-history) gnus-current-article article ! gnus-current-headers (gnus-summary-article-header gnus-current-article) ! gnus-article-current (cons gnus-newsgroup-name gnus-current-article)) (unless (vectorp gnus-current-headers) (setq gnus-current-headers nil)) *************** *** 12792,12800 **** ;; Suggested by Jim Sisolak ;; . (gnus-set-global-variables) ! (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)) ! (and gnus-use-cache (vectorp (gnus-summary-article-header article)) (gnus-cache-possibly-enter-article group article --- 12960,12968 ---- ;; Suggested by Jim Sisolak ;; . (gnus-set-global-variables) ! (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)) ! (and gnus-use-cache (vectorp (gnus-summary-article-header article)) (gnus-cache-possibly-enter-article group article *************** *** 12808,12818 **** (run-hooks 'internal-hook) (run-hooks 'gnus-article-prepare-hook) ;; Decode MIME message. ! (if gnus-show-mime ! (if (or (not gnus-strict-mime) ! (gnus-fetch-field "Mime-Version")) ! (funcall gnus-show-mime-method) ! (funcall gnus-decode-encoded-word-method))) ;; Perform the article display hooks. (run-hooks 'gnus-article-display-hook)) ;; Do page break. --- 12976,12986 ---- (run-hooks 'internal-hook) (run-hooks 'gnus-article-prepare-hook) ;; Decode MIME message. ! (if gnus-show-mime ! (if (or (not gnus-strict-mime) ! (gnus-fetch-field "Mime-Version")) ! (funcall gnus-show-mime-method) ! (funcall gnus-decode-encoded-word-method))) ;; Perform the article display hooks. (run-hooks 'gnus-article-display-hook)) ;; Do page break. *************** *** 12825,12835 **** (defun gnus-article-show-all-headers () "Show all article headers in article mode buffer." ! (save-excursion (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) ! (remove-text-properties (point-min) (point-max) gnus-hidden-properties)))) (defun gnus-article-hide-headers-if-wanted () --- 12993,13003 ---- (defun gnus-article-show-all-headers () "Show all article headers in article mode buffer." ! (save-excursion (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) ! (remove-text-properties (point-min) (point-max) gnus-hidden-properties)))) (defun gnus-article-hide-headers-if-wanted () *************** *** 12839,12850 **** gnus-inhibit-hiding (gnus-article-hide-headers))) ! (defun gnus-article-hide-headers (&optional show delete) ! "Hide unwanted headers and possibly sort them as well." (interactive "P") ! ;; This function might be inhibited. ! (if show ! (gnus-article-show-hidden-text 'headers) (unless gnus-inhibit-hiding (save-excursion (set-buffer gnus-article-buffer) --- 13007,13019 ---- gnus-inhibit-hiding (gnus-article-hide-headers))) ! (defun gnus-article-hide-headers (&optional arg delete) ! "Toggle whether to hide unwanted headers and possibly sort them as well. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." (interactive "P") ! (unless (gnus-article-check-hidden-text 'headers arg) ! ;; This function might be inhibited. (unless gnus-inhibit-hiding (save-excursion (set-buffer gnus-article-buffer) *************** *** 12865,12880 **** ;; First we narrow to just the headers. (widen) (goto-char (point-min)) ! ;; Hide any "From " lines at the beginning of (mail) articles. (while (looking-at "From ") (forward-line 1)) ! (unless (bobp) ! (add-text-properties (point-min) (point) (nconc (list 'gnus-type 'headers) gnus-hidden-properties))) ;; Then treat the rest of the header lines. ! (narrow-to-region ! (point) (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) ;; Then we use the two regular expressions ;; `gnus-ignored-headers' and `gnus-visible-headers' to --- 13034,13049 ---- ;; First we narrow to just the headers. (widen) (goto-char (point-min)) ! ;; Hide any "From " lines at the beginning of (mail) articles. (while (looking-at "From ") (forward-line 1)) ! (unless (bobp) ! (add-text-properties (point-min) (point) (nconc (list 'gnus-type 'headers) gnus-hidden-properties))) ;; Then treat the rest of the header lines. ! (narrow-to-region ! (point) (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) ;; Then we use the two regular expressions ;; `gnus-ignored-headers' and `gnus-visible-headers' to *************** *** 12890,12900 **** (progn (push (buffer-substring (setq beg (point)) ! (progn (forward-line 1) ;; Be sure to get multi-line headers... (re-search-forward "^[^ \t]*:" nil t) ! (beginning-of-line) (point))) want-list) (delete-region beg (point))) --- 13059,13069 ---- (progn (push (buffer-substring (setq beg (point)) ! (progn (forward-line 1) ;; Be sure to get multi-line headers... (re-search-forward "^[^ \t]*:" nil t) ! (beginning-of-line) (point))) want-list) (delete-region beg (point))) *************** *** 12908,12916 **** (if delete (delete-region (point-min) (point-max)) ;; Suggested by Sudish Joseph . ! (add-text-properties (point) (point-max) ! (nconc (list 'gnus-type 'headers) gnus-hidden-properties))))))))) (defsubst gnus-article-header-rank (header) --- 13077,13085 ---- (if delete (delete-region (point-min) (point-max)) ;; Suggested by Sudish Joseph . ! (add-text-properties (point) (point-max) ! (nconc (list 'gnus-type 'headers) gnus-hidden-properties))))))))) (defsubst gnus-article-header-rank (header) *************** *** 12929,12934 **** --- 13098,13162 ---- (< (gnus-article-header-rank h1) (gnus-article-header-rank h2))) + (defun gnus-article-hide-boring-headers (&optional arg) + "Toggle hiding of headers that aren't very interesting. + If given a negative prefix, always show; if given a positive prefix, + always hide." + (interactive "P") + (unless (gnus-article-check-hidden-text 'headers arg) + (save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (let ((buffer-read-only nil) + (list gnus-boring-article-headers) + (inhibit-point-motion-hooks t) + elem) + (nnheader-narrow-to-headers) + (while list + (setq elem (pop list)) + (goto-char (point-min)) + (cond + ;; Hide empty headers. + ((eq elem 'empty) + (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t) + (forward-line -1) + (gnus-article-hide-header))) + ;; Hide boring Newsgroups header. + ((eq elem 'newsgroups) + (when (equal (mail-fetch-field "newsgroups") + (gnus-group-real-name gnus-newsgroup-name)) + (gnus-article-hide-header "newsgroups"))) + ((eq elem 'followup-to) + (when (equal (mail-fetch-field "followup-to") + (mail-fetch-field "newsgroups")) + (gnus-article-hide-header "followup-to"))) + ((eq elem 'reply-to) + (when (equal (nth 1 (mail-extract-address-components + (mail-fetch-field "from"))) + (nth 1 (mail-extract-address-components + (mail-fetch-field "reply-to")))) + (gnus-article-hide-header "reply-to"))) + ((eq elem 'date) + (let ((date (mail-fetch-field "date"))) + (when (and date + (< (gnus-days-between date (current-time-string)) + 4)) + (gnus-article-hide-header "date"))))))))))) + + (defun gnus-article-hide-header (&optional header) + (when header + (goto-char (point-min)) + (re-search-forward (concat "^" header ":") nil t)) + (when (or (not header) + (match-beginning 0)) + (add-text-properties + (progn (beginning-of-line) (point)) + (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + (point-max)) + (nconc (list 'gnus-type 'headers) + gnus-hidden-properties)))) + ;; Written by Per Abrahamsen . (defun gnus-article-treat-overstrike () "Translate overstrikes into bold text." *************** *** 12948,12955 **** (- (point) 2) (1- (point)) 'face 'underline)) ((eq previous ?_) (put-text-property (- (point) 2) (point) 'invisible t) ! (put-text-property ! (point) (1+ (point)) 'face 'underline)))))))) (defun gnus-article-word-wrap () "Format too long lines." --- 13176,13183 ---- (- (point) 2) (1- (point)) 'face 'underline)) ((eq previous ?_) (put-text-property (- (point) 2) (point) 'invisible t) ! (put-text-property ! (point) (1+ (point)) 'face 'underline)))))))) (defun gnus-article-word-wrap () "Format too long lines." *************** *** 12981,12986 **** --- 13209,13229 ---- (while (search-forward "\r" nil t) (replace-match "" t t))))) + (defun gnus-article-remove-trailing-blank-lines () + "Remove all trailing blank lines from the article." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (delete-region + (point) + (progn + (while (looking-at "^[ \t]*$") + (forward-line -1)) + (forward-line 1) + (point)))))) + (defun gnus-article-display-x-face (&optional force) "Look for an X-Face header and display it if present." (interactive (list 'force)) *************** *** 12993,13007 **** (case-fold-search nil) from) (save-restriction ! (gnus-narrow-to-headers) (setq from (mail-fetch-field "from")) (goto-char (point-min)) ! (when (and gnus-article-x-face-command (or force ;; Check whether this face is censored. (not gnus-article-x-face-too-ugly) (and gnus-article-x-face-too-ugly from ! (not (string-match gnus-article-x-face-too-ugly from)))) ;; Has to be present. (re-search-forward "^X-Face: " nil t)) --- 13236,13250 ---- (case-fold-search nil) from) (save-restriction ! (nnheader-narrow-to-headers) (setq from (mail-fetch-field "from")) (goto-char (point-min)) ! (when (and gnus-article-x-face-command (or force ;; Check whether this face is censored. (not gnus-article-x-face-too-ugly) (and gnus-article-x-face-too-ugly from ! (not (string-match gnus-article-x-face-too-ugly from)))) ;; Has to be present. (re-search-forward "^X-Face: " nil t)) *************** *** 13018,13024 **** ;; as a, well, command, and fork it off. (let ((process-connection-type nil)) (process-kill-without-query ! (start-process "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command)) (process-send-region "gnus-x-face" beg end) (process-send-eof "gnus-x-face"))))))))) --- 13261,13267 ---- ;; as a, well, command, and fork it off. (let ((process-connection-type nil)) (process-kill-without-query ! (start-process "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command)) (process-send-region "gnus-x-face" beg end) (process-send-eof "gnus-x-face"))))))))) *************** *** 13038,13051 **** (subst-char-in-region (point-min) (point-max) ?_ ? ) (widen) (goto-char (point-min))))) ! (defun gnus-article-de-quoted-unreadable (&optional force) "Do a naive translation of a quoted-printable-encoded article. This is in no way, shape or form meant as a replacement for real MIME processing, but is simply a stop-gap measure until MIME support is written. If FORCE, decode the article whether it is marked as quoted-printable ! or not." (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) --- 13281,13294 ---- (subst-char-in-region (point-min) (point-max) ?_ ? ) (widen) (goto-char (point-min))))) ! (defun gnus-article-de-quoted-unreadable (&optional force) "Do a naive translation of a quoted-printable-encoded article. This is in no way, shape or form meant as a replacement for real MIME processing, but is simply a stop-gap measure until MIME support is written. If FORCE, decode the article whether it is marked as quoted-printable ! or not." (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) *************** *** 13075,13086 **** (delete-char 1)) ((gnus-message 3 "Malformed MIME quoted-printable message"))))) ! (defun gnus-article-hide-pgp (&optional show) ! "Hide any PGP headers and signatures in the current article. ! If given a prefix, show the hidden PGP gruft instead." ! (interactive) ! (if show ! (gnus-article-show-hidden-text 'pgp) (save-excursion (set-buffer gnus-article-buffer) (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties)) --- 13318,13329 ---- (delete-char 1)) ((gnus-message 3 "Malformed MIME quoted-printable message"))))) ! (defun gnus-article-hide-pgp (&optional arg) ! "Toggle hiding of any PGP headers and signatures in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive "P") ! (unless (gnus-article-check-hidden-text 'pgp arg) (save-excursion (set-buffer gnus-article-buffer) (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties)) *************** *** 13094,13100 **** ;; Hide the actual signature. (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) (setq end (match-beginning 0)) ! (add-text-properties (match-beginning 0) (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) (match-end 0) --- 13337,13343 ---- ;; Hide the actual signature. (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) (setq end (match-beginning 0)) ! (add-text-properties (match-beginning 0) (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) (match-end 0) *************** *** 13110,13152 **** (add-text-properties (match-beginning 0) (match-end 0) props)) (widen)))))) ! (defun gnus-article-hide-signature (&optional show) "Hide the signature in the current article. ! If given a prefix, show the signature instead." (interactive "P") ! (if show ! (gnus-article-show-hidden-text 'signature) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-max)) (and (re-search-backward gnus-signature-separator nil t) gnus-signature-face ! (add-text-properties (match-end 0) (point-max) (nconc (list 'gnus-type 'signature) gnus-hidden-properties))))))) ! (defun gnus-article-hide (&optional show force) "Hide all the gruft in the current article. This means that PGP stuff, signatures, cited text and (some) headers will be hidden. If given a prefix, show the hidden text instead." (interactive (list current-prefix-arg 'force)) ! (gnus-article-hide-headers show) ! (gnus-article-hide-pgp show) ! (gnus-article-hide-citation-maybe show force) ! (gnus-article-hide-signature show)) ! ! (defun gnus-article-show-hidden-text (type) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (beg (point))) (while (gnus-goto-char (text-property-any beg (point-max) 'gnus-type type)) ! (remove-text-properties (point) (setq beg (1+ (point))) ! gnus-hidden-properties))))) (defvar gnus-article-time-units `((year . ,(* 365.25 24 60 60)) --- 13353,13421 ---- (add-text-properties (match-beginning 0) (match-end 0) props)) (widen)))))) ! (defun gnus-article-hide-signature (&optional arg) "Hide the signature in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." (interactive "P") ! (unless (gnus-article-check-hidden-text 'signature arg) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-max)) (and (re-search-backward gnus-signature-separator nil t) gnus-signature-face ! (add-text-properties (match-end 0) (point-max) (nconc (list 'gnus-type 'signature) gnus-hidden-properties))))))) ! (defun gnus-article-check-hidden-text (type arg) ! "Return nil if hiding is necessary." ! (let ((hide (gnus-article-hidden-text-p 'signature))) ! (cond ((or (and (null arg) (eq hide 'hidden)) ! (and arg (< 0 (prefix-numeric-value arg)))) ! (gnus-article-show-hidden-text 'signature)) ! ((eq hide 'shown) ! (gnus-article-show-hidden-text 'signature t)) ! (t nil)))) ! ! (defun gnus-article-hidden-text-p (type) ! "Say whether the current buffer contains hidden text of type TYPE." ! (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type)) ! prop) ! (when pos ! (if (get-text-property pos 'invisible) ! 'hidden ! 'shown)))) ! ! (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. This means that PGP stuff, signatures, cited text and (some) headers will be hidden. If given a prefix, show the hidden text instead." (interactive (list current-prefix-arg 'force)) ! (gnus-article-hide-headers arg) ! (gnus-article-hide-pgp arg) ! (gnus-article-hide-citation-maybe arg force) ! (gnus-article-hide-signature arg)) ! ! (defun gnus-article-show-hidden-text (type &optional hide) ! "Show all hidden text of type TYPE. ! If HIDE, hide the text instead." (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t) (beg (point))) (while (gnus-goto-char (text-property-any beg (point-max) 'gnus-type type)) ! (if hide ! (add-text-properties (point) (setq beg (1+ (point))) ! gnus-hidden-properties) ! (remove-text-properties (point) (setq beg (1+ (point))) ! gnus-hidden-properties))) ! t))) (defvar gnus-article-time-units `((year . ,(* 365.25 24 60 60)) *************** *** 13162,13185 **** 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 gnus-current-headers (gnus-summary-article-header) "")) (date (and (vectorp header) (mail-header-date header))) (date-regexp "^Date: \\|^X-Sent: ") (inhibit-point-motion-hooks t)) (when (and date (not (string= date ""))) (save-excursion (set-buffer gnus-article-buffer) (save-restriction ! (gnus-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. (if (zerop (nnheader-remove-header date-regexp t)) (beginning-of-line) (goto-char (point-max))) (insert ! (cond ! ;; Convert to the local timezone. We have to slap a ;; `condition-case' round the calls to the timezone ;; functions since they aren't particularly resistant to ;; buggy dates. --- 13431,13455 ---- 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 gnus-current-headers (gnus-summary-article-header) "")) (date (and (vectorp header) (mail-header-date header))) (date-regexp "^Date: \\|^X-Sent: ") + (now (current-time)) (inhibit-point-motion-hooks t)) (when (and date (not (string= date ""))) (save-excursion (set-buffer gnus-article-buffer) (save-restriction ! (nnheader-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. (if (zerop (nnheader-remove-header date-regexp t)) (beginning-of-line) (goto-char (point-max))) (insert ! (cond ! ;; Convert to the local timezone. We have to slap a ;; `condition-case' round the calls to the timezone ;; functions since they aren't particularly resistant to ;; buggy dates. *************** *** 13202,13217 **** ((eq type 'lapsed) ;; If the date is seriously mangled, the timezone ;; functions are liable to bug out, so we condition-case ! ;; the entire thing. ! (let* ((real-sec (condition-case () ! (- (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! (current-time-string) ! (current-time-zone) "UT")) ! (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! date nil "UT"))) ! (error 0))) (sec (abs real-sec)) num prev) (if (zerop sec) --- 13472,13491 ---- ((eq type 'lapsed) ;; If the date is seriously mangled, the timezone ;; functions are liable to bug out, so we condition-case ! ;; the entire thing. ! (let* ((real-time ! (condition-case () ! (gnus-time-minus ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! (current-time-string now) ! (current-time-zone now) "UT")) ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! date nil "UT"))) ! (error '(0 0)))) ! (real-sec (+ (* (float (car real-time)) 65536) ! (cadr real-time))) (sec (abs real-sec)) num prev) (if (zerop sec) *************** *** 13222,13237 **** ;; through the time units for years, weeks, etc, ;; and divide things to see whether that results ;; in positive answers. ! (mapconcat (lambda (unit) (if (zerop (setq num (ffloor (/ sec (cdr unit))))) ;; The (remaining) seconds are too few to ;; be divided into this time unit. ! "" ;; It's big enough, so we output it. (setq sec (- sec (* num (cdr unit)))) (prog1 ! (concat (if prev ", " "") (int-to-string (floor num)) " " (symbol-name (car unit)) (if (> num 1) "s" "")) --- 13496,13511 ---- ;; through the time units for years, weeks, etc, ;; and divide things to see whether that results ;; in positive answers. ! (mapconcat (lambda (unit) (if (zerop (setq num (ffloor (/ sec (cdr unit))))) ;; The (remaining) seconds are too few to ;; be divided into this time unit. ! "" ;; It's big enough, so we output it. (setq sec (- sec (* num (cdr unit)))) (prog1 ! (concat (if prev ", " "") (int-to-string (floor num)) " " (symbol-name (car unit)) (if (> num 1) "s" "")) *************** *** 13365,13371 **** (let ((buffer-read-only nil)) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))) ! (when (cond ((< arg 0) (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) ((> arg 0) --- 13639,13645 ---- (let ((buffer-read-only nil)) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))) ! (when (cond ((< arg 0) (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) ((> arg 0) *************** *** 13374,13380 **** (narrow-to-region (point) (if (re-search-forward page-delimiter nil 'move) ! (match-beginning 0) (point))) (when (and (gnus-visual-p 'page-marker) (not (= (point-min) 1))) --- 13648,13654 ---- (narrow-to-region (point) (if (re-search-forward page-delimiter nil 'move) ! (match-beginning 0) (point))) (when (and (gnus-visual-p 'page-marker) (not (= (point-min) 1))) *************** *** 13390,13400 **** ;; Article mode commands (defun gnus-article-next-page (&optional lines) ! "Show next page of current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." ! (interactive "P") (move-to-window-line -1) ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) (if (save-excursion --- 13664,13686 ---- ;; Article mode commands + (defun gnus-article-goto-next-page () + "Show the next page of the article." + (interactive) + (when (gnus-article-next-page) + (gnus-article-read-summary-keys nil ?n))) + + (defun gnus-article-goto-prev-page () + "Show the next page of the article." + (interactive) + (if (bobp) (gnus-article-read-summary-keys nil ?n) + (gnus-article-prev-page nil))) + (defun gnus-article-next-page (&optional lines) ! "Show the next page of the current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." ! (interactive "p") (move-to-window-line -1) ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) (if (save-excursion *************** *** 13420,13426 **** (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. Argument LINES specifies lines to be scrolled down." ! (interactive "P") (move-to-window-line 0) (if (and gnus-break-pages (bobp) --- 13706,13712 ---- (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. Argument LINES specifies lines to be scrolled down." ! (interactive "p") (move-to-window-line 0) (if (and gnus-break-pages (bobp) *************** *** 13453,13459 **** "Describe article mode commands briefly." (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-summary-command () "Execute the last keystroke in the summary buffer." --- 13739,13745 ---- "Describe article mode commands briefly." (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-summary-command () "Execute the last keystroke in the summary buffer." *************** *** 13476,13481 **** --- 13762,13804 ---- (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) + (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) + "Read a summary buffer key sequence and execute it from the article buffer." + (interactive "P") + (let ((nosaves + '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" + "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" + "=" "^" "\M-^")) + keys) + (save-excursion + (set-buffer gnus-summary-buffer) + (push (or key last-command-event) unread-command-events) + (setq keys (read-key-sequence nil))) + (message "") + + (if (member keys nosaves) + (let (func) + (pop-to-buffer gnus-summary-buffer 'norecord) + (if (setq func (lookup-key (current-local-map) keys)) + (call-interactively func) + (ding))) + (let ((obuf (current-buffer)) + (owin (current-window-configuration)) + (opoint (point)) + func in-buffer) + (if not-restore-window + (pop-to-buffer gnus-summary-buffer 'norecord) + (switch-to-buffer gnus-summary-buffer 'norecord)) + (setq in-buffer (current-buffer)) + (if (setq func (lookup-key (current-local-map) keys)) + (call-interactively func) + (ding)) + (when (eq in-buffer (current-buffer)) + (set-buffer obuf) + (unless not-restore-window + (set-window-configuration owin)) + (set-window-point (get-buffer-window (current-buffer)) opoint)))))) + ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti) *************** *** 13574,13580 **** (defvar gnus-dribble-eval-file nil) (defun gnus-dribble-file-name () ! (concat (if gnus-dribble-directory (concat (file-name-as-directory gnus-dribble-directory) (file-name-nondirectory gnus-current-startup-file)) --- 13897,13903 ---- (defvar gnus-dribble-eval-file nil) (defun gnus-dribble-file-name () ! (concat (if gnus-dribble-directory (concat (file-name-as-directory gnus-dribble-directory) (file-name-nondirectory gnus-current-startup-file)) *************** *** 13594,13602 **** (defun gnus-dribble-read-file () (let ((dribble-file (gnus-dribble-file-name))) ! (save-excursion ! (set-buffer (setq gnus-dribble-buffer ! (get-buffer-create (file-name-nondirectory dribble-file)))) (gnus-add-current-to-buffer-list) (erase-buffer) --- 13917,13925 ---- (defun gnus-dribble-read-file () (let ((dribble-file (gnus-dribble-file-name))) ! (save-excursion ! (set-buffer (setq gnus-dribble-buffer ! (get-buffer-create (file-name-nondirectory dribble-file)))) (gnus-add-current-to-buffer-list) (erase-buffer) *************** *** 13614,13620 **** (insert-file-contents dribble-file) (if (not (zerop (buffer-size))) (set-buffer-modified-p t)) ! (if (gnus-y-or-n-p "Auto-save file exists. Do you want to read it? ") (setq gnus-dribble-eval-file t)))))))) --- 13937,13943 ---- (insert-file-contents dribble-file) (if (not (zerop (buffer-size))) (set-buffer-modified-p t)) ! (if (gnus-y-or-n-p "Auto-save file exists. Do you want to read it? ") (setq gnus-dribble-eval-file t)))))))) *************** *** 13678,13684 **** gnus-secondary-servers)) nil nil gnus-nntp-server)))) ! (if (and gnus-nntp-server (stringp gnus-nntp-server) (not (string= gnus-nntp-server ""))) (setq gnus-select-method --- 14001,14007 ---- gnus-secondary-servers)) nil nil gnus-nntp-server)))) ! (if (and gnus-nntp-server (stringp gnus-nntp-server) (not (string= gnus-nntp-server ""))) (setq gnus-select-method *************** *** 13686,13693 **** (string= gnus-nntp-server "::")) (list 'nnspool (system-name))) ((string-match "^:" gnus-nntp-server) ! (list 'nnmh gnus-nntp-server ! (list 'nnmh-directory (file-name-as-directory (expand-file-name (concat "~/" (substring --- 14009,14016 ---- (string= gnus-nntp-server "::")) (list 'nnspool (system-name))) ((string-match "^:" gnus-nntp-server) ! (list 'nnmh gnus-nntp-server ! (list 'nnmh-directory (file-name-as-directory (expand-file-name (concat "~/" (substring *************** *** 13707,13727 **** (require 'nntp))) (setq gnus-current-select-method gnus-select-method) (run-hooks 'gnus-open-server-hook) ! (or ;; gnus-open-server-hook might have opened it ! (gnus-server-opened gnus-select-method) (gnus-open-server gnus-select-method) (gnus-y-or-n-p (format ! "%s open error: '%s'. Continue? " (nth 1 gnus-select-method) (gnus-status-message gnus-select-method))) (progn ! (gnus-message 1 "Couldn't open server on %s" (nth 1 gnus-select-method)) (ding) nil))))) (defun gnus-check-server (&optional method) "Check whether the connection to METHOD is down. If METHOD is nil, use `gnus-select-method'. --- 14030,14056 ---- (require 'nntp))) (setq gnus-current-select-method gnus-select-method) (run-hooks 'gnus-open-server-hook) ! (or ;; gnus-open-server-hook might have opened it ! (gnus-server-opened gnus-select-method) (gnus-open-server gnus-select-method) (gnus-y-or-n-p (format ! "%s open error: '%s'. Continue? " (nth 1 gnus-select-method) (gnus-status-message gnus-select-method))) (progn ! (gnus-message 1 "Couldn't open server on %s" (nth 1 gnus-select-method)) (ding) nil))))) + (defun gnus-check-group (group) + "Try to make sure that the server where GROUP exists is alive." + (let ((method (gnus-find-method-for-group group))) + (or (gnus-server-opened method) + (gnus-open-server method)))) + (defun gnus-check-server (&optional method) "Check whether the connection to METHOD is down. If METHOD is nil, use `gnus-select-method'. *************** *** 13749,13755 **** (setq method (gnus-server-to-method method))) (let ((func (intern (format "%s-%s" (car method) function)))) ;; If the functions isn't bound, we require the backend in ! ;; question. (unless (fboundp func) (require (car method)) (unless (fboundp func) --- 14078,14084 ---- (setq method (gnus-server-to-method method))) (let ((func (intern (format "%s-%s" (car method) function)))) ;; If the functions isn't bound, we require the backend in ! ;; question. (unless (fboundp func) (require (car method)) (unless (fboundp func) *************** *** 13772,13778 **** (funcall (gnus-get-function method 'open-server) (nth 1 method) (nthcdr 2 method)))) ;; If this hasn't been opened before, we add it to the list. ! (unless elem (setq elem (list method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. --- 14101,14107 ---- (funcall (gnus-get-function method 'open-server) (nth 1 method) (nthcdr 2 method)))) ;; If this hasn't been opened before, we add it to the list. ! (unless elem (setq elem (list method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. *************** *** 13794,13800 **** (defun gnus-request-newgroups (date method) "Request all new groups since DATE from METHOD." ! (funcall (gnus-get-function method 'request-newgroups) date (nth 1 method))) (defun gnus-server-opened (method) --- 14123,14129 ---- (defun gnus-request-newgroups (date method) "Request all new groups since DATE from METHOD." ! (funcall (gnus-get-function method 'request-newgroups) date (nth 1 method))) (defun gnus-server-opened (method) *************** *** 13809,13825 **** method))) (funcall (gnus-get-function method 'status-message) (nth 1 method)))) ! (defun gnus-request-group (group &optional dont-check) "Request GROUP. If DONT-CHECK, no information is required." ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-group) (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-request-asynchronous (group &optional articles) "Request that GROUP behave asynchronously. ARTICLES is the `data' of the group." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-asynchronous) (gnus-group-real-name group) (nth 1 method) articles))) (defun gnus-list-active-group (group) --- 14138,14154 ---- method))) (funcall (gnus-get-function method 'status-message) (nth 1 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)))) ! (funcall (gnus-get-function method 'request-group) (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-request-asynchronous (group &optional articles) "Request that GROUP behave asynchronously. ARTICLES is the `data' of the group." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-asynchronous) (gnus-group-real-name group) (nth 1 method) articles))) (defun gnus-list-active-group (group) *************** *** 13827,13833 **** (let ((method (gnus-find-method-for-group group)) (func 'list-active-group)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) (gnus-group-real-name group) (nth 1 method))))) (defun gnus-request-group-description (group) --- 14156,14162 ---- (let ((method (gnus-find-method-for-group group)) (func 'list-active-group)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) (gnus-group-real-name group) (nth 1 method))))) (defun gnus-request-group-description (group) *************** *** 13835,13847 **** (let ((method (gnus-find-method-for-group group)) (func 'request-group-description)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) (gnus-group-real-name group) (nth 1 method))))) (defun gnus-close-group (group) "Request the GROUP be closed." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'close-group) (gnus-group-real-name group) (nth 1 method)))) (defun gnus-retrieve-headers (articles group &optional fetch-old) --- 14164,14176 ---- (let ((method (gnus-find-method-for-group group)) (func 'request-group-description)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) (gnus-group-real-name group) (nth 1 method))))) (defun gnus-close-group (group) "Request the GROUP be closed." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'close-group) (gnus-group-real-name group) (nth 1 method)))) (defun gnus-retrieve-headers (articles group &optional fetch-old) *************** *** 13850,13856 **** (let ((method (gnus-find-method-for-group group))) (if (and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group fetch-old) ! (funcall (gnus-get-function method 'retrieve-headers) articles (gnus-group-real-name group) (nth 1 method) fetch-old)))) --- 14179,14185 ---- (let ((method (gnus-find-method-for-group group))) (if (and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group fetch-old) ! (funcall (gnus-get-function method 'retrieve-headers) articles (gnus-group-real-name group) (nth 1 method) fetch-old)))) *************** *** 13866,13889 **** (funcall (gnus-get-function method 'request-type) (gnus-group-real-name group) article)))) (defun gnus-request-article (article group &optional buffer) "Request the ARTICLE in GROUP. ARTICLE can either be an article number or an article Message-ID. If BUFFER, insert the article in that group." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-article) article (gnus-group-real-name group) (nth 1 method) buffer))) (defun gnus-request-head (article group) "Request the head of ARTICLE in GROUP." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-head) article (gnus-group-real-name group) (nth 1 method)))) (defun gnus-request-body (article group) "Request the body of ARTICLE in GROUP." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-body) article (gnus-group-real-name group) (nth 1 method)))) (defun gnus-request-post (method) --- 14195,14226 ---- (funcall (gnus-get-function method 'request-type) (gnus-group-real-name group) article)))) + (defun gnus-request-update-mark (group article mark) + "Return the type (`post' or `mail') of GROUP (and ARTICLE)." + (let ((method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function 'request-update-mark (car method))) + mark + (funcall (gnus-get-function method 'request-update-mark) + (gnus-group-real-name group) article)))) + (defun gnus-request-article (article group &optional buffer) "Request the ARTICLE in GROUP. ARTICLE can either be an article number or an article Message-ID. If BUFFER, insert the article in that group." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-article) article (gnus-group-real-name group) (nth 1 method) buffer))) (defun gnus-request-head (article group) "Request the head of ARTICLE in GROUP." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-head) article (gnus-group-real-name group) (nth 1 method)))) (defun gnus-request-body (article group) "Request the body of ARTICLE in GROUP." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-body) article (gnus-group-real-name group) (nth 1 method)))) (defun gnus-request-post (method) *************** *** 13894,13925 **** "Request a SCAN being performed in GROUP from METHOD. If GROUP is nil, all groups on METHOD are scanned." (let ((method (if group (gnus-find-method-for-group group) method))) ! (funcall (gnus-get-function method 'request-scan) (and group (gnus-group-real-name group)) (nth 1 method)))) ! (defun gnus-request-update-info (info method) "Request that METHOD update INFO." ! (when (gnus-check-backend-function 'request-update-info method) ! (funcall (gnus-get-function method 'request-update-info) ! (gnus-group-real-name (gnus-info-group info)) info (nth 1 method)))) (defun gnus-request-expire-articles (articles group &optional force) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-expire-articles) articles (gnus-group-real-name group) (nth 1 method) force))) ! (defun gnus-request-move-article (article group server accept-function &optional last) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-move-article) ! article (gnus-group-real-name group) (nth 1 method) accept-function last))) ! (defun gnus-request-accept-article (group &optional last) (let ((func (if (symbolp group) group ! (car (gnus-find-method-for-group group))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) last))) --- 14231,14262 ---- "Request a SCAN being performed in GROUP from METHOD. If GROUP is nil, all groups on METHOD are scanned." (let ((method (if group (gnus-find-method-for-group group) method))) ! (funcall (gnus-get-function method 'request-scan) (and group (gnus-group-real-name group)) (nth 1 method)))) ! (defsubst gnus-request-update-info (info method) "Request that METHOD update INFO." ! (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)) info (nth 1 method)))) (defun gnus-request-expire-articles (articles group &optional force) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-expire-articles) articles (gnus-group-real-name group) (nth 1 method) force))) ! (defun gnus-request-move-article (article group server accept-function &optional last) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-move-article) ! article (gnus-group-real-name group) (nth 1 method) accept-function last))) ! (defun gnus-request-accept-article (group &optional last method) (let ((func (if (symbolp group) group ! (car (or method (gnus-find-method-for-group group)))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) last))) *************** *** 13931,13985 **** (defun gnus-request-associate-buffer (group) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-associate-buffer) (gnus-group-real-name group)))) (defun gnus-request-restore-buffer (article group) "Request a new buffer restored to the state of ARTICLE." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-restore-buffer) article (gnus-group-real-name group) (nth 1 method)))) ! (defun gnus-request-create-group (group) ! (let ((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-request-delete-group (group &optional force) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-delete-group) (gnus-group-real-name group) force (nth 1 method)))) (defun gnus-request-rename-group (group new-name) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-rename-group) ! (gnus-group-real-name group) (gnus-group-real-name new-name) (nth 1 method)))) - (defun gnus-post-method (group force-group-method) - "Return the posting method based on GROUP and FORCE." - (let ((group-method (if (stringp group) - (gnus-find-method-for-group group) - group))) - (cond - ;; If the group-method is nil (which shouldn't happen) we use - ;; the default method. - ((null group-method) - gnus-select-method) - ;; We want this group's method. - (force-group-method group-method) - ;; Override normal method. - ((and gnus-post-method - (or (gnus-method-option-p group-method 'post) - (gnus-method-option-p group-method 'post-mail))) - gnus-post-method) - ;; Perhaps this is a mail group? - ((and (not (gnus-member-of-valid 'post group)) - (not (gnus-method-option-p group-method 'post-mail))) - group-method) - ;; Use the normal select method. - (t gnus-select-method)))) - (defun gnus-member-of-valid (symbol group) "Find out if GROUP has SYMBOL as part of its \"valid\" spec." (memq symbol (assoc --- 14268,14298 ---- (defun gnus-request-associate-buffer (group) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-associate-buffer) (gnus-group-real-name group)))) (defun gnus-request-restore-buffer (article group) "Request a new buffer restored to the state of ARTICLE." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-restore-buffer) article (gnus-group-real-name group) (nth 1 method)))) ! (defun gnus-request-create-group (group &optional 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-request-delete-group (group &optional force) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-delete-group) (gnus-group-real-name group) force (nth 1 method)))) (defun gnus-request-rename-group (group new-name) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-rename-group) ! (gnus-group-real-name group) (gnus-group-real-name new-name) (nth 1 method)))) (defun gnus-member-of-valid (symbol group) "Find out if GROUP has SYMBOL as part of its \"valid\" spec." (memq symbol (assoc *************** *** 13991,14014 **** (memq option (assoc (format "%s" (car method)) gnus-valid-select-methods))) - (defmacro gnus-server-equal (ss1 ss2) - "Say whether two servers are equal." - `(let ((s1 ,ss1) - (s2 ,ss2)) - (or (equal s1 s2) - (and (= (length s1) (length s2)) - (progn - (while (and s1 (member (car s1) s2)) - (setq s1 (cdr s1))) - (null s1)))))) - (defun gnus-server-extend-method (group method) ! ;; This function "extends" a virtual server. If the server is ! ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ! ;; called "helly+alt.alt". (let ((entry ! (gnus-copy-sequence (if (equal (car method) "native") gnus-select-method (cdr (assoc (car method) gnus-server-alist)))))) (setcar (cdr entry) (concat (nth 1 entry) "+" group)) --- 14304,14316 ---- (memq option (assoc (format "%s" (car method)) gnus-valid-select-methods))) (defun gnus-server-extend-method (group method) ! ;; This function "extends" a virtual server. If the server is ! ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ! ;; called "hello+alt.alt". (let ((entry ! (gnus-copy-sequence (if (equal (car method) "native") gnus-select-method (cdr (assoc (car method) gnus-server-alist)))))) (setcar (cdr entry) (concat (nth 1 entry) "+" group)) *************** *** 14044,14103 **** (let ((valids gnus-valid-select-methods) outs) (while valids ! (if (memq feature (car valids)) (setq outs (cons (car valids) outs))) (setq valids (cdr valids))) outs)) ! ;;; ;;; Active & Newsrc File Handling ;;; - ;; Newsrc related functions. - ;; Gnus internal format of gnus-newsrc-alist: - ;; (("alt.general" 3 (1 . 1)) - ;; ("alt.misc" 3 ((1 . 10) (12 . 15))) - ;; ("alt.test" 7 (1 . 99) (45 57 93)) ...) - ;; The first item is the group name; the second is the subscription - ;; level; the third is either a range of a list of ranges of read - ;; articles, the optional fourth element is a list of marked articles, - ;; the optional fifth element is the select method. - ;; - ;; Gnus internal format of gnus-newsrc-hashtb: - ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...) - ;; This is the entry for "alt.misc". The first element is the number - ;; of unread articles in "alt.misc". The cdr of this entry is the - ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is - ;; trivial to remove or add new elements into gnus-newsrc-alist - ;; without scanning the entire list. So, to get the actual information - ;; of "alt.misc", you'd say something like - ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb)) - ;; - ;; Gnus internal format of gnus-active-hashtb: - ;; ((1 . 1)) - ;; (5 . 10)) - ;; (67 . 99)) ...) - ;; The only element in each entry in this hash table is a range of - ;; (possibly) available articles. (Articles in this range may have - ;; been expired or canceled.) - ;; - ;; Gnus internal format of gnus-killed-list and gnus-zombie-list: - ;; ("alt.misc" "alt.test" "alt.general" ...) - (defun gnus-setup-news (&optional rawfile level) "Setup news information. If RAWFILE is non-nil, the .newsrc file will also be read. If LEVEL is non-nil, the news will be set up at level LEVEL." (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) ;; Clear some variables to re-initialize news information. ! (if init (setq gnus-newsrc-alist nil gnus-active-hashtb nil)) ;; Read the newsrc file and create `gnus-newsrc-hashtb'. (if init (gnus-read-newsrc-file rawfile)) ;; If we don't read the complete active file, we fill in the ! ;; hashtb here. (if (or (null gnus-read-active-file) (eq gnus-read-active-file 'some)) (gnus-update-active-hashtb-from-killed)) --- 14346,14374 ---- (let ((valids gnus-valid-select-methods) outs) (while valids ! (if (memq feature (car valids)) (setq outs (cons (car valids) outs))) (setq valids (cdr valids))) outs)) ! ;;; ;;; Active & Newsrc File Handling ;;; (defun gnus-setup-news (&optional rawfile level) "Setup news information. If RAWFILE is non-nil, the .newsrc file will also be read. If LEVEL is non-nil, the news will be set up at level LEVEL." (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) ;; Clear some variables to re-initialize news information. ! (if init (setq gnus-newsrc-alist nil gnus-active-hashtb nil)) ;; Read the newsrc file and create `gnus-newsrc-hashtb'. (if init (gnus-read-newsrc-file rawfile)) ;; If we don't read the complete active file, we fill in the ! ;; hashtb here. (if (or (null gnus-read-active-file) (eq gnus-read-active-file 'some)) (gnus-update-active-hashtb-from-killed)) *************** *** 14106,14112 **** ;; If `gnus-read-active-file' is nil, then we just create an empty ;; hash table. The partial filling out of the hash table will be ;; done in `gnus-get-unread-articles'. ! (and gnus-read-active-file (not level) (gnus-read-active-file)) --- 14377,14383 ---- ;; If `gnus-read-active-file' is nil, then we just create an empty ;; hash table. The partial filling out of the hash table will be ;; done in `gnus-get-unread-articles'. ! (and gnus-read-active-file (not level) (gnus-read-active-file)) *************** *** 14131,14137 **** (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) (gnus-get-unread-articles level)) ! (if (and init gnus-check-bogus-newsgroups gnus-read-active-file (not level) (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)))) --- 14402,14408 ---- (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) (gnus-get-unread-articles level)) ! (if (and init gnus-check-bogus-newsgroups gnus-read-active-file (not level) (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)))) *************** *** 14141,14188 **** Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' The `-n' option line from .newsrc is respected." (interactive) ! (or (gnus-check-first-time-used) ! (if (or (consp gnus-check-new-newsgroups) ! (eq gnus-check-new-newsgroups 'ask-server)) ! (gnus-ask-server-for-new-groups) ! (let ((groups 0) ! group new-newsgroups) ! (gnus-message 5 "Looking for new newsgroups...") ! (or gnus-have-read-active-file (gnus-read-active-file)) ! (setq gnus-newsrc-last-checked-date (current-time-string)) ! (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed)) ! ;; Go though every newsgroup in `gnus-active-hashtb' and compare ! ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. ! (mapatoms ! (lambda (sym) ! (if (or (null (setq group (symbol-name sym))) ! (not (boundp sym)) ! (null (symbol-value sym)) ! (gnus-gethash group gnus-killed-hashtb) ! (gnus-gethash group gnus-newsrc-hashtb)) ! () ! (let ((do-sub (gnus-matches-options-n group))) ! (cond ! ((eq do-sub 'subscribe) ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (funcall gnus-subscribe-options-newsgroup-method group)) ! ((eq do-sub 'ignore) ! nil) ! (t ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (if gnus-subscribe-hierarchical-interactive ! (setq new-newsgroups (cons group new-newsgroups)) ! (funcall gnus-subscribe-newsgroup-method group))))))) ! gnus-active-hashtb) ! (if new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups)) ! ;; Suggested by Per Abrahamsen . ! (if (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." ! groups (if (> groups 1) "s have" " has")) ! (gnus-message 6 "No new newsgroups.")))))) (defun gnus-matches-options-n (group) ;; Returns `subscribe' if the group is to be uncoditionally --- 14412,14459 ---- Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' The `-n' option line from .newsrc is respected." (interactive) ! (unless (gnus-check-first-time-used) ! (if (or (consp gnus-check-new-newsgroups) ! (eq gnus-check-new-newsgroups 'ask-server)) ! (gnus-ask-server-for-new-groups) ! (let ((groups 0) ! group new-newsgroups) ! (gnus-message 5 "Looking for new newsgroups...") ! (or gnus-have-read-active-file (gnus-read-active-file)) ! (setq gnus-newsrc-last-checked-date (current-time-string)) ! (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed)) ! ;; Go though every newsgroup in `gnus-active-hashtb' and compare ! ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. ! (mapatoms ! (lambda (sym) ! (if (or (null (setq group (symbol-name sym))) ! (not (boundp sym)) ! (null (symbol-value sym)) ! (gnus-gethash group gnus-killed-hashtb) ! (gnus-gethash group gnus-newsrc-hashtb)) ! () ! (let ((do-sub (gnus-matches-options-n group))) ! (cond ! ((eq do-sub 'subscribe) ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (funcall gnus-subscribe-options-newsgroup-method group)) ! ((eq do-sub 'ignore) ! nil) ! (t ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (if gnus-subscribe-hierarchical-interactive ! (setq new-newsgroups (cons group new-newsgroups)) ! (funcall gnus-subscribe-newsgroup-method group))))))) ! gnus-active-hashtb) ! (if new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups)) ! ;; Suggested by Per Abrahamsen . ! (if (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." ! groups (if (> groups 1) "s have" " has")) ! (gnus-message 6 "No new newsgroups.")))))) (defun gnus-matches-options-n (group) ;; Returns `subscribe' if the group is to be uncoditionally *************** *** 14194,14207 **** ((and gnus-options-subscribe (string-match gnus-options-subscribe group)) 'subscribe) ! ((and gnus-auto-subscribed-groups (string-match gnus-auto-subscribed-groups group)) 'subscribe) ((and gnus-options-not-subscribe (string-match gnus-options-not-subscribe group)) 'ignore) ;; Then we go through the list that was retrieved from the .newsrc ! ;; file. This list has elements on the form ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list ;; is in the reverse order of the options line) is returned. (t --- 14465,14478 ---- ((and gnus-options-subscribe (string-match gnus-options-subscribe group)) 'subscribe) ! ((and gnus-auto-subscribed-groups (string-match gnus-auto-subscribed-groups group)) 'subscribe) ((and gnus-options-not-subscribe (string-match gnus-options-not-subscribe group)) 'ignore) ;; Then we go through the list that was retrieved from the .newsrc ! ;; file. This list has elements on the form ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list ;; is in the reverse order of the options line) is returned. (t *************** *** 14213,14274 **** (defun gnus-ask-server-for-new-groups () (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) ! (methods (cons gnus-select-method ! (append ! (and (consp gnus-check-new-newsgroups) ! gnus-check-new-newsgroups) ! gnus-secondary-select-methods))) (groups 0) (new-date (current-time-string)) ! (hashtb (gnus-make-hashtable 100)) ! group new-newsgroups got-new method) ;; Go through both primary and secondary select methods and ! ;; request new newsgroups. ! (while methods ! (setq method (gnus-server-get-method nil (car methods))) ! (and (gnus-check-server method) ! (gnus-request-newgroups date method) ! (save-excursion ! (setq got-new t) ! (set-buffer nntp-server-buffer) ! ;; Enter all the new groups in a hashtable. ! (gnus-active-to-gnus-format method hashtb 'ignore))) ! (setq methods (cdr methods))) ! (and got-new (setq gnus-newsrc-last-checked-date new-date)) ! ;; Now all new groups from all select methods are in `hashtb'. ! (mapatoms ! (lambda (group-sym) ! (setq group (symbol-name group-sym)) ! (if (or (null group) ! (null (symbol-value group-sym)) ! (gnus-gethash group gnus-newsrc-hashtb) ! (member group gnus-zombie-list) ! (member group gnus-killed-list)) ! ;; The group is already known. ! () ! (and (symbol-value group-sym) ! (gnus-set-active group (symbol-value group-sym))) ! (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (funcall ! gnus-subscribe-options-newsgroup-method group)) ! ((eq do-sub 'ignore) ! nil) ! (t ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (if gnus-subscribe-hierarchical-interactive ! (setq new-newsgroups (cons group new-newsgroups)) ! (funcall gnus-subscribe-newsgroup-method group))))))) ! hashtb) ! (if new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups)) ;; Suggested by Per Abrahamsen . ! (if (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." ! groups (if (> groups 1) "s have" " has"))) got-new)) (defun gnus-check-first-time-used () --- 14484,14548 ---- (defun gnus-ask-server-for-new-groups () (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) ! (methods (cons gnus-select-method ! (cons ! gnus-message-archive-method ! (append ! (and (consp gnus-check-new-newsgroups) ! gnus-check-new-newsgroups) ! gnus-secondary-select-methods)))) (groups 0) (new-date (current-time-string)) ! group new-newsgroups got-new method hashtb ! gnus-override-subscribe-method) ;; Go through both primary and secondary select methods and ! ;; request new newsgroups. ! (while (setq method (gnus-server-get-method nil (pop methods))) ! (setq gnus-override-subscribe-method method) ! (when (and (gnus-check-server method) ! (gnus-request-newgroups date method)) ! (save-excursion ! (setq got-new t) ! (setq hashtb (gnus-make-hashtable 100)) ! (set-buffer nntp-server-buffer) ! ;; Enter all the new groups into a hashtable. ! (gnus-active-to-gnus-format method hashtb 'ignore))) ! ;; Now all new groups from `method' are in `hashtb'. ! (mapatoms ! (lambda (group-sym) ! (if (or (null (setq group (symbol-name group-sym))) ! (null (symbol-value group-sym)) ! (gnus-gethash group gnus-newsrc-hashtb) ! (member group gnus-zombie-list) ! (member group gnus-killed-list)) ! ;; The group is already known. ! () ! ;; Make this group active. ! (when (symbol-value group-sym) ! (gnus-set-active group (symbol-value group-sym))) ! ;; Check whether we want it or not. ! (let ((do-sub (gnus-matches-options-n group))) ! (cond ! ((eq do-sub 'subscribe) ! (incf groups) ! (gnus-sethash group group gnus-killed-hashtb) ! (funcall gnus-subscribe-options-newsgroup-method group)) ! ((eq do-sub 'ignore) ! nil) ! (t ! (incf groups) ! (gnus-sethash group group gnus-killed-hashtb) ! (if gnus-subscribe-hierarchical-interactive ! (push group new-newsgroups) ! (funcall gnus-subscribe-newsgroup-method group))))))) ! hashtb) ! (when new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups))) ;; Suggested by Per Abrahamsen . ! (when (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." ! groups (if (> groups 1) "s have" " has"))) ! (and got-new (setq gnus-newsrc-last-checked-date new-date)) got-new)) (defun gnus-check-first-time-used () *************** *** 14290,14296 **** (if (null (setq group (symbol-name sym))) () (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) (gnus-sethash group group gnus-killed-hashtb) (funcall gnus-subscribe-options-newsgroup-method group)) --- 14564,14570 ---- (if (null (setq group (symbol-name sym))) () (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) (gnus-sethash group group gnus-killed-hashtb) (funcall gnus-subscribe-options-newsgroup-method group)) *************** *** 14301,14307 **** gnus-active-hashtb) (while groups (if (gnus-active (car groups)) ! (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) (gnus-group-make-help-group) --- 14575,14581 ---- gnus-active-hashtb) (while groups (if (gnus-active (car groups)) ! (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) (gnus-group-make-help-group) *************** *** 14309,14318 **** (gnus-message 7 "`A k' to list killed groups")))))) (defun gnus-subscribe-group (group previous &optional method) ! (gnus-group-change-level (if method (list t group gnus-level-default-subscribed nil nil method) ! group) gnus-level-default-subscribed gnus-level-killed previous t)) ;; `gnus-group-change-level' is the fundamental function for changing --- 14583,14592 ---- (gnus-message 7 "`A k' to list killed groups")))))) (defun gnus-subscribe-group (group previous &optional method) ! (gnus-group-change-level (if method (list t group gnus-level-default-subscribed nil nil method) ! group) gnus-level-default-subscribed gnus-level-killed previous t)) ;; `gnus-group-change-level' is the fundamental function for changing *************** *** 14327,14336 **** ;; ENTRY can either be a string (newsgroup name) or a list (if ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' ! ;; entries. ;; LEVEL is the new level of the group, OLDLEVEL is the old level and ;; PREVIOUS is the group (in hashtb entry format) to insert this group ! ;; after. (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) (let (group info active num) --- 14601,14610 ---- ;; ENTRY can either be a string (newsgroup name) or a list (if ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' ! ;; entries. ;; LEVEL is the new level of the group, OLDLEVEL is the old level and ;; PREVIOUS is the group (in hashtb entry format) to insert this group ! ;; after. (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) (let (group info active num) *************** *** 14340,14346 **** (setq group (car (nth 2 entry)))) (setq group entry)) (if (and (stringp entry) ! oldlevel (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) --- 14614,14620 ---- (setq group (car (nth 2 entry)))) (setq group entry)) (if (and (stringp entry) ! oldlevel (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) *************** *** 14352,14365 **** (if (and (>= oldlevel gnus-level-zombie) (gnus-gethash group gnus-newsrc-hashtb)) ;; We are trying to subscribe a group that is already ! ;; subscribed. ! () ; Do nothing. (or (gnus-ephemeral-group-p group) (gnus-dribble-enter ! (format "(gnus-group-change-level %S %S %S %S %S)" group level oldlevel (car (nth 2 previous)) fromkilled))) ! ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie ;; list. If not, and it is in fact going to be killed, we remove --- 14626,14639 ---- (if (and (>= oldlevel gnus-level-zombie) (gnus-gethash group gnus-newsrc-hashtb)) ;; We are trying to subscribe a group that is already ! ;; subscribed. ! () ; Do nothing. (or (gnus-ephemeral-group-p group) (gnus-dribble-enter ! (format "(gnus-group-change-level %S %S %S %S %S)" group level oldlevel (car (nth 2 previous)) fromkilled))) ! ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie ;; list. If not, and it is in fact going to be killed, we remove *************** *** 14386,14392 **** ;; Remove from the hash table. (gnus-sethash group nil gnus-newsrc-hashtb) ;; We do not enter foreign groups into the list of dead ! ;; groups. (unless (gnus-group-foreign-p group) (if (= level gnus-level-zombie) (setq gnus-zombie-list (cons group gnus-zombie-list)) --- 14660,14666 ---- ;; Remove from the hash table. (gnus-sethash group nil gnus-newsrc-hashtb) ;; We do not enter foreign groups into the list of dead ! ;; groups. (unless (gnus-group-foreign-p group) (if (= level gnus-level-zombie) (setq gnus-zombie-list (cons group gnus-zombie-list)) *************** *** 14402,14418 **** (setq info (cdr entry)) (setq num (car entry))) (setq active (gnus-active group)) ! (setq num (if active (- (1+ (cdr active)) (car active)) t)) ;; Check whether the group is foreign. If so, the ;; foreign select method has to be entered into the ! ;; info. ! (let ((method (gnus-group-method-name group))) (if (eq method gnus-select-method) (setq info (list group level nil)) (setq info (list group level nil nil method))))) ! (or previous ! (setq previous (let ((p gnus-newsrc-alist)) (while (cdr (cdr p)) (setq p (cdr p))) --- 14676,14693 ---- (setq info (cdr entry)) (setq num (car entry))) (setq active (gnus-active group)) ! (setq num (if active (- (1+ (cdr active)) (car active)) t)) ;; Check whether the group is foreign. If so, the ;; foreign select method has to be entered into the ! ;; info. ! (let ((method (or gnus-override-subscribe-method ! (gnus-group-method-name group)))) (if (eq method gnus-select-method) (setq info (list group level nil)) (setq info (list group level nil nil method))))) ! (or previous ! (setq previous (let ((p gnus-newsrc-alist)) (while (cdr (cdr p)) (setq p (cdr p))) *************** *** 14421,14427 **** (if (cdr previous) (progn (setcdr (cdr previous) entry) ! (gnus-sethash group (cons num (cdr previous)) gnus-newsrc-hashtb)) (setcdr previous entry) (gnus-sethash group (cons num previous) --- 14696,14702 ---- (if (cdr previous) (progn (setcdr (cdr previous) entry) ! (gnus-sethash group (cons num (cdr previous)) gnus-newsrc-hashtb)) (setcdr previous entry) (gnus-sethash group (cons num previous) *************** *** 14433,14439 **** ;; It was alive, and it is going to stay alive, so we ;; just change the level and don't change any pointers or ;; hash table entries. ! (setcar (cdr (car (cdr (cdr entry)))) level))))))) (defun gnus-kill-newsgroup (newsgroup) "Obsolete function. Kills a newsgroup." --- 14708,14716 ---- ;; It was alive, and it is going to stay alive, so we ;; just change the level and don't change any pointers or ;; hash table entries. ! (setcar (cdr (car (cdr (cdr entry)))) level)))) ! (when gnus-group-change-level-function ! (funcall gnus-group-change-level-function group level oldlevel))))) (defun gnus-kill-newsgroup (newsgroup) "Obsolete function. Kills a newsgroup." *************** *** 14443,14453 **** (defun gnus-check-bogus-newsgroups (&optional confirm) "Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every ! newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) bogus group entry info) (gnus-message 5 "Checking bogus newsgroups...") ! (unless gnus-have-read-active-file (gnus-read-active-file)) (when (member gnus-select-method gnus-have-read-active-file) ;; Find all bogus newsgroup that are subscribed. --- 14720,14730 ---- (defun gnus-check-bogus-newsgroups (&optional confirm) "Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every ! newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) bogus group entry info) (gnus-message 5 "Checking bogus newsgroups...") ! (unless gnus-have-read-active-file (gnus-read-active-file)) (when (member gnus-select-method gnus-have-read-active-file) ;; Find all bogus newsgroup that are subscribed. *************** *** 14494,14514 **** ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. ! (defun gnus-get-unread-articles (&optional level) (let* ((newsrc (cdr gnus-newsrc-alist)) (level (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level ! (min ! (cond ((and gnus-activate-foreign-newsgroups (not (numberp gnus-activate-foreign-newsgroups))) (1+ gnus-level-subscribed)) ((numberp gnus-activate-foreign-newsgroups) gnus-activate-foreign-newsgroups) (t 0)) level)) - (update - (fboundp (intern (format "%s-request-update-info" - (car gnus-select-method))))) info group active virtuals method fmethod) (gnus-message 5 "Checking new news...") --- 14771,14788 ---- ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. ! (defun gnus-get-unread-articles (&optional level) (let* ((newsrc (cdr gnus-newsrc-alist)) (level (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level ! (min ! (cond ((and gnus-activate-foreign-newsgroups (not (numberp gnus-activate-foreign-newsgroups))) (1+ gnus-level-subscribed)) ((numberp gnus-activate-foreign-newsgroups) gnus-activate-foreign-newsgroups) (t 0)) level)) info group active virtuals method fmethod) (gnus-message 5 "Checking new news...") *************** *** 14525,14564 **** (if (and (setq method (gnus-info-method info)) (not (gnus-server-equal gnus-select-method ! (prog1 ! (setq fmethod (gnus-server-get-method nil method)) ! ;; We do this here because it would be awkward ! ;; to do it anywhere else. Hell, it's pretty ! ;; awkward here as well, but at least it's ! ;; reasonably efficient. ! (and (<= (gnus-info-level info) foreign-level) ! (gnus-request-update-info info method))))) (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (if (<= (gnus-info-level info) foreign-level) (setq active (gnus-activate-group (gnus-info-group info) 'scan))) ! ;; These groups are native or secondary. (if (<= (gnus-info-level info) level) ! (progn ! (if (and update (not method)) ! (progn ! ;; Allow updating of native groups as well, even ! ;; though that's pretty unlikely. ! (gnus-request-update-info info gnus-select-method) ! (setq active (gnus-activate-group ! (gnus-info-group info) 'scan))) ! (or gnus-read-active-file ! (setq active (gnus-activate-group ! (gnus-info-group info) 'scan))))))) ! (if active ! (gnus-get-unread-articles-in-group info active) ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-set-active group nil) (setcar (gnus-gethash group gnus-newsrc-hashtb) t)) ! (setq newsrc (cdr newsrc))) (gnus-message 5 "Checking new news...done"))) --- 14799,14823 ---- (if (and (setq method (gnus-info-method info)) (not (gnus-server-equal gnus-select-method ! (setq fmethod (gnus-server-get-method nil method)))) (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (if (<= (gnus-info-level info) foreign-level) (setq active (gnus-activate-group (gnus-info-group info) 'scan))) ! ;; These groups are native or secondary. (if (<= (gnus-info-level info) level) ! (or gnus-read-active-file ! (setq active (gnus-activate-group ! (gnus-info-group info) 'scan))))) ! (if active ! (gnus-get-unread-articles-in-group info active t) ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-set-active group nil) (setcar (gnus-gethash group gnus-newsrc-hashtb) t)) ! (setq newsrc (cdr newsrc))) (gnus-message 5 "Checking new news...done"))) *************** *** 14570,14585 **** (ohashtb gnus-newsrc-hashtb) prev) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) ! (setq alist ! (setq prev (setq gnus-newsrc-alist (if (equal (car (car gnus-newsrc-alist)) "dummy.group") gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist))))) (while alist ! (gnus-sethash ! (car (car alist)) ! (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb))) prev) gnus-newsrc-hashtb) (setq prev alist --- 14829,14844 ---- (ohashtb gnus-newsrc-hashtb) prev) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) ! (setq alist ! (setq prev (setq gnus-newsrc-alist (if (equal (car (car gnus-newsrc-alist)) "dummy.group") gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist))))) (while alist ! (gnus-sethash ! (car (car alist)) ! (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb))) prev) gnus-newsrc-hashtb) (setq prev alist *************** *** 14589,14596 **** "Create a hash table from the killed and zombie lists." (let ((lists '(gnus-killed-list gnus-zombie-list)) list) ! (setq gnus-killed-hashtb ! (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) (while lists (setq list (symbol-value (car lists))) --- 14848,14855 ---- "Create a hash table from the killed and zombie lists." (let ((lists '(gnus-killed-list gnus-zombie-list)) list) ! (setq gnus-killed-hashtb ! (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) (while lists (setq list (symbol-value (car lists))) *************** *** 14599,14615 **** (gnus-sethash (car list) (car list) gnus-killed-hashtb) (setq list (cdr list)))))) ! (defun gnus-get-unread-articles-in-group (info active) (let* ((range (gnus-info-read info)) (num 0) (marked (gnus-info-marks info))) ;; If a cache is present, we may have to alter the active info. (and gnus-use-cache (gnus-cache-possibly-alter-active (gnus-info-group info) active)) ! ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the ;; number to the group hash table entry. ! (cond ((zerop (cdr active)) (setq num 0)) ((not range) --- 14858,14878 ---- (gnus-sethash (car list) (car list) gnus-killed-hashtb) (setq list (cdr list)))))) ! (defun gnus-get-unread-articles-in-group (info active &optional update) ! ;; Allow the backend to update the info in the group. ! (when update ! (gnus-request-update-info ! info (gnus-find-method-for-group (gnus-info-group info)))) (let* ((range (gnus-info-read info)) (num 0) (marked (gnus-info-marks info))) ;; If a cache is present, we may have to alter the active info. (and gnus-use-cache (gnus-cache-possibly-alter-active (gnus-info-group info) active)) ! ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the ;; number to the group hash table entry. ! (cond ((zerop (cdr active)) (setq num 0)) ((not range) *************** *** 14626,14655 **** ;; The read list is a list of ranges. Fix them according to ;; the active hash table. ;; First peel off any elements that are below the lower ! ;; active limit. ! (while (and (cdr range) ! (>= (car active) (or (and (atom (car (cdr range))) (car (cdr range))) (car (car (cdr range)))))) (if (numberp (car range)) ! (setcar range ! (cons (car range) (or (and (numberp (car (cdr range))) ! (car (cdr range))) (cdr (car (cdr range)))))) ! (setcdr (car range) (or (and (numberp (nth 1 range)) (nth 1 range)) (cdr (car (cdr range)))))) (setcdr range (cdr (cdr range)))) ! ;; Adjust the first element to be the same as the lower limit. ! (if (and (not (atom (car range))) (< (cdr (car range)) (car active))) (setcdr (car range) (1- (car active)))) ;; Then we want to peel off any elements that are higher ! ;; than the upper active limit. (let ((srange range)) ;; Go past all legal elements. ! (while (and (cdr srange) (<= (or (and (atom (car (cdr srange))) (car (cdr srange))) (car (car (cdr srange)))) (cdr active))) --- 14889,14918 ---- ;; The read list is a list of ranges. Fix them according to ;; the active hash table. ;; First peel off any elements that are below the lower ! ;; active limit. ! (while (and (cdr range) ! (>= (car active) (or (and (atom (car (cdr range))) (car (cdr range))) (car (car (cdr range)))))) (if (numberp (car range)) ! (setcar range ! (cons (car range) (or (and (numberp (car (cdr range))) ! (car (cdr range))) (cdr (car (cdr range)))))) ! (setcdr (car range) (or (and (numberp (nth 1 range)) (nth 1 range)) (cdr (car (cdr range)))))) (setcdr range (cdr (cdr range)))) ! ;; Adjust the first element to be the same as the lower limit. ! (if (and (not (atom (car range))) (< (cdr (car range)) (car active))) (setcdr (car range) (1- (car active)))) ;; Then we want to peel off any elements that are higher ! ;; than the upper active limit. (let ((srange range)) ;; Go past all legal elements. ! (while (and (cdr srange) (<= (or (and (atom (car (cdr srange))) (car (cdr srange))) (car (car (cdr srange)))) (cdr active))) *************** *** 14699,14705 **** (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") (progn (goto-char (match-beginning 1)) ! (gnus-set-active group (setq active (cons (read (current-buffer)) (read (current-buffer))))) ;; Return the new active info. --- 14962,14968 ---- (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") (progn (goto-char (match-beginning 1)) ! (gnus-set-active group (setq active (cons (read (current-buffer)) (read (current-buffer))))) ;; Return the new active info. *************** *** 14720,14728 **** (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, ;; killed. Gnus stores no information on killed groups, so ! ;; there's nothing to be done. ;; One could store the information somewhere temporarily, ! ;; perhaps... Hmmm... () ;; Remove any negative articles numbers. (while (and unread (< (car unread) 0)) --- 14983,14991 ---- (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, ;; killed. Gnus stores no information on killed groups, so ! ;; there's nothing to be done. ;; One could store the information somewhere temporarily, ! ;; perhaps... Hmmm... () ;; Remove any negative articles numbers. (while (and unread (< (car unread) 0)) *************** *** 14731,14737 **** (while (and unread (< (car unread) (car active))) (setq unread (cdr unread))) ;; Compute the ranges of read articles by looking at the list of ! ;; unread articles. (while unread (if (/= (car unread) prev) (setq read (cons (if (= prev (1- (car unread))) prev --- 14994,15000 ---- (while (and unread (< (car unread) (car active))) (setq unread (cdr unread))) ;; Compute the ranges of read articles by looking at the list of ! ;; unread articles. (while unread (if (/= (car unread) prev) (setq read (cons (if (= prev (1- (car unread))) prev *************** *** 14741,14747 **** (when (<= prev (cdr active)) (setq read (cons (cons prev (cdr active)) read))) ;; Enter this list into the group info. ! (gnus-info-set-read info (if (> (length read) 1) (nreverse read) read)) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) --- 15004,15010 ---- (when (<= prev (cdr active)) (setq read (cons (cons prev (cdr active)) read))) ;; Enter this list into the group info. ! (gnus-info-set-read info (if (> (length read) 1) (nreverse read) read)) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) *************** *** 14755,14765 **** (ranges (gnus-info-read info)) news article) (while articles ! (when (gnus-member-of-range (setq article (pop articles)) ranges) (setq news (cons article news)))) (when news ! (gnus-info-set-read info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) (gnus-group-update-group group t)))) --- 15018,15028 ---- (ranges (gnus-info-read info)) news article) (while articles ! (when (gnus-member-of-range (setq article (pop articles)) ranges) (setq news (cons article news)))) (when news ! (gnus-info-set-read info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) (gnus-group-update-group group t)))) *************** *** 14778,14789 **** ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods (if (gnus-check-server gnus-select-method) ! ;; The native server is available. ! (cons gnus-select-method gnus-secondary-select-methods) ! ;; The native server is down, so we just do the ! ;; secondary ones. ! gnus-secondary-select-methods)) list-type) (setq gnus-have-read-active-file nil) (save-excursion --- 15041,15054 ---- ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods (cons gnus-message-archive-method ! (if (gnus-check-server gnus-select-method) ! ;; The native server is available. ! (cons gnus-select-method ! gnus-secondary-select-methods) ! ;; The native server is down, so we just do the ! ;; secondary ones. ! gnus-secondary-select-methods))) list-type) (setq gnus-have-read-active-file nil) (save-excursion *************** *** 14801,14826 **** ;; Request that the backend scan its incoming messages. (and (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) ! (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) (let ((newsrc (cdr gnus-newsrc-alist)) (gmethod (gnus-server-get-method nil method)) groups) (while newsrc ! (and (gnus-server-equal ! (gnus-find-method-for-group (car (car newsrc)) (car newsrc)) gmethod) ! (setq groups (cons (gnus-group-real-name (car (car newsrc))) groups))) (setq newsrc (cdr newsrc))) (gnus-check-server method) (setq list-type (gnus-retrieve-groups groups method)) ! (cond ((not list-type) ! (gnus-message ! 1 "Cannot read partial active file from %s server." (car method)) (ding) (sit-for 2)) --- 15066,15091 ---- ;; Request that the backend scan its incoming messages. (and (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) ! (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) (let ((newsrc (cdr gnus-newsrc-alist)) (gmethod (gnus-server-get-method nil method)) groups) (while newsrc ! (and (gnus-server-equal ! (gnus-find-method-for-group (car (car newsrc)) (car newsrc)) gmethod) ! (setq groups (cons (gnus-group-real-name (car (car newsrc))) groups))) (setq newsrc (cdr newsrc))) (gnus-check-server method) (setq list-type (gnus-retrieve-groups groups method)) ! (cond ((not list-type) ! (gnus-message ! 1 "Cannot read partial active file from %s server." (car method)) (ding) (sit-for 2)) *************** *** 14831,14837 **** (t (if (not (gnus-request-list method)) (progn ! (gnus-message 1 "Cannot read active file from %s server." (car method)) (ding)) (gnus-active-to-gnus-format method) --- 15096,15102 ---- (t (if (not (gnus-request-list method)) (progn ! (gnus-message 1 "Cannot read active file from %s server." (car method)) (ding)) (gnus-active-to-gnus-format method) *************** *** 14846,14865 **** (unless method (setq method gnus-select-method)) (let ((cur (current-buffer)) ! (hashtb (or hashtb ! (if (and gnus-active-hashtb (not (equal method gnus-select-method))) gnus-active-hashtb (setq gnus-active-hashtb (if (equal method gnus-select-method) ! (gnus-make-hashtable (count-lines (point-min) (point-max))) (gnus-make-hashtable 4096)))))) (flag-hashtb (gnus-make-hashtable 60))) ;; Delete unnecessary lines. (goto-char (point-min)) (while (search-forward "\nto." nil t) ! (delete-region (1+ (match-beginning 0)) (progn (forward-line 1) (point)))) (or (string= gnus-ignored-newsgroups "") (progn --- 15111,15130 ---- (unless method (setq method gnus-select-method)) (let ((cur (current-buffer)) ! (hashtb (or hashtb ! (if (and gnus-active-hashtb (not (equal method gnus-select-method))) gnus-active-hashtb (setq gnus-active-hashtb (if (equal method gnus-select-method) ! (gnus-make-hashtable (count-lines (point-min) (point-max))) (gnus-make-hashtable 4096)))))) (flag-hashtb (gnus-make-hashtable 60))) ;; Delete unnecessary lines. (goto-char (point-min)) (while (search-forward "\nto." nil t) ! (delete-region (1+ (match-beginning 0)) (progn (forward-line 1) (point)))) (or (string= gnus-ignored-newsgroups "") (progn *************** *** 14872,14878 **** (while (re-search-backward "[][';?()#]" nil t) (insert ?\\)) ;; If these are groups from a foreign select method, we insert the ! ;; group prefix in front of the group names. (and method (not (gnus-server-equal (gnus-server-get-method nil method) (gnus-server-get-method nil gnus-select-method))) --- 15137,15143 ---- (while (re-search-backward "[][';?()#]" nil t) (insert ?\\)) ;; If these are groups from a foreign select method, we insert the ! ;; group prefix in front of the group names. (and method (not (gnus-server-equal (gnus-server-get-method nil method) (gnus-server-get-method nil gnus-select-method))) *************** *** 14886,14892 **** (if (string-match "%[oO]" gnus-group-line-format) ;; Suggested by Brian Edmonds . ;; If we want information on moderated groups, we use this ! ;; loop... (let* ((mod-hashtb (make-vector 7 0)) (m (intern "m" mod-hashtb)) group max min) --- 15151,15157 ---- (if (string-match "%[oO]" gnus-group-line-format) ;; Suggested by Brian Edmonds . ;; If we want information on moderated groups, we use this ! ;; loop... (let* ((mod-hashtb (make-vector 7 0)) (m (intern "m" mod-hashtb)) group max min) *************** *** 14897,14903 **** (setq group (let ((obarray hashtb)) (read cur))) (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not (or (= (following-char) ?=) --- 15162,15168 ---- (setq group (let ((obarray hashtb)) (read cur))) (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not (or (= (following-char) ?=) *************** *** 14907,14915 **** (set group nil)) ;; Enter moderated groups into a list. (if (eq (let ((obarray mod-hashtb)) (read cur)) m) ! (setq gnus-moderated-list (cons (symbol-name group) gnus-moderated-list)))) ! (error (and group (symbolp group) (set group nil)))) --- 15172,15180 ---- (set group nil)) ;; Enter moderated groups into a list. (if (eq (let ((obarray mod-hashtb)) (read cur)) m) ! (setq gnus-moderated-list (cons (symbol-name group) gnus-moderated-list)))) ! (error (and group (symbolp group) (set group nil)))) *************** *** 14927,14933 **** (setq group (let ((obarray hashtb)) (read cur))) (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not (or (= (following-char) ?=) --- 15192,15198 ---- (setq group (let ((obarray hashtb)) (read cur))) (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not (or (= (following-char) ?=) *************** *** 14935,14948 **** (= (following-char) ?j))))) (set group (cons min max)) (set group nil))) ! (error ! (progn (and group (symbolp group) (set group nil)) (or ignore-errors (gnus-message 3 "Warning - illegal active: %s" ! (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))))) (widen) (forward-line 1)))))) --- 15200,15213 ---- (= (following-char) ?j))))) (set group (cons min max)) (set group nil))) ! (error ! (progn (and group (symbolp group) (set group nil)) (or ignore-errors (gnus-message 3 "Warning - illegal active: %s" ! (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))))) (widen) (forward-line 1)))))) *************** *** 14950,14962 **** (defun gnus-groups-to-gnus-format (method &optional hashtb) ;; Parse a "groups" active file. (let ((cur (current-buffer)) ! (hashtb (or hashtb (if (and method gnus-active-hashtb) gnus-active-hashtb (setq gnus-active-hashtb ! (gnus-make-hashtable (count-lines (point-min) (point-max))))))) ! (prefix (and method (not (gnus-server-equal (gnus-server-get-method nil method) (gnus-server-get-method nil gnus-select-method))) --- 15215,15227 ---- (defun gnus-groups-to-gnus-format (method &optional hashtb) ;; Parse a "groups" active file. (let ((cur (current-buffer)) ! (hashtb (or hashtb (if (and method gnus-active-hashtb) gnus-active-hashtb (setq gnus-active-hashtb ! (gnus-make-hashtable (count-lines (point-min) (point-max))))))) ! (prefix (and method (not (gnus-server-equal (gnus-server-get-method nil method) (gnus-server-get-method nil gnus-select-method))) *************** *** 14977,14983 **** (skip-chars-forward " \t") (insert prefix) (goto-char opoint) ! (set (let ((obarray hashtb)) (read cur)) (cons min max))) (error (and group (symbolp group) (set group nil)))) (forward-line 1))) --- 15242,15248 ---- (skip-chars-forward " \t") (insert prefix) (goto-char opoint) ! (set (let ((obarray hashtb)) (read cur)) (cons min max))) (error (and group (symbolp group) (set group nil)))) (forward-line 1))) *************** *** 15009,15018 **** ;; much information that can not be gotten from the .newsrc ;; file (ticked articles, killed groups, foreign methods, etc.) (gnus-read-newsrc-el-file quick-file) ! (if (or force (and (file-newer-than-file-p newsrc-file quick-file) ! (file-newer-than-file-p newsrc-file (concat quick-file "d"))) (not gnus-newsrc-alist)) ;; We read the .newsrc file. Note that if there if a --- 15274,15283 ---- ;; much information that can not be gotten from the .newsrc ;; file (ticked articles, killed groups, foreign methods, etc.) (gnus-read-newsrc-el-file quick-file) ! (if (or force (and (file-newer-than-file-p newsrc-file quick-file) ! (file-newer-than-file-p newsrc-file (concat quick-file "d"))) (not gnus-newsrc-alist)) ;; We read the .newsrc file. Note that if there if a *************** *** 15044,15057 **** (error (gnus-message 1 "Error in %s" ding-file) (ding))) ! (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file (gnus-message 5 "Reading %s..." file) ;; The .el file is newer than the .eld file, so we read that one ! ;; as well. (gnus-read-old-newsrc-el-file file)))) ;; Parse the old-style quick startup file --- 15309,15322 ---- (error (gnus-message 1 "Error in %s" ding-file) (ding))) ! (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file (gnus-message 5 "Reading %s..." file) ;; The .el file is newer than the .eld file, so we read that one ! ;; as well. (gnus-read-old-newsrc-el-file file)))) ;; Parse the old-style quick startup file *************** *** 15075,15093 **** (progn (gnus-info-set-read info (cdr (cdr group))) (gnus-info-set-level ! info (if (nth 1 group) gnus-level-default-subscribed gnus-level-default-unsubscribed)) (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) (setq gnus-newsrc-alist ! (cons (setq info (list (car group) (if (nth 1 group) gnus-level-default-subscribed ! gnus-level-default-unsubscribed) (cdr (cdr group)))) gnus-newsrc-alist))) (if (setq m (assoc (car group) marked)) ! (gnus-info-set-marks info (cons (list (cons 'tick (gnus-compress-sequence (sort (cdr m) '<) t))) nil)))) --- 15340,15358 ---- (progn (gnus-info-set-read info (cdr (cdr group))) (gnus-info-set-level ! info (if (nth 1 group) gnus-level-default-subscribed gnus-level-default-unsubscribed)) (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) (setq gnus-newsrc-alist ! (cons (setq info (list (car group) (if (nth 1 group) gnus-level-default-subscribed ! gnus-level-default-unsubscribed) (cdr (cdr group)))) gnus-newsrc-alist))) (if (setq m (assoc (car group) marked)) ! (gnus-info-set-marks info (cons (list (cons 'tick (gnus-compress-sequence (sort (cdr m) '<) t))) nil)))) *************** *** 15101,15107 **** ;; "options", while the .eld version does, so we just add it if it ;; isn't there. (and ! gnus-newsrc-options (progn (and (not (string-match "^ *options" gnus-newsrc-options)) (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) --- 15366,15372 ---- ;; "options", while the .eld version does, so we just add it if it ;; isn't there. (and ! gnus-newsrc-options (progn (and (not (string-match "^ *options" gnus-newsrc-options)) (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) *************** *** 15113,15119 **** (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist))) ! (defun gnus-make-newsrc-file (file) "Make server dependent file name by catenating FILE and server host name." (let* ((file (expand-file-name file nil)) --- 15378,15384 ---- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist))) ! (defun gnus-make-newsrc-file (file) "Make server dependent file name by catenating FILE and server host name." (let* ((file (expand-file-name file nil)) *************** *** 15138,15144 **** ;; can `eq' against it later. (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) ! (while (not (eobp)) ;; We first read the first word on the line by narrowing and ;; then reading into `gnus-active-hashtb'. Most groups will --- 15403,15409 ---- ;; can `eq' against it later. (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) ! (while (not (eobp)) ;; We first read the first word on the line by narrowing and ;; then reading into `gnus-active-hashtb'. Most groups will *************** *** 15148,15160 **** (point) (progn (skip-chars-forward "^ \t!:\n") (point))) (goto-char (point-min)) ! (setq symbol (and (/= (point-min) (point-max)) (let ((obarray gnus-active-hashtb)) (read buf)))) (widen) ;; Now, the symbol we have read is either `options' or a group ! ;; name. If it is an options line, we just add it to a string. ! (cond ((or (eq symbol options-symbol) (eq symbol Options-symbol)) (setq gnus-newsrc-options --- 15413,15425 ---- (point) (progn (skip-chars-forward "^ \t!:\n") (point))) (goto-char (point-min)) ! (setq symbol (and (/= (point-min) (point-max)) (let ((obarray gnus-active-hashtb)) (read buf)))) (widen) ;; Now, the symbol we have read is either `options' or a group ! ;; name. If it is an options line, we just add it to a string. ! (cond ((or (eq symbol options-symbol) (eq symbol Options-symbol)) (setq gnus-newsrc-options *************** *** 15163,15169 **** ;; .newsrc files only contain a single options line, we ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options ! (buffer-substring (gnus-point-at-bol) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) --- 15428,15434 ---- ;; .newsrc files only contain a single options line, we ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options ! (buffer-substring (gnus-point-at-bol) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) *************** *** 15186,15192 **** ;; We are now at the beginning of the list of read articles. ;; We read them range by range. (while ! (cond ((looking-at "[0-9]+") ;; We narrow and read a number instead of buffer-substring/ ;; string-to-int because it's faster. narrow/widen is --- 15451,15457 ---- ;; We are now at the beginning of the list of read articles. ;; We read them range by range. (while ! (cond ((looking-at "[0-9]+") ;; We narrow and read a number instead of buffer-substring/ ;; string-to-int because it's faster. narrow/widen is *************** *** 15204,15216 **** (if (not (looking-at "[0-9]+")) ;; This is a buggy line, by we pretend that ;; it's kinda OK. Perhaps the user should be ! ;; dinged? (setq reads (cons num1 reads)) ! (setq reads ! (cons (cons num1 (progn ! (narrow-to-region (match-beginning 0) (match-end 0)) (read buf))) reads)) --- 15469,15481 ---- (if (not (looking-at "[0-9]+")) ;; This is a buggy line, by we pretend that ;; it's kinda OK. Perhaps the user should be ! ;; dinged? (setq reads (cons num1 reads)) ! (setq reads ! (cons (cons num1 (progn ! (narrow-to-region (match-beginning 0) (match-end 0)) (read buf))) reads)) *************** *** 15226,15239 **** nil) (t ;; Not numbers and not eol, so this might be a buggy ! ;; line... ! (or (eobp) ;; If it was eob instead of ?\n, we allow it. (progn ;; The line was buggy. (setq group nil) ! (gnus-message 3 "Mangled line: %s" ! (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))) (ding) (sit-for 1))) --- 15491,15504 ---- nil) (t ;; Not numbers and not eol, so this might be a buggy ! ;; line... ! (or (eobp) ;; If it was eob instead of ?\n, we allow it. (progn ;; The line was buggy. (setq group nil) ! (gnus-message 3 "Mangled line: %s" ! (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))) (ding) (sit-for 1))) *************** *** 15245,15251 **** ;; We have already read .newsrc.eld, so we gently update the ;; data in the hash table with the information we have just ! ;; read. (when group (let ((info (gnus-get-info group)) level) --- 15510,15516 ---- ;; We have already read .newsrc.eld, so we gently update the ;; data in the hash table with the information we have just ! ;; read. (when group (let ((info (gnus-get-info group)) level) *************** *** 15260,15281 **** (cond ((and (<= level gnus-level-subscribed) (not subscribed)) (setq level (if reads ! gnus-level-default-unsubscribed (1+ gnus-level-default-unsubscribed)))) ((and (> level gnus-level-subscribed) subscribed) (setq level gnus-level-default-subscribed))) (gnus-info-set-level info level)) ;; This is a new group. ! (setq info (list group (if subscribed ! gnus-level-default-subscribed (if reads (1+ gnus-level-subscribed) gnus-level-default-unsubscribed)) (nreverse reads)))) (setq newsrc (cons info newsrc)))))) (forward-line 1)) ! (setq newsrc (nreverse newsrc)) (if (not already-read) --- 15525,15546 ---- (cond ((and (<= level gnus-level-subscribed) (not subscribed)) (setq level (if reads ! gnus-level-default-unsubscribed (1+ gnus-level-default-unsubscribed)))) ((and (> level gnus-level-subscribed) subscribed) (setq level gnus-level-default-subscribed))) (gnus-info-set-level info level)) ;; This is a new group. ! (setq info (list group (if subscribed ! gnus-level-default-subscribed (if reads (1+ gnus-level-subscribed) gnus-level-default-unsubscribed)) (nreverse reads)))) (setq newsrc (cons info newsrc)))))) (forward-line 1)) ! (setq newsrc (nreverse newsrc)) (if (not already-read) *************** *** 15284,15290 **** ;; have read from .newsrc, and `gnus-newsrc-alist', which is ;; what we've read from .newsrc.eld. We have to merge these ;; lists. We do this by "attaching" any (foreign) groups in the ! ;; gnus-newsrc-alist to the (native) group that precedes them. (let ((rc (cdr gnus-newsrc-alist)) (prev gnus-newsrc-alist) entry mentry) --- 15549,15555 ---- ;; have read from .newsrc, and `gnus-newsrc-alist', which is ;; what we've read from .newsrc.eld. We have to merge these ;; lists. We do this by "attaching" any (foreign) groups in the ! ;; gnus-newsrc-alist to the (native) group that precedes them. (let ((rc (cdr gnus-newsrc-alist)) (prev gnus-newsrc-alist) entry mentry) *************** *** 15315,15325 **** ;; subscribed. A line like ;; options -n !all rec.all ;; will lead to a list that looks like ! ;; (("^rec\\..+" . subscribe) ;; ("^.+" . ignore)) ;; So all "rec.*" groups will be subscribed, while all the other ;; groups will be ignored. Note that "options -n !all rec.all" is very ! ;; different from "options -n rec.all !all". (defun gnus-newsrc-parse-options (options) (let (out eol) (save-excursion --- 15580,15590 ---- ;; subscribed. A line like ;; options -n !all rec.all ;; will lead to a list that looks like ! ;; (("^rec\\..+" . subscribe) ;; ("^.+" . ignore)) ;; So all "rec.*" groups will be subscribed, while all the other ;; groups will be ignored. Note that "options -n !all rec.all" is very ! ;; different from "options -n rec.all !all". (defun gnus-newsrc-parse-options (options) (let (out eol) (save-excursion *************** *** 15343,15349 **** ;; We are only interested in "options -n" lines - we ;; ignore the other option lines. (while (re-search-forward "[ \t]-n" nil t) ! (setq eol (or (save-excursion (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) (- (point) 2))) --- 15608,15614 ---- ;; We are only interested in "options -n" lines - we ;; ignore the other option lines. (while (re-search-forward "[ \t]-n" nil t) ! (setq eol (or (save-excursion (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) (- (point) 2))) *************** *** 15354,15368 **** ;; If the word begins with a bang (!), this is a "not" ;; spec. We put this spec (minus the bang) and the ;; symbol `ignore' into the list. ! (setq out (cons (cons (concat ! "^" (buffer-substring (1+ (match-beginning 0)) (match-end 0))) 'ignore) out)) ;; There was no bang, so this is a "yes" spec. (setq out (cons (cons (concat "^" (match-string 0)) 'subscribe) out))))) ! (setq gnus-newsrc-options-n out)))) (defun gnus-save-newsrc-file (&optional force) --- 15619,15633 ---- ;; If the word begins with a bang (!), this is a "not" ;; spec. We put this spec (minus the bang) and the ;; symbol `ignore' into the list. ! (setq out (cons (cons (concat ! "^" (buffer-substring (1+ (match-beginning 0)) (match-end 0))) 'ignore) out)) ;; There was no bang, so this is a "yes" spec. (setq out (cons (cons (concat "^" (match-string 0)) 'subscribe) out))))) ! (setq gnus-newsrc-options-n out)))) (defun gnus-save-newsrc-file (&optional force) *************** *** 15392,15398 **** (set-buffer (get-buffer-create " *Gnus-newsrc*")) (make-local-variable 'version-control) (setq version-control 'never) ! (setq buffer-file-name (concat gnus-current-startup-file ".eld")) (gnus-add-current-to-buffer-list) (buffer-disable-undo (current-buffer)) --- 15657,15663 ---- (set-buffer (get-buffer-create " *Gnus-newsrc*")) (make-local-variable 'version-control) (setq version-control 'never) ! (setq buffer-file-name (concat gnus-current-startup-file ".eld")) (gnus-add-current-to-buffer-list) (buffer-disable-undo (current-buffer)) *************** *** 15402,15408 **** (run-hooks 'gnus-save-quick-newsrc-hook) (save-buffer) (kill-buffer (current-buffer)) ! (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) (gnus-dribble-delete-file))))) --- 15667,15673 ---- (run-hooks 'gnus-save-quick-newsrc-hook) (save-buffer) (kill-buffer (current-buffer)) ! (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) (gnus-dribble-delete-file))))) *************** *** 15413,15419 **** (insert ";; to read .newsrc.\n") (insert "(setq gnus-newsrc-file-version " (prin1-to-string gnus-version) ")\n") ! (let ((variables (if gnus-save-killed-list gnus-variable-list ;; Remove the `gnus-killed-list' from the list of variables ;; to be saved, if required. --- 15678,15684 ---- (insert ";; to read .newsrc.\n") (insert "(setq gnus-newsrc-file-version " (prin1-to-string gnus-version) ")\n") ! (let ((variables (if gnus-save-killed-list gnus-variable-list ;; Remove the `gnus-killed-list' from the list of variables ;; to be saved, if required. *************** *** 15454,15467 **** (if (not (listp (cdr ranges))) (if (= (car ranges) (cdr ranges)) (insert (int-to-string (car ranges))) ! (insert (int-to-string (car ranges)) "-" (int-to-string (cdr ranges)))) (while ranges (setq range (car ranges) ranges (cdr ranges)) (if (or (atom range) (= (car range) (cdr range))) ! (insert (int-to-string ! (or (and (atom range) range) (car range)))) (insert (int-to-string (car range)) "-" (int-to-string (cdr range)))) --- 15719,15732 ---- (if (not (listp (cdr ranges))) (if (= (car ranges) (cdr ranges)) (insert (int-to-string (car ranges))) ! (insert (int-to-string (car ranges)) "-" (int-to-string (cdr ranges)))) (while ranges (setq range (car ranges) ranges (cdr ranges)) (if (or (atom range) (= (car range) (cdr range))) ! (insert (int-to-string ! (or (and (atom range) range) (car range)))) (insert (int-to-string (car range)) "-" (int-to-string (cdr range)))) *************** *** 15473,15479 **** ;; It has been reported that sometime the modtime on the .newsrc ;; file seems to be off. We really do want to overwrite it, so ;; we clear the modtime here before saving. It's a bit odd, ! ;; though... ;; sometimes the modtime clear isn't sufficient. most brute force: ;; delete the silly thing entirely first. but this fails to provide ;; such niceties as .newsrc~ creation. --- 15738,15744 ---- ;; It has been reported that sometime the modtime on the .newsrc ;; file seems to be off. We really do want to overwrite it, so ;; we clear the modtime here before saving. It's a bit odd, ! ;; though... ;; sometimes the modtime clear isn't sufficient. most brute force: ;; delete the silly thing entirely first. but this fails to provide ;; such niceties as .newsrc~ creation. *************** *** 15490,15504 **** (defun gnus-slave-save-newsrc () (save-excursion (set-buffer gnus-dribble-buffer) ! (let ((slave-name (make-temp-name (concat gnus-current-startup-file "-slave-")))) (write-region (point-min) (point-max) slave-name nil 'nomesg)))) (defun gnus-master-read-slave-newsrc () ! (let ((slave-files ! (directory-files (file-name-directory gnus-current-startup-file) ! t (concat "^" (regexp-quote (concat (file-name-nondirectory gnus-current-startup-file) --- 15755,15769 ---- (defun gnus-slave-save-newsrc () (save-excursion (set-buffer gnus-dribble-buffer) ! (let ((slave-name (make-temp-name (concat gnus-current-startup-file "-slave-")))) (write-region (point-min) (point-max) slave-name nil 'nomesg)))) (defun gnus-master-read-slave-newsrc () ! (let ((slave-files ! (directory-files (file-name-directory gnus-current-startup-file) ! t (concat "^" (regexp-quote (concat (file-name-nondirectory gnus-current-startup-file) *************** *** 15511,15518 **** (save-excursion (set-buffer (get-buffer-create " *gnus slave*")) (buffer-disable-undo (current-buffer)) ! (setq slave-files ! (sort (mapcar (lambda (file) (list (nth 5 (file-attributes file)) file)) slave-files) (lambda (f1 f2) --- 15776,15783 ---- (save-excursion (set-buffer (get-buffer-create " *gnus slave*")) (buffer-disable-undo (current-buffer)) ! (setq slave-files ! (sort (mapcar (lambda (file) (list (nth 5 (file-attributes file)) file)) slave-files) (lambda (f1 f2) *************** *** 15526,15532 **** (progn (eval-buffer (current-buffer)) t) ! (error (gnus-message 3 "Possible error in %s" file) (ding) (sit-for 2) --- 15791,15797 ---- (progn (eval-buffer (current-buffer)) t) ! (error (gnus-message 3 "Possible error in %s" file) (ding) (sit-for 2) *************** *** 15542,15548 **** ;;; Group description. (defun gnus-read-all-descriptions-files () ! (let ((methods (cons gnus-select-method gnus-secondary-select-methods))) (while methods (gnus-read-descriptions-file (car methods)) (setq methods (cdr methods))) --- 15807,15815 ---- ;;; Group description. (defun gnus-read-all-descriptions-files () ! (let ((methods (cons gnus-select-method ! (cons gnus-message-archive-method ! gnus-secondary-select-methods)))) (while methods (gnus-read-descriptions-file (car methods)) (setq methods (cdr methods))) *************** *** 15553,15566 **** ;; We create the hashtable whether we manage to read the desc file ;; to avoid trying to re-read after a failed read. (or gnus-description-hashtb ! (setq gnus-description-hashtb (gnus-make-hashtable (length gnus-active-hashtb)))) ;; Mark this method's desc file as read. (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" gnus-description-hashtb) (gnus-message 5 "Reading descriptions file via %s..." (car method)) ! (cond ((not (gnus-check-server method)) (gnus-message 1 "Couldn't open server") nil) --- 15820,15833 ---- ;; We create the hashtable whether we manage to read the desc file ;; to avoid trying to re-read after a failed read. (or gnus-description-hashtb ! (setq gnus-description-hashtb (gnus-make-hashtable (length gnus-active-hashtb)))) ;; Mark this method's desc file as read. (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" gnus-description-hashtb) (gnus-message 5 "Reading descriptions file via %s..." (car method)) ! (cond ((not (gnus-check-server method)) (gnus-message 1 "Couldn't open server") nil) *************** *** 15581,15588 **** (goto-char (point-min)) (while (not (eobp)) ;; If we get an error, we set group to 0, which is not a ! ;; symbol... ! (setq group (condition-case () (let ((obarray gnus-description-hashtb)) ;; Group is set to a symbol interned in this --- 15848,15855 ---- (goto-char (point-min)) (while (not (eobp)) ;; If we get an error, we set group to 0, which is not a ! ;; symbol... ! (setq group (condition-case () (let ((obarray gnus-description-hashtb)) ;; Group is set to a symbol interned in this *************** *** 15592,15598 **** (skip-chars-forward " \t") ;; ... which leads to this line being effectively ignored. (and (symbolp group) ! (set group (buffer-substring (point) (progn (end-of-line) (point))))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") --- 15859,15865 ---- (skip-chars-forward " \t") ;; ... which leads to this line being effectively ignored. (and (symbolp group) ! (set group (buffer-substring (point) (progn (end-of-line) (point))))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") *************** *** 15672,15678 **** (when ident (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) ;; Delete the article itself. ! (delete-region (point) (next-single-property-change (1+ (point)) 'gnus-backlog nil (point-max))))))) --- 15939,15945 ---- (when ident (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) ;; Delete the article itself. ! (delete-region (point) (next-single-property-change (1+ (point)) 'gnus-backlog nil (point-max))))))) *************** *** 15685,15691 **** ;; It was in the backlog. (save-excursion (set-buffer (gnus-backlog-buffer)) ! (if (not (setq beg (text-property-any (point-min) (point-max) 'gnus-backlog ident))) ;; It wasn't in the backlog after all. --- 15952,15958 ---- ;; It was in the backlog. (save-excursion (set-buffer (gnus-backlog-buffer)) ! (if (not (setq beg (text-property-any (point-min) (point-max) 'gnus-backlog ident))) ;; It wasn't in the backlog after all. *************** *** 15694,15700 **** nil) ;; Find the end (i. e., the beginning of the next article). (setq end ! (next-single-property-change (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) (let ((buffer-read-only nil)) (erase-buffer) --- 15961,15967 ---- nil) ;; Find the end (i. e., the beginning of the next article). (setq end ! (next-single-property-change (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) (let ((buffer-read-only nil)) (erase-buffer) *** pub/sgnus/lisp/nnbabyl.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnbabyl.el Tue Jan 16 20:27:17 1996 *************** *** 1,5 **** ;;; nnbabyl.el --- rmail mbox access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nnbabyl.el --- rmail mbox access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 18,25 **** ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to ! ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: --- 18,26 ---- ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: *************** *** 108,121 **** (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) ! gnus-verbose-backends ! (message "nnbabyl: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! gnus-verbose-backends ! (message "nnbabyl: Receiving headers...done")) (set-buffer nntp-server-buffer) (nnheader-fold-continuation-lines) --- 109,120 ---- (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) ! (nnheader-message 5 "nnbabyl: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! (nnheader-message 5 "nnbabyl: Receiving headers...done")) (set-buffer nntp-server-buffer) (nnheader-fold-continuation-lines) *************** *** 201,221 **** (nnbabyl-article-group-number))))))) (defun nnbabyl-request-group (group &optional server dont-check) ! (save-excursion ! (if (nnbabyl-possibly-change-newsgroup group) ! (if dont-check ! t ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (let ((active (assoc group nnbabyl-group-alist))) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- (cdr (car (cdr active))) ! (car (car (cdr active))))) ! (car (car (cdr active))) ! (cdr (car (cdr active))) ! (car active)))) ! t))))) (defun nnbabyl-request-scan (&optional group server) (nnbabyl-read-mbox) --- 200,227 ---- (nnbabyl-article-group-number))))))) (defun nnbabyl-request-group (group &optional server dont-check) ! (let ((active (assoc group nnbabyl-group-alist))) ! (save-excursion ! (cond ! ((null (nnbabyl-possibly-change-newsgroup group)) ! (nnheader-report 'nnbabyl "No such group: %s" group)) ! (dont-check ! (nnheader-report 'nnbabyl "Selected group %s" group) ! t) ! ((> (car active) (cdr active)) ! (nnheader-report 'nnbabyl "Empty group %s" group)) ! (t ! (nnheader-report 'nnbabyl "Selected group %s" group) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- (cdr (car (cdr active))) ! (car (car (cdr active))))) ! (car (car (cdr active))) ! (cdr (car (cdr active))) ! (car active)))) ! t))))) (defun nnbabyl-request-scan (&optional group server) (nnbabyl-read-mbox) *************** *** 287,295 **** (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn ! (and gnus-verbose-backends ! (message "Deleting article %d in %s..." ! (car articles) newsgroup)) (nnbabyl-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) --- 293,300 ---- (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn ! (nnheader-message 5 "Deleting article %d in %s..." ! (car articles) newsgroup) (nnbabyl-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) *************** *** 561,568 **** (let ((delim (concat "^" nnbabyl-mail-delimiter)) start end) (set-buffer (setq nnbabyl-mbox-buffer ! (nnheader-find-file-noselect ! nnbabyl-mbox-file nil 'raw))) ;; Save buffer mode. (setq nnbabyl-previous-buffer-mode (cons (cons (point-min) (point-max)) --- 566,572 ---- (let ((delim (concat "^" nnbabyl-mail-delimiter)) start end) (set-buffer (setq nnbabyl-mbox-buffer ! (find-file-noselect nnbabyl-mbox-file nil 'raw))) ;; Save buffer mode. (setq nnbabyl-previous-buffer-mode (cons (cons (point-min) (point-max)) *** pub/sgnus/lisp/nndir.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nndir.el Wed Jan 3 13:33:02 1996 *************** *** 1,5 **** ;;; nndir.el --- single directory newsgroup access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nndir.el --- single directory newsgroup access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *** pub/sgnus/lisp/nndoc.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nndoc.el Wed Jan 10 21:13:34 1996 *************** *** 1,5 **** ;;; nndoc.el --- single file access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nndoc.el --- single file access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 58,63 **** --- 58,70 ---- (forward (article-begin . "^-+ Start of forwarded message -+\n+") (body-end . "^-+ End of forwarded message -+\n")) + (clari-briefs + (article-begin . "^ \\*") + (body-end . "^\t------*[ \t]^*\n^ \\*") + (body-begin . "^\t") + (head-end . "^\t") + (generate-head . nndoc-generate-clari-briefs-head) + (article-transform . nndoc-transform-clari-briefs)) (slack-digest (article-begin . "^------------------------------*[\n \t]+") (head-end . "^ ?$") *************** *** 95,100 **** --- 102,109 ---- (defvar nndoc-body-end nil) (defvar nndoc-dissection-alist nil) (defvar nndoc-prepare-body nil) + (defvar nndoc-generate-head nil) + (defvar nndoc-article-transform nil) (defvar nndoc-current-server nil) (defvar nndoc-server-alist nil) *************** *** 140,156 **** (setq entry (cdr (assq (setq article (pop articles)) nndoc-dissection-alist))) (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring ! nndoc-current-buffer (car entry) (nth 1 entry)) (goto-char (point-max)) (or (= (char-after (1- (point))) ?\n) (insert "\n")) (insert (format "Lines: %d\n" (nth 4 entry))) (insert ".\n")) ! ;; Fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) 'headers))))) (defun nndoc-open-server (server &optional defs) --- 149,164 ---- (setq entry (cdr (assq (setq article (pop articles)) nndoc-dissection-alist))) (insert (format "221 %d Article retrieved.\n" article)) ! (if nndoc-generate-head ! (funcall nndoc-generate-head article) ! (insert-buffer-substring ! nndoc-current-buffer (car entry) (nth 1 entry))) (goto-char (point-max)) (or (= (char-after (1- (point))) ?\n) (insert "\n")) (insert (format "Lines: %d\n" (nth 4 entry))) (insert ".\n")) ! (nnheader-fold-continuation-lines) 'headers))))) (defun nndoc-open-server (server &optional defs) *************** *** 201,227 **** (goto-char beg) (when nndoc-prepare-body (funcall nndoc-prepare-body)) t)))) (defun nndoc-request-group (group &optional server dont-check) "Select news GROUP." (save-excursion ! (if (not (nndoc-possibly-change-buffer group server)) ! (progn ! (setq nndoc-status-string "No such file or buffer") ! nil) ! (if dont-check ! t (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((number (length nndoc-dissection-alist))) ! (if (zerop number) ! (progn ! (nndoc-close-group group) ! nil) ! (insert (format "211 %d %d %d %s\n" number 1 number group)) ! t))))))) (defun nndoc-close-group (group &optional server) (nndoc-possibly-change-buffer group server) --- 209,238 ---- (goto-char beg) (when nndoc-prepare-body (funcall nndoc-prepare-body)) + (when nndoc-article-transform + (funcall nndoc-article-transform article)) t)))) (defun nndoc-request-group (group &optional server dont-check) "Select news GROUP." (save-excursion ! (let (number) ! (cond ! ((not (nndoc-possibly-change-buffer group server)) ! (nnheader-report 'nndoc "No such file or buffer: %s" ! nndoc-address)) ! (dont-check ! (nnheader-report 'nndoc "Selected group %s" group) ! t) ! ((zerop (setq number (length nndoc-dissection-alist))) ! (nndoc-close-group group) ! (nnheader-report 'nndoc "No articles in group %s" group)) ! (t (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (insert (format "211 %d %d %d %s\n" number 1 number group)) ! t)))))) (defun nndoc-close-group (group &optional server) (nndoc-possibly-change-buffer group server) *************** *** 285,292 **** (save-excursion (set-buffer nndoc-current-buffer) (nndoc-set-delims) ! (nndoc-dissect-buffer)) ! t))) ;; MIME (RFC 1341) digest hack by Ulrik Dickow . (defun nndoc-guess-digest-type () --- 296,303 ---- (save-excursion (set-buffer nndoc-current-buffer) (nndoc-set-delims) ! (nndoc-dissect-buffer))) ! t)) ;; MIME (RFC 1341) digest hack by Ulrik Dickow . (defun nndoc-guess-digest-type () *************** *** 332,343 **** 'mmdf) ((looking-at "^Path:.*\n") 'rnews) ((save-excursion (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) (not (re-search-forward "^Subject:.*digest" nil t)))) 'forward) ! ((re-search-forward "\^_\^L *\n" nil t) ! 'babyl) ((re-search-forward "^Path: .*!" nil t) 'news) (t --- 343,357 ---- 'mmdf) ((looking-at "^Path:.*\n") 'rnews) + ((re-search-forward "\^_\^L *\n" nil t) + 'babyl) ((save-excursion (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) (not (re-search-forward "^Subject:.*digest" nil t)))) 'forward) ! ((let ((case-fold-search nil)) ! (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) ! 'clari-briefs) ((re-search-forward "^Path: .*!" nil t) 'news) (t *************** *** 349,355 **** nndoc-article-end nndoc-head-begin nndoc-head-end nndoc-file-end nndoc-article-begin nndoc-body-begin nndoc-body-end-function nndoc-body-end ! nndoc-prepare-body))) (while vars (set (pop vars) nil))) (let* (defs guess) --- 363,370 ---- nndoc-article-end nndoc-head-begin nndoc-head-end nndoc-file-end nndoc-article-begin nndoc-body-begin nndoc-body-end-function nndoc-body-end ! nndoc-prepare-body nndoc-article-transform ! nndoc-generate-head))) (while vars (set (pop vars) nil))) (let* (defs guess) *************** *** 434,439 **** --- 449,478 ---- (save-excursion (and (re-search-backward nndoc-article-begin nil t) (goto-char (+ (point) (string-to-int (match-string 1))))))) + + (defun nndoc-transform-clari-briefs (article) + (goto-char (point-min)) + (when (looking-at " *\\*\\(.*\\)\n") + (replace-match "" t t)) + (nndoc-generate-clari-briefs-head article)) + + (defun nndoc-generate-clari-briefs-head (article) + (let ((entry (cdr (assq article nndoc-dissection-alist))) + subject from) + (save-excursion + (set-buffer nndoc-current-buffer) + (save-restriction + (narrow-to-region (car entry) (nth 3 entry)) + (goto-char (point-min)) + (when (looking-at " *\\*\\(.*\\)$") + (setq subject (match-string 1))) + (when + (let ((case-fold-search nil)) + (re-search-forward + "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t)) + (setq from (match-string 1))))) + (insert "From: " "clari@clari.net (" (or from "unknown") ")" + "\nSubject: " (or subject "(no subject)") "\n"))) (provide 'nndoc) *** pub/sgnus/lisp/nndraft.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nndraft.el Fri Jan 12 13:53:40 1996 *************** *** 1,5 **** ;;; nndraft.el --- draft article access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; nndraft.el --- draft article access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 163,173 **** (file (nndraft-article-filename article))) (setq buffer-file-name file) (setq buffer-auto-save-file-name (make-auto-save-file-name)) article)) (defun nndraft-request-group (group &optional server dont-check) ! (nndraft-execute-nnmh-command ! (` (nnmh-request-group group "" (, dont-check))))) (defun nndraft-request-list (&optional server dir) (nndraft-execute-nnmh-command --- 163,176 ---- (file (nndraft-article-filename article))) (setq buffer-file-name file) (setq buffer-auto-save-file-name (make-auto-save-file-name)) + (clear-visited-file-modtime) article)) (defun nndraft-request-group (group &optional server dont-check) ! (prog1 ! (nndraft-execute-nnmh-command ! (` (nnmh-request-group group "" (, dont-check)))) ! (nnheader-report 'nndraft nnmh-status-string))) (defun nndraft-request-list (&optional server dir) (nndraft-execute-nnmh-command *************** *** 202,207 **** --- 205,211 ---- (let* ((point (point)) (mode major-mode) (name (buffer-name)) + (gnus-verbose-backends nil) (gart (nndraft-execute-nnmh-command (` (nnmh-request-accept-article group (, last) noinsert)))) (state *** pub/sgnus/lisp/nneething.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nneething.el Fri Jan 5 02:43:26 1996 *************** *** 1,5 **** ;;; nneething.el --- random file access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nneething.el --- random file access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 31,42 **** (require 'nnheader) (require 'nnmail) (defvar nneething-map-file-directory "~/.nneething/" "*Map files directory.") ! (defvar nneething-exclude-files "~$" ! "*Regexp saying what files to exclude from the group.") (defvar nneething-map-file ".nneething" "*Name of map files.") --- 31,44 ---- (require 'nnheader) (require 'nnmail) + (eval-when-compile (require 'cl)) (defvar nneething-map-file-directory "~/.nneething/" "*Map files directory.") ! (defvar nneething-exclude-files nil ! "*Regexp saying what files to exclude from the group. ! If this variable is nil, no files will be excluded.") (defvar nneething-map-file ".nneething" "*Name of map files.") *************** *** 60,70 **** (defvar nneething-read-only nil) (defvar nneething-active nil) (defvar nneething-server-variables ! (list ! (list 'nneething-directory nneething-directory) ! '(nneething-current-directory nil) ! '(nneething-status-string "") ! '(nneething-group-alist))) --- 62,71 ---- (defvar nneething-read-only nil) (defvar nneething-active nil) (defvar nneething-server-variables ! `((nneething-directory ,nneething-directory) ! (nneething-current-directory nil) ! (nneething-status-string "") ! (nneething-group-alist))) *************** *** 90,96 **** (setq file (nneething-file-name article)) (if (and (file-exists-p file) ! (not (zerop (nth 7 (file-attributes file))))) (progn (insert (format "221 %d Article retrieved.\n" article)) (nneething-insert-head file) --- 91,98 ---- (setq file (nneething-file-name article)) (if (and (file-exists-p file) ! (or (file-directory-p file) ! (not (zerop (nth 7 (file-attributes file)))))) (progn (insert (format "221 %d Article retrieved.\n" article)) (nneething-insert-head file) *************** *** 210,236 **** ;; Read nneething-active and nneething-map. (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) ! touched) (if (file-exists-p map-file) (condition-case nil (load map-file nil t t) (error nil))) (or nneething-active (setq nneething-active (cons 1 0))) ! ;; Remove files matching that regexp. ! (let ((f files) ! prev) ! (while f ! (if (string-match nneething-exclude-files (car f)) ! (if prev (setcdr prev (cdr f)) ! (setq files (cdr files))) ! (setq prev f)) ! (setq f (cdr f)))) ! ;; Remove files that have disappeared from the map. (let ((map nneething-map) prev) (while map ! (if (member (car (car map)) files) ! (setq prev map) (setq touched t) (if prev (setcdr prev (cdr map)) --- 212,254 ---- ;; Read nneething-active and nneething-map. (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) ! touched map-files) (if (file-exists-p map-file) (condition-case nil (load map-file nil t t) (error nil))) (or nneething-active (setq nneething-active (cons 1 0))) ! ;; Old nneething had a different map format. ! (when (and (cdr (car nneething-map)) ! (atom (cdar nneething-map))) ! (setq nneething-map ! (mapcar (lambda (n) ! (list (cdr n) (car n) ! (nth 5 (file-attributes ! (nneething-file-name (car n)))))) ! nneething-map))) ! ;; Remove files matching the exclusion regexp. ! (when nneething-exclude-files ! (let ((f files) ! prev) ! (while f ! (if (string-match nneething-exclude-files (car f)) ! (if prev (setcdr prev (cdr f)) ! (setq files (cdr files))) ! (setq prev f)) ! (setq f (cdr f))))) ! ;; Remove deleted files from the map. (let ((map nneething-map) prev) (while map ! (if (and (member (cadar map) files) ! ;; We also remove files that have changed mod times. ! (equal (nth 5 (file-attributes ! (nneething-file-name (cadar map)))) ! (caddar map))) ! (progn ! (push (cadar map) map-files) ! (setq prev map)) (setq touched t) (if prev (setcdr prev (cdr map)) *************** *** 238,257 **** (setq map (cdr map)))) ;; Find all new files and enter them into the map. (while files ! (or (assoc (car files) nneething-map) ; If already in the map, ignore. ! (progn ! (setq touched t) ! (setcdr nneething-active (1+ (cdr nneething-active))) ! (setq nneething-map ! (cons (cons (car files) (cdr nneething-active)) ! nneething-map)))) (setq files (cdr files))) ! (if (or (not touched) nneething-read-only) ! () (save-excursion ! (set-buffer (get-buffer-create " *nneething map*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" "(setq nneething-active '" (prin1-to-string nneething-active) ")\n") --- 256,274 ---- (setq map (cdr map)))) ;; Find all new files and enter them into the map. (while files ! (unless (member (car files) map-files) ! ;; This file is not in the map, so we enter it. ! (setq touched t) ! (setcdr nneething-active (1+ (cdr nneething-active))) ! (push (list (cdr nneething-active) (car files) ! (nth 5 (file-attributes ! (nneething-file-name (car files))))) ! nneething-map)) (setq files (cdr files))) ! (when (and touched ! (not nneething-read-only)) (save-excursion ! (nnheader-set-temp-buffer " *nneething map*") (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" "(setq nneething-active '" (prin1-to-string nneething-active) ")\n") *************** *** 321,332 **** (nneething-make-head file)) t)))) - (defun nneething-number-to-file (number) - (car (rassq number nneething-map))) - (defun nneething-file-name (article) (concat (file-name-as-directory nneething-directory) ! (if (numberp article) (nneething-number-to-file article) article))) (provide 'nneething) --- 338,347 ---- (nneething-make-head file)) t)))) (defun nneething-file-name (article) (concat (file-name-as-directory nneething-directory) ! (if (numberp article) ! (cadr (assq article nneething-map)) article))) (provide 'nneething) *** pub/sgnus/lisp/nnfolder.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnfolder.el Sat Jan 13 00:32:26 1996 *************** *** 1,5 **** ;;; nnfolder.el --- mail folder access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Scott Byer ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; nnfolder.el --- mail folder access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Scott Byer ;; Lars Magne Ingebrigtsen *************** *** 63,69 **** such things as moving mail. All buffers always get killed upon server close.") (defvar nnfolder-newsgroups-file ! (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") (defvar nnfolder-get-new-mail t --- 63,69 ---- such things as moving mail. All buffers always get killed upon server close.") (defvar nnfolder-newsgroups-file ! (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") (defvar nnfolder-get-new-mail t *************** *** 72,77 **** --- 72,80 ---- (defvar nnfolder-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") + (defvar nnfolder-inhibit-expiry nil + "If non-nil, inhibit expiry.") + (defconst nnfolder-version "nnfolder 1.0" *************** *** 97,102 **** --- 100,106 ---- (list 'nnfolder-active-file nnfolder-active-file) (list 'nnfolder-newsgroups-file nnfolder-newsgroups-file) (list 'nnfolder-get-new-mail nnfolder-get-new-mail) + (list 'nnfolder-inhibit-expiry nnfolder-inhibit-expiry) '(nnfolder-current-group nil) '(nnfolder-current-buffer nil) '(nnfolder-status-string "") *************** *** 219,226 **** (save-excursion (nnmail-activate 'nnfolder) (when (assoc group nnfolder-group-alist) ! (if dont-check ! t (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) (range (car (cdr active))) --- 223,234 ---- (save-excursion (nnmail-activate 'nnfolder) (when (assoc group nnfolder-group-alist) ! (nnfolder-possibly-change-group group) ! (cond ! (dont-check ! (nnheader-report 'nnfolder "Selected group %s" group) ! t) ! (t (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) (range (car (cdr active))) *************** *** 228,238 **** (maxactive (cdr range))) (set-buffer nntp-server-buffer) (erase-buffer) ! (when active (insert (format "211 %d %d %d %s\n" (1+ (- maxactive minactive)) minactive maxactive group)) ! t)))))) (defun nnfolder-request-scan (&optional group server) (nnmail-get-new-mail --- 236,250 ---- (maxactive (cdr range))) (set-buffer nntp-server-buffer) (erase-buffer) ! (cond ! ((null active) ! (nnheader-report 'nnfolder "No such group: %s" group)) ! (t ! (nnheader-report 'nnfolder "Selected group %s" group) (insert (format "211 %d %d %d %s\n" (1+ (- maxactive minactive)) minactive maxactive group)) ! t)))))))) (defun nnfolder-request-scan (&optional group server) (nnmail-get-new-mail *************** *** 320,330 **** (nnmail-expired-article-p newsgroup (buffer-substring ! (point) (progn (end-of-line) (point))) force)) (progn ! (and gnus-verbose-backends ! (message "Deleting article %d..." ! (car articles) newsgroup)) (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) --- 332,342 ---- (nnmail-expired-article-p newsgroup (buffer-substring ! (point) (progn (end-of-line) (point))) ! force nnfolder-inhibit-expiry)) (progn ! (nnheader-message 5 "Deleting article %d..." ! (car articles) newsgroup) (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) *************** *** 483,489 **** (defun nnfolder-possibly-change-group (group) (or (file-exists-p nnfolder-directory) ! (make-directory (directory-file-name nnfolder-directory))) (nnfolder-possibly-activate-groups nil) (or (assoc group nnfolder-group-alist) (not (file-exists-p (concat (file-name-as-directory nnfolder-directory) --- 495,501 ---- (defun nnfolder-possibly-change-group (group) (or (file-exists-p nnfolder-directory) ! (make-directory (directory-file-name nnfolder-directory) t)) (nnfolder-possibly-activate-groups nil) (or (assoc group nnfolder-group-alist) (not (file-exists-p (concat (file-name-as-directory nnfolder-directory) *************** *** 642,648 **** ;; and add it if it isn't. ;;(if (not (assoc nnfoler-current-group nnfolder-group-alist) (set-buffer (setq nnfolder-current-buffer ! (nnheader-find-file-noselect file nil 'raw))) (buffer-disable-undo (current-buffer)) (let ((delim (concat "^" rmail-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) --- 654,660 ---- ;; and add it if it isn't. ;;(if (not (assoc nnfoler-current-group nnfolder-group-alist) (set-buffer (setq nnfolder-current-buffer ! (find-file-noselect file nil 'raw))) (buffer-disable-undo (current-buffer)) (let ((delim (concat "^" rmail-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) *************** *** 704,709 **** --- 716,736 ---- ;; Make absolutely sure that the active list reflects reality! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (current-buffer)))) + + ;;;###autoload + (defun nnfolder-generate-active-file () + "Look for mbox folders in the nnfolder directory and make them into groups." + (interactive) + (nnmail-activate 'nnfolder) + (let ((files (directory-files nnfolder-directory)) + file group) + (while (setq file (pop files)) + (when (nnheader-mail-file-mbox-p file) + (nnheader-message 5 "Adding group %s..." file) + (push (list file (cons 1 0)) nnfolder-group-alist) + (nnfolder-read-folder file) + (nnfolder-close-group file)) + (message "")))) (provide 'nnfolder) *** pub/sgnus/lisp/nnheader.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnheader.el Tue Jan 16 20:28:56 1996 *************** *** 1,5 **** ;;; nnheader.el --- header access macros for Gnus and its backends ! ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; nnheader.el --- header access macros for Gnus and its backends ! ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *************** *** 18,32 **** ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to ! ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ! ;; These macros may look very much like the ones in GNUS 4.1. They ;; are, in a way, but you should note that the indices they use have ! ;; been changed from the internal GNUS format to the NOV format. Makes ! ;; it possible to read headers from XOVER much faster. ;; ;; The format of a header is now: ;; [number subject from date id references chars lines xref] --- 18,33 ---- ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: ! ;; These macros may look very much like the ones in GNUS 4.1. They ;; are, in a way, but you should note that the indices they use have ! ;; been changed from the internal GNUS format to the NOV format. The ! ;; makes it possible to read headers from XOVER much faster. ;; ;; The format of a header is now: ;; [number subject from date id references chars lines xref] *************** *** 38,152 **** (require 'mail-utils) (require 'sendmail) (eval-when-compile (require 'cl)) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") ! (defalias 'nntp-header-number 'mail-header-number) (defmacro mail-header-number (header) "Return article number in HEADER." ! (` (aref (, header) 0))) - (defalias 'nntp-set-header-number 'mail-header-set-number) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." ! (` (aset (, header) 0 (, number)))) - (defalias 'nntp-header-subject 'mail-header-subject) (defmacro mail-header-subject (header) "Return subject string in HEADER." ! (` (aref (, header) 1))) - (defalias 'nntp-set-header-subject 'mail-header-set-subject) (defmacro mail-header-set-subject (header subject) "Set article subject of HEADER to SUBJECT." ! (` (aset (, header) 1 (, subject)))) - (defalias 'nntp-header-from 'mail-header-from) (defmacro mail-header-from (header) "Return author string in HEADER." ! (` (aref (, header) 2))) - (defalias 'nntp-set-header-from 'mail-header-set-from) (defmacro mail-header-set-from (header from) "Set article author of HEADER to FROM." ! (` (aset (, header) 2 (, from)))) - (defalias 'nntp-header-date 'mail-header-date) (defmacro mail-header-date (header) "Return date in HEADER." ! (` (aref (, header) 3))) - (defalias 'nntp-set-header-date 'mail-header-set-date) (defmacro mail-header-set-date (header date) "Set article date of HEADER to DATE." ! (` (aset (, header) 3 (, date)))) ! (defalias 'nntp-header-id 'mail-header-id) (defmacro mail-header-id (header) "Return Id in HEADER." ! (` (aref (, header) 4))) ! (defalias 'nntp-set-header-id 'mail-header-set-id) (defmacro mail-header-set-id (header id) "Set article Id of HEADER to ID." ! (` (aset (, header) 4 (, id)))) - (defalias 'nntp-header-references 'mail-header-references) (defmacro mail-header-references (header) "Return references in HEADER." ! (` (aref (, header) 5))) - (defalias 'nntp-set-header-references 'mail-header-set-references) (defmacro mail-header-set-references (header ref) "Set article references of HEADER to REF." ! (` (aset (, header) 5 (, ref)))) - (defalias 'nntp-header-chars 'mail-header-chars) (defmacro mail-header-chars (header) "Return number of chars of article in HEADER." ! (` (aref (, header) 6))) - (defalias 'nntp-set-header-chars 'mail-header-set-chars) (defmacro mail-header-set-chars (header chars) "Set number of chars in article of HEADER to CHARS." ! (` (aset (, header) 6 (, chars)))) - (defalias 'nntp-header-lines 'mail-header-lines) (defmacro mail-header-lines (header) "Return lines in HEADER." ! (` (aref (, header) 7))) - (defalias 'nntp-set-header-lines 'mail-header-set-lines) (defmacro mail-header-set-lines (header lines) "Set article lines of HEADER to LINES." ! (` (aset (, header) 7 (, lines)))) - (defalias 'nntp-header-xref 'mail-header-xref) (defmacro mail-header-xref (header) "Return xref string in HEADER." ! (` (aref (, header) 8))) - (defalias 'nntp-set-header-xref 'mail-header-set-xref) (defmacro mail-header-set-xref (header xref) "Set article xref of HEADER to xref." ! (` (aset (, header) 8 (, xref)))) ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) ! (defvar gnus-verbose-backends t ! "*If non-nil, Gnus backends will generate lots of comments.") (defvar gnus-nov-is-evil nil "If non-nil, Gnus backends will never output headers in the NOV format.") (defvar news-reply-yank-from nil) (defvar news-reply-yank-message-id nil) - ;; All backends use this function, so I moved it to this file. - (defun nnheader-init-server-buffer () (save-excursion (setq nntp-server-buffer (get-buffer-create " *nntpd*")) (set-buffer nntp-server-buffer) --- 39,149 ---- (require 'mail-utils) (require 'sendmail) + (require 'rmail) (eval-when-compile (require 'cl)) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") ! (defvar nnheader-file-name-translation-alist nil ! "*Alist that says how to translate characters in file names. ! For instance, if \":\" is illegal as a file character in file names ! on your system, you could say something like: ! ! \(setq nnheader-file-name-translation-alist '((?: . ?_)))") ! ! ;;; Header access macros. ! (defmacro mail-header-number (header) "Return article number in HEADER." ! `(aref ,header 0)) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." ! `(aset ,header 0 ,number)) (defmacro mail-header-subject (header) "Return subject string in HEADER." ! `(aref ,header 1)) (defmacro mail-header-set-subject (header subject) "Set article subject of HEADER to SUBJECT." ! `(aset ,header 1 ,subject)) (defmacro mail-header-from (header) "Return author string in HEADER." ! `(aref ,header 2)) (defmacro mail-header-set-from (header from) "Set article author of HEADER to FROM." ! `(aset ,header 2 ,from)) (defmacro mail-header-date (header) "Return date in HEADER." ! `(aref ,header 3)) (defmacro mail-header-set-date (header date) "Set article date of HEADER to DATE." ! `(aset ,header 3 ,date)) ! (defalias 'mail-header-message-id 'mail-header-id) (defmacro mail-header-id (header) "Return Id in HEADER." ! `(aref ,header 4)) ! (defalias 'mail-header-set-message-id 'mail-header-set-id) (defmacro mail-header-set-id (header id) "Set article Id of HEADER to ID." ! `(aset ,header 4 ,id)) (defmacro mail-header-references (header) "Return references in HEADER." ! `(aref ,header 5)) (defmacro mail-header-set-references (header ref) "Set article references of HEADER to REF." ! `(aset ,header 5 ,ref)) (defmacro mail-header-chars (header) "Return number of chars of article in HEADER." ! `(aref ,header 6)) (defmacro mail-header-set-chars (header chars) "Set number of chars in article of HEADER to CHARS." ! `(aset ,header 6 ,chars)) (defmacro mail-header-lines (header) "Return lines in HEADER." ! `(aref ,header 7)) (defmacro mail-header-set-lines (header lines) "Set article lines of HEADER to LINES." ! `(aset ,header 7 ,lines)) (defmacro mail-header-xref (header) "Return xref string in HEADER." ! `(aref ,header 8)) (defmacro mail-header-set-xref (header xref) "Set article xref of HEADER to xref." ! `(aset ,header 8 ,xref)) + (defun make-mail-header (&optional init) + "Create a new mail header structure initialized with INIT." + (make-vector 9 init)) ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) ! (defvar gnus-verbose-backends 7 ! "*A number that says how talkative the Gnus backends should be.") (defvar gnus-nov-is-evil nil "If non-nil, Gnus backends will never output headers in the NOV format.") (defvar news-reply-yank-from nil) (defvar news-reply-yank-message-id nil) (defun nnheader-init-server-buffer () + "Initialize the Gnus-backend communication buffer." (save-excursion (setq nntp-server-buffer (get-buffer-create " *nntpd*")) (set-buffer nntp-server-buffer) *************** *** 156,161 **** --- 153,160 ---- (setq case-fold-search t) ;Should ignore case. t)) + ;;; Virtual server functions. + (defun nnheader-set-init-variables (server defs) (let ((s server) val) *************** *** 193,207 **** (set (car (car state)) (nth 1 (car state))) (setq state (cdr state)))) ! ;; Read the head of an article. (defun nnheader-insert-head (file) (if (eq nnheader-max-head-length t) ;; Just read the entire file. ! (nnheader-insert-file-contents-literally file) (let ((beg 0) (chop 1024)) ;; Read 1K blocks until we find a separator. ! (while (and (eq chop (nth 1 (nnheader-insert-file-contents-literally file nil beg (setq beg (+ chop beg))))) (prog1 (not (search-backward "\n\n" nil t)) (goto-char (point-max))) --- 192,208 ---- (set (car (car state)) (nth 1 (car state))) (setq state (cdr state)))) ! ;;; Various functions the backends use. ! (defun nnheader-insert-head (file) + "Insert the head of the article." (if (eq nnheader-max-head-length t) ;; Just read the entire file. ! (insert-file-contents-literally file) (let ((beg 0) (chop 1024)) ;; Read 1K blocks until we find a separator. ! (while (and (eq chop (nth 1 (insert-file-contents-literally file nil beg (setq beg (+ chop beg))))) (prog1 (not (search-backward "\n\n" nil t)) (goto-char (point-max))) *************** *** 209,214 **** --- 210,216 ---- (< beg nnheader-max-head-length))))))) (defun nnheader-article-p () + "Say whether the current buffer looks like an article." (goto-char (point-min)) (if (not (search-forward "\n\n" nil t)) nil *************** *** 220,370 **** (eobp) (widen)))) - ;; Written by Erik Naggum . - (defun nnheader-insert-file-contents-literally (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. - A buffer may be modified in several ways after reading into the buffer due - to advanced Emacs features, such as file-name-handlers, format decoding, - find-file-hooks, etc. - This function ensures that none of these modifications will take place." - (let ( ; (file-name-handler-alist nil) - (format-alist nil) - (after-insert-file-functions nil) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil))) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (filename) t)) - (insert-file-contents filename visit beg end replace)) - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - - (defun nnheader-find-file-noselect (filename &optional nowarn rawfile) - "Read file FILENAME into a buffer and return the buffer. - If a buffer exists visiting FILENAME, return that one, but - verify that the file has not changed since visited or saved. - The buffer is not selected, just returned to the caller." - (setq filename - (abbreviate-file-name - (expand-file-name filename))) - (if (file-directory-p filename) - (if find-file-run-dired - (dired-noselect filename) - (error "%s is a directory." filename)) - (let* ((buf (get-file-buffer filename)) - (truename (abbreviate-file-name (file-truename filename))) - (number (nthcdr 10 (file-attributes truename))) - ;; Find any buffer for a file which has same truename. - (other (and (not buf) - (if (fboundp 'find-buffer-visiting) - (find-buffer-visiting filename) - (get-file-buffer filename)))) - error) - ;; Let user know if there is a buffer with the same truename. - (if other - (progn - (or nowarn - (string-equal filename (buffer-file-name other)) - (message "%s and %s are the same file" - filename (buffer-file-name other))) - ;; Optionally also find that buffer. - (if (or (and (boundp 'find-file-existing-other-name) - find-file-existing-other-name) - find-file-visit-truename) - (setq buf other)))) - (if buf - (or nowarn - (verify-visited-file-modtime buf) - (cond ((not (file-exists-p filename)) - (error "File %s no longer exists!" filename)) - ((yes-or-no-p - (if (string= (file-name-nondirectory filename) - (buffer-name buf)) - (format - (if (buffer-modified-p buf) - "File %s changed on disk. Discard your edits? " - "File %s changed on disk. Reread from disk? ") - (file-name-nondirectory filename)) - (format - (if (buffer-modified-p buf) - "File %s changed on disk. Discard your edits in %s? " - "File %s changed on disk. Reread from disk into %s? ") - (file-name-nondirectory filename) - (buffer-name buf)))) - (save-excursion - (set-buffer buf) - (revert-buffer t t))))) - (save-excursion - ;;; The truename stuff makes this obsolete. - ;;; (let* ((link-name (car (file-attributes filename))) - ;;; (linked-buf (and (stringp link-name) - ;;; (get-file-buffer link-name)))) - ;;; (if (bufferp linked-buf) - ;;; (message "Symbolic link to file in buffer %s" - ;;; (buffer-name linked-buf)))) - (setq buf (create-file-buffer filename)) - ;; (set-buffer-major-mode buf) - (set-buffer buf) - (erase-buffer) - (if rawfile - (condition-case () - (nnheader-insert-file-contents-literally filename t) - (file-error - ;; Unconditionally set error - (setq error t))) - (condition-case () - (insert-file-contents filename t) - (file-error - ;; Run find-file-not-found-hooks until one returns non-nil. - (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks) - ;; If they fail too, set error. - (setq error t))))) - ;; Find the file's truename, and maybe use that as visited name. - (setq buffer-file-truename truename) - (setq buffer-file-number number) - ;; On VMS, we may want to remember which directory in a search list - ;; the file was found in. - (and (eq system-type 'vax-vms) - (let (logical) - (if (string-match ":" (file-name-directory filename)) - (setq logical (substring (file-name-directory filename) - 0 (match-beginning 0)))) - (not (member logical find-file-not-true-dirname-list))) - (setq buffer-file-name buffer-file-truename)) - (if find-file-visit-truename - (setq buffer-file-name - (setq filename - (expand-file-name buffer-file-truename)))) - ;; Set buffer's default directory to that of the file. - (setq default-directory (file-name-directory filename)) - ;; Turn off backup files for certain file names. Since - ;; this is a permanent local, the major mode won't eliminate it. - (and (not (funcall backup-enable-predicate buffer-file-name)) - (progn - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) - (if rawfile - nil - (after-find-file error (not nowarn))))) - buf))) - (defun nnheader-insert-references (references message-id) ! (if (and (not references) (not message-id)) ! () ; This is illegal, but not all articles have Message-IDs. ! ;; Fold long references line to follow RFC1036. ! (mail-position-on-field "References") ! (let ((begin (save-excursion (beginning-of-line) (point))) ! (fill-column 78) ! (fill-prefix "\t")) ! (if references (insert references)) ! (if (and references message-id) (insert " ")) ! (if message-id (insert message-id)) ! ;; The region must end with a newline to fill the region ! ;; without inserting extra newline. ! (fill-region-as-paragraph begin (1+ (point)))))) (defun nnheader-remove-header (header &optional is-regexp first) "Remove HEADER. --- 222,242 ---- (eobp) (widen)))) (defun nnheader-insert-references (references message-id) ! "Insert a References header based on REFERENCES and MESSAGE-ID." ! (if (and (not references) (not message-id)) ! () ; This is illegal, but not all articles have Message-IDs. ! (mail-position-on-field "References") ! (let ((begin (save-excursion (beginning-of-line) (point))) ! (fill-column 78) ! (fill-prefix "\t")) ! (if references (insert references)) ! (if (and references message-id) (insert " ")) ! (if message-id (insert message-id)) ! ;; Fold long References lines to conform to RFC1036 (sort of). ! ;; The region must end with a newline to fill the region ! ;; without inserting extra newline. ! (fill-region-as-paragraph begin (1+ (point)))))) (defun nnheader-remove-header (header &optional is-regexp first) "Remove HEADER. *************** *** 389,398 **** (point-max)))) number)) (defun nnheader-set-temp-buffer (name) (set-buffer (get-buffer-create name)) (buffer-disable-undo (current-buffer)) ! (erase-buffer)) (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files --- 261,292 ---- (point-max)))) number)) + (defun nnheader-replace-header (header new-value) + "Remove HEADER and insert the NEW-VALUE." + (save-excursion + (save-restriction + (nnheader-narrow-to-headers) + (prog1 + (nnheader-remove-header header) + (goto-char (point-max)) + (insert header ": " new-value "\n"))))) + + (defun nnheader-narrow-to-headers () + "Narrow to the head of an article." + (widen) + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (goto-char (point-min))) + (defun nnheader-set-temp-buffer (name) + "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." (set-buffer (get-buffer-create name)) (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (current-buffer)) (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files *************** *** 411,431 **** --- 305,436 ---- "Regexp that matches numerical full file paths.") (defun nnheader-file-to-number (file) + "Take a file name and return the article number." (if (not (boundp 'jka-compr-compression-info-list)) (string-to-int file) (string-match nnheader-numerical-short-files file) (string-to-int (match-string 0 file)))) (defun nnheader-directory-articles (dir) + "Return a list of all article files in a directory." (mapcar 'nnheader-file-to-number (directory-files dir nil nnheader-numerical-short-files t))) + (defun nnheader-article-to-file-alist (dir) + "Return an alist of article/file pairs in DIR." + (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) + (directory-files dir nil nnheader-numerical-short-files t))) + (defun nnheader-fold-continuation-lines () "Fold continuation lines in the current buffer." (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t))) + (defun nnheader-translate-file-chars (file) + (if (null nnheader-file-name-translation-alist) + ;; No translation is necessary. + file + ;; We translate -- but only the file name. We leave the directory + ;; alone. + (let* ((new (file-name-nondirectory file)) + (len (length new)) + (i 0) + trans) + (while (< i len) + (when (setq trans (cdr (assq (aref new i) + nnheader-file-name-translation-alist))) + (aset new i trans)) + (incf i)) + (concat (file-name-directory file) new)))) + + (defun nnheader-report (backend &rest args) + "Report an error from the BACKEND. + The first string in ARGS can be a format string." + (set (intern (format "%s-status-string" backend)) + (if (< (length args) 2) + (car args) + (apply 'format args))) + nil) + + (defun nnheader-get-report (backend) + (message "%s" (symbol-value (intern (format "%s-status-string" backend))))) + + (defun nnheader-insert (format &rest args) + "Clear the communicaton buffer and insert FORMAT and ARGS into the buffer. + If FORMAT isn't a format string, it and all ARGS will be inserted + without formatting." + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (if (string-match "%" format) + (insert (apply 'format format args)) + (apply 'insert format args)) + t)) + + (defun nnheader-mail-file-mbox-p (file) + "Say whether FILE looks like an Unix mbox file." + (when (and (file-exists-p file) + (file-readable-p file) + (file-regular-p file)) + (save-excursion + (nnheader-set-temp-buffer " *mail-file-mbox-p*") + (insert-file-contents-literally file) + (goto-char (point-min)) + (prog1 + (looking-at rmail-unix-mail-delimiter) + (kill-buffer (current-buffer)))))) + + (defun nnheader-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (if (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string)) + + (defun nnheader-file-to-group (file &optional top) + "Return a group name based on FILE and TOP." + (nnheader-replace-chars-in-string + (if (not top) + file + (condition-case () + (substring (expand-file-name file) + (length + (expand-file-name + (file-name-as-directory top)))) + (error ""))) + ?/ ?.)) + + (defun nnheader-message (level &rest args) + "Message if the Gnus backends are talkative." + (if (or (not (numberp gnus-verbose-backends)) + (<= level gnus-verbose-backends)) + (apply 'message args) + (apply 'format args))) + + (defun nnheader-be-verbose (level) + "Return whether the backends should be verbose on LEVEL." + (or (not (numberp gnus-verbose-backends)) + (<= level gnus-verbose-backends))) + + (defun nnheader-group-pathname (group dir &optional file) + "Make pathname for GROUP." + (concat + (let ((dir (file-name-as-directory (expand-file-name dir)))) + ;; If this directory exists, we use it directly. + (if (file-directory-p (concat dir group)) + (concat dir group "/") + ;; If not, we translate dots into slashes. + (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) + (cond ((null file) "") + ((numberp file) (int-to-string file)) + (t file)))) + (provide 'nnheader) ;;; nnheader.el ends here *** pub/sgnus/lisp/nnkiboze.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnkiboze.el Wed Jan 10 20:00:32 1996 *************** *** 1,5 **** ;;; nnkiboze.el --- select virtual news access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; nnkiboze.el --- select virtual news access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 151,159 **** (defun nnkiboze-close-group (group &optional server) (nnkiboze-possibly-change-newsgroups group) ;; Remove NOV lines of articles that are marked as read. ! (if (or (not (file-exists-p (nnkiboze-nov-file-name))) ! (not nnkiboze-remove-read-articles)) ! () (save-excursion (let ((unreads gnus-newsgroup-unreads) (unselected gnus-newsgroup-unselected) --- 151,159 ---- (defun nnkiboze-close-group (group &optional server) (nnkiboze-possibly-change-newsgroups group) ;; Remove NOV lines of articles that are marked as read. ! (when (and (file-exists-p (nnkiboze-nov-file-name)) ! nnkiboze-remove-read-articles ! (eq major-mode 'gnus-summary-mode)) (save-excursion (let ((unreads gnus-newsgroup-unreads) (unselected gnus-newsgroup-unselected) *************** *** 237,244 **** (defun nnkiboze-score-file (group) (list (expand-file-name ! (concat gnus-kill-files-directory nnkiboze-current-score-group ! "." gnus-score-file-suffix)))) (defun nnkiboze-generate-group (group) (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) --- 237,246 ---- (defun nnkiboze-score-file (group) (list (expand-file-name ! (concat (file-name-as-directory gnus-kill-files-directory) ! (nnheader-translate-file-chars ! (concat nnkiboze-current-score-group ! "." gnus-score-file-suffix)))))) (defun nnkiboze-generate-group (group) (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) *************** *** 391,398 **** (insert prefix))))))) (defun nnkiboze-nov-file-name () ! (concat nnkiboze-directory ! (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")) (provide 'nnkiboze) --- 393,401 ---- (insert prefix))))))) (defun nnkiboze-nov-file-name () ! (concat (file-name-as-directory nnkiboze-directory) ! (nnheader-translate-file-chars ! (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")))) (provide 'nnkiboze) *** pub/sgnus/lisp/nnmail.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnmail.el Tue Jan 16 19:42:46 1996 *************** *** 1,5 **** ;;; nnmail.el --- mail support functions for the Gnus mail backends ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail --- 1,5 ---- ;;; nnmail.el --- mail support functions for the Gnus mail backends ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail *************** *** 116,122 **** "*When using procmail (and the like), incoming mail is put in this directory. The Gnus mail backends will read the mail from this directory.") ! (defvar nnmail-procmail-suffix ".spool" "*Suffix of files created by procmail (and the like). This variable might be a suffix-regexp to match the suffixes of several files - eg. \".spool[0-9]*\".") --- 116,122 ---- "*When using procmail (and the like), incoming mail is put in this directory. The Gnus mail backends will read the mail from this directory.") ! (defvar nnmail-procmail-suffix "\\.spool" "*Suffix of files created by procmail (and the like). This variable might be a suffix-regexp to match the suffixes of several files - eg. \".spool[0-9]*\".") *************** *** 127,132 **** --- 127,138 ---- (defvar nnmail-delete-file-function 'delete-file "Function called to delete files in some mail backends.") + (defvar nnmail-crosspost-link-function 'add-name-to-file + "Function called to create a copy of a file. + This is `add-name-to-file' by default, which means that crossposts + will use hard links. If your file system doesn't allow hard + links, you could set this variable to `copy-file' instead.") + (defvar nnmail-movemail-program "movemail" "*A command to be executed to move mail from the inbox. The default is \"movemail\".") *************** *** 163,168 **** --- 169,180 ---- "*Hook called before treating incoming mail. The hook is run in a buffer with all the new, incoming mail.") + (defvar nnmail-pre-get-new-mail-hook nil + "Hook called just before starting to handle new incoming mail.") + + (defvar nnmail-post-get-new-mail-hook nil + "Hook called just after finishing handling new incoming mail.") + ;; Suggested by Mejia Pablo J . (defvar nnmail-tmp-directory nil "*If non-nil, use this directory for temporary storage when reading incoming mail.") *************** *** 235,242 **** (defvar nnmail-message-id-cache-file "~/.nnmail-cache" "*The file name of the nnmail Message-ID cache.") ! (defvar nnmail-delete-duplicates nil ! "*If non-nil, nnmail will delete any duplicate mails it sees.") ;;; Internal variables. --- 247,258 ---- (defvar nnmail-message-id-cache-file "~/.nnmail-cache" "*The file name of the nnmail Message-ID cache.") ! (defvar nnmail-treat-duplicates 'warn ! "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. ! Three values are legal: nil, which means that nnmail is not to keep a ! Message-ID cache; `warn', which means that nnmail should insert extra ! headers to warn the user about the duplication (this is the default); ! and `delete', which means that nnmail will delete duplicated mails.") ;;; Internal variables. *************** *** 258,285 **** (progn (insert-file-contents file) t) (file-error nil))) ! (defun nnmail-group-pathname (group mail-dir) "Make pathname for GROUP." ! (let ((mail-dir (file-name-as-directory (expand-file-name mail-dir)))) ! ;; If this directory exists, we use it directly. ! (if (or nnmail-use-long-file-names ! (file-directory-p (concat mail-dir group))) ! (concat mail-dir group "/") ! ;; If not, we translate dots into slashes. ! (concat mail-dir (nnmail-replace-chars-in-string group ?. ?/) "/")))) ! ! (defun nnmail-replace-chars-in-string (string from to) ! "Replace characters in STRING from FROM to TO." ! (let ((string (substring string 0)) ;Copy string. ! (len (length string)) ! (idx 0)) ! ;; Replace all occurrences of FROM with TO. ! (while (< idx len) ! (if (= (aref string idx) from) ! (aset string idx to)) ! (setq idx (1+ idx))) ! string)) ! (defun nnmail-date-to-time (date) "Convert DATE into time." (let* ((d1 (timezone-parse-date date)) --- 274,291 ---- (progn (insert-file-contents file) t) (file-error nil))) ! (defun nnmail-group-pathname (group dir &optional file) "Make pathname for GROUP." ! (concat ! (let ((dir (file-name-as-directory (expand-file-name dir)))) ! ;; If this directory exists, we use it directly. ! (if (or nnmail-use-long-file-names ! (file-directory-p (concat dir group))) ! (concat dir group "/") ! ;; If not, we translate dots into slashes. ! (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) ! (if file file ""))) ! (defun nnmail-date-to-time (date) "Convert DATE into time." (let* ((d1 (timezone-parse-date date)) *************** *** 429,434 **** --- 435,442 ---- (setq group (pop group-assoc)) (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) (car (car (cdr group)))))) + (unless (file-exists-p (file-name-directory file-name)) + (make-directory (file-name-directory file-name) t)) (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) (kill-buffer (current-buffer)))))) *************** *** 451,457 **** (let (start message-id content-length do-search end) (while (not (eobp)) (goto-char (point-min)) ! (re-search-forward " \n0, *unseen,+\n\\*\\*\\* EOOH \\*\\*\\*\n" nil t) (goto-char (match-end 0)) (delete-region (match-beginning 0) (match-end 0)) (setq start (point)) --- 459,466 ---- (let (start message-id content-length do-search end) (while (not (eobp)) (goto-char (point-min)) ! (re-search-forward ! " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t) (goto-char (match-end 0)) (delete-region (match-beginning 0) (match-end 0)) (setq start (point)) *************** *** 465,470 **** --- 474,483 ---- (setq message-id (buffer-substring (match-beginning 1) (match-end 1))) ;; There is no Message-ID here, so we create one. + (save-excursion + (when (re-search-backward "^Message-ID:" nil t) + (beginning-of-line) + (insert "Original-"))) (forward-line -1) (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))) *************** *** 501,511 **** (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) ! ;; If this is a duplicate message, then we do not save it. ! (if (nnmail-cache-id-exists-p message-id) ! (delete-region (point-min) (point-max)) ! (nnmail-cache-insert message-id) ! (funcall func)) (setq end (point-max)))) (goto-char end)))) --- 514,520 ---- (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) ! (nnmail-check-duplication message-id func) (setq end (point-max)))) (goto-char end)))) *************** *** 536,541 **** --- 545,554 ---- (goto-char (point-min)) (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) (setq message-id (match-string 1)) + (save-excursion + (when (re-search-backward "^Message-ID:" nil t) + (beginning-of-line) + (insert "Original-"))) ;; There is no Message-ID here, so we create one. (forward-line 1) (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) *************** *** 575,585 **** (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) ! ;; If this is a duplicate message, then we do not save it. ! (if (nnmail-cache-id-exists-p message-id) ! (delete-region (point-min) (point-max)) ! (nnmail-cache-insert message-id) ! (funcall func)) (setq end (point-max)))) (goto-char end))))) --- 588,594 ---- (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) ! (nnmail-check-duplication message-id func) (setq end (point-max)))) (goto-char end))))) *************** *** 610,615 **** --- 619,628 ---- (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) (setq message-id (match-string 1)) ;; There is no Message-ID here, so we create one. + (save-excursion + (when (re-search-backward "^Message-ID:" nil t) + (beginning-of-line) + (insert "Original-"))) (forward-line 1) (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) ;; Find the end of this article. *************** *** 623,633 **** (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) ! ;; If this is a duplicate message, then we do not save it. ! (if (nnmail-cache-id-exists-p message-id) ! (delete-region (point-min) (point-max)) ! (nnmail-cache-insert message-id) ! (funcall func)) (setq end (point-max)))) (goto-char end) (forward-line 2))))) --- 636,642 ---- (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) ! (nnmail-check-duplication message-id func) (setq end (point-max)))) (goto-char end) (forward-line 2))))) *************** *** 657,663 **** ;; 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 ((looking-at "\^L") (nnmail-process-babyl-mail-format func)) ((looking-at "\^A\^A\^A\^A") (nnmail-process-mmdf-mail-format func)) --- 666,673 ---- ;; 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)) *************** *** 927,933 **** (defvar nnmail-cache-buffer nil) (defun nnmail-cache-open () ! (if (or (not nnmail-delete-duplicates) (and nnmail-cache-buffer (buffer-name nnmail-cache-buffer))) () ; The buffer is open. --- 937,943 ---- (defvar nnmail-cache-buffer nil) (defun nnmail-cache-open () ! (if (or (not nnmail-treat-duplicates) (and nnmail-cache-buffer (buffer-name nnmail-cache-buffer))) () ; The buffer is open. *************** *** 941,951 **** (current-buffer)))) (defun nnmail-cache-close () ! (if (or (not nnmail-cache-buffer) ! (not nnmail-delete-duplicates) ! (not (buffer-name nnmail-cache-buffer)) ! (not (buffer-modified-p nnmail-cache-buffer))) ! () ; The buffer is closed. (save-excursion (set-buffer nnmail-cache-buffer) ;; Weed out the excess number of Message-IDs. --- 951,960 ---- (current-buffer)))) (defun nnmail-cache-close () ! (when (and nnmail-cache-buffer ! nnmail-treat-duplicates ! (buffer-name nnmail-cache-buffer) ! (buffer-modified-p nnmail-cache-buffer)) (save-excursion (set-buffer nnmail-cache-buffer) ;; Weed out the excess number of Message-IDs. *************** *** 963,985 **** (set-buffer-modified-p nil)))) (defun nnmail-cache-insert (id) ! (and nnmail-delete-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (insert id "\n")))) (defun nnmail-cache-id-exists-p (id) ! (and nnmail-delete-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (search-backward id nil t)))) (defun nnmail-get-value (&rest args) (let ((sym (intern (apply 'format args)))) ! (and (boundp sym) ! (symbol-value sym)))) (defun nnmail-get-new-mail (method exit-func temp &optional group spool-func) --- 972,1020 ---- (set-buffer-modified-p nil)))) (defun nnmail-cache-insert (id) ! (when nnmail-treat-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (insert id "\n")))) (defun nnmail-cache-id-exists-p (id) ! (when nnmail-treat-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (search-backward id nil t)))) ! ! (defun nnmail-check-duplication (message-id func) ! ;; If this is a duplicate message, then we do not save it. ! (let ((duplication (nnmail-cache-id-exists-p message-id))) ! (cond ! ((not duplication) ! (nnmail-cache-insert message-id) ! (funcall func)) ! ((eq nnmail-treat-duplicates 'delete) ! (delete-region (point-min) (point-max))) ! (t ! ;; We insert a warning. ! (let ((case-fold-search t) ! (newid (nnmail-message-id))) ! (goto-char (point-min)) ! (when (re-search-forward "^message-id:" nil t) ! (beginning-of-line) ! (insert "Original-")) ! (beginning-of-line) ! (insert "Message-ID: " newid "\n") ! (insert "Gnus-Warning: This is a duplication of message " ! message-id "\n") ! (nnmail-cache-insert newid) ! (funcall func)))))) ! ! ;;; Get new mail. (defun nnmail-get-value (&rest args) (let ((sym (intern (apply 'format args)))) ! (when (boundp sym) ! (symbol-value sym)))) (defun nnmail-get-new-mail (method exit-func temp &optional group spool-func) *************** *** 991,996 **** --- 1026,1033 ---- nnmail-spool-file) ;; We first activate all the groups. (nnmail-activate method) + ;; Allow the user to hook. + (run-hooks 'nnmail-pre-get-new-mail-hook) ;; The we go through all the existing spool files and split the ;; mail from each. (while spools *************** *** 1001,1008 **** (when (or (string-match "^po:" spool) (and (file-exists-p spool) (> (nth 7 (file-attributes (file-truename spool))) 0))) ! (when gnus-verbose-backends ! (message "%s: Reading incoming mail..." method)) (when (and (nnmail-move-inbox spool) (file-exists-p nnmail-crash-box)) ;; There is new mail. We first find out if all this mail --- 1038,1044 ---- (when (or (string-match "^po:" spool) (and (file-exists-p spool) (> (nth 7 (file-attributes (file-truename spool))) 0))) ! (nnheader-message 3 "%s: Reading incoming mail..." method) (when (and (nnmail-move-inbox spool) (file-exists-p nnmail-crash-box)) ;; There is new mail. We first find out if all this mail *************** *** 1031,1038 **** (when exit-func (funcall exit-func)) (run-hooks 'nnmail-read-incoming-hook) ! (when gnus-verbose-backends ! (message "%s: Reading incoming mail...done" method))) ;; Delete all the temporary files. (while incomings (setq incoming (pop incomings)) --- 1067,1075 ---- (when exit-func (funcall exit-func)) (run-hooks 'nnmail-read-incoming-hook) ! (nnheader-message 3 "%s: Reading incoming mail...done" method)) ! ;; Allow the user to hook. ! (run-hooks 'nnmail-post-get-new-mail-hook) ;; Delete all the temporary files. (while incomings (setq incoming (pop incomings)) *************** *** 1041,1054 **** (file-writable-p incoming) (delete-file incoming)))))) ! (defun nnmail-expired-article-p (group time force) "Say whether an article that is TIME old in GROUP should be expired." (if force t (let ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function group)) nnmail-expiry-wait))) ! (cond ((eq days 'never) ;; This isn't an expirable group. nil) ((eq days 'immediate) --- 1078,1093 ---- (file-writable-p incoming) (delete-file incoming)))))) ! (defun nnmail-expired-article-p (group time force &optional inhibit) "Say whether an article that is TIME old in GROUP should be expired." (if force t (let ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function group)) nnmail-expiry-wait))) ! (cond ((or (eq days 'never) ! (and (not force) ! inhibit)) ;; This isn't an expirable group. nil) ((eq days 'immediate) *** pub/sgnus/lisp/nnmbox.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnmbox.el Sat Jan 13 01:10:14 1996 *************** *** 1,5 **** ;;; nnmbox.el --- mail mbox access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nnmbox.el --- mail mbox access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 109,122 **** (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) ! gnus-verbose-backends ! (message "nnmbox: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! gnus-verbose-backends ! (message "nnmbox: Receiving headers...done")) (set-buffer nntp-server-buffer) (nnheader-fold-continuation-lines) --- 109,120 ---- (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) ! (nnheader-message 5 "nnmbox: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! (nnheader-message 5 "nnmbox: Receiving headers...done")) (set-buffer nntp-server-buffer) (nnheader-fold-continuation-lines) *************** *** 182,202 **** (nnmbox-article-group-number))))))) (defun nnmbox-request-group (group &optional server dont-check) ! (save-excursion ! (if (nnmbox-possibly-change-newsgroup group) ! (if dont-check ! t ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (let ((active (assoc group nnmbox-group-alist))) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- (cdr (car (cdr active))) ! (car (car (cdr active))))) ! (car (car (cdr active))) ! (cdr (car (cdr active))) ! (car active)))) ! t))))) (defun nnmbox-request-scan (&optional group server) (nnmbox-read-mbox) --- 180,202 ---- (nnmbox-article-group-number))))))) (defun nnmbox-request-group (group &optional server dont-check) ! (let ((active (assoc group nnmbox-group-alist))) ! (cond ! ((null (nnmbox-possibly-change-newsgroup group)) ! (nnheader-report 'nnmbox "No such group: %s" group)) ! (dont-check ! (nnheader-report 'nnmbox "Selected group %s" group) ! (nnheader-insert "")) ! ((> (car active) (cdr active)) ! (nnheader-report 'nnmbox "Empty group %s" group) ! (nnheader-insert "211 0 0 0 %s\n" group)) ! (t ! (nnheader-report 'nnmbox "Selected group %s" group) ! (nnheader-insert ! "211 %d %d %d %s\n" ! (1+ (- (cdadr active) (caadr active))) ! (cadr active) (cdadr active) (car active)) ! t)))) (defun nnmbox-request-scan (&optional group server) (nnmbox-read-mbox) *************** *** 253,261 **** (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn ! (and gnus-verbose-backends ! (message "Deleting article %d in %s..." ! (car articles) newsgroup)) (nnmbox-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) --- 253,260 ---- (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn ! (nnheader-message 5 "Deleting article %d in %s..." ! (car articles) newsgroup) (nnmbox-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) *************** *** 417,424 **** (not (buffer-name nnmbox-mbox-buffer))) (save-excursion (set-buffer (setq nnmbox-mbox-buffer ! (nnheader-find-file-noselect ! nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)))) (if (not nnmbox-group-alist) (nnmail-activate 'nnmbox)) --- 416,422 ---- (not (buffer-name nnmbox-mbox-buffer))) (save-excursion (set-buffer (setq nnmbox-mbox-buffer ! (find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)))) (if (not nnmbox-group-alist) (nnmail-activate 'nnmbox)) *************** *** 502,509 **** (let ((delim (concat "^" rmail-unix-mail-delimiter)) start end) (set-buffer (setq nnmbox-mbox-buffer ! (nnheader-find-file-noselect ! nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (re-search-forward delim nil t) --- 500,506 ---- (let ((delim (concat "^" rmail-unix-mail-delimiter)) start end) (set-buffer (setq nnmbox-mbox-buffer ! (find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (re-search-forward delim nil t) *** pub/sgnus/lisp/nnmh.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnmh.el Tue Jan 16 21:20:52 1996 *************** *** 1,5 **** ;;; nnmh.el --- mhspool access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nnmh.el --- mhspool access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 162,197 **** (defun nnmh-request-group (group &optional server dont-check) (let ((pathname (nnmail-group-pathname group nnmh-directory)) dir) ! (if (file-directory-p pathname) ! (progn ! (setq nnmh-current-directory pathname) ! (and nnmh-get-new-mail ! nnmh-be-safe ! (nnmh-update-gnus-unreads group)) ! (or dont-check ! (progn ! (setq dir ! (sort ! (mapcar ! (function ! (lambda (name) ! (string-to-int name))) ! (directory-files pathname nil "^[0-9]+$" t)) ! '<)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if dir ! (insert (format "211 %d %d %d %s\n" (length dir) ! (car dir) ! (progn (while (cdr dir) ! (setq dir (cdr dir))) ! (car dir)) ! group)) ! (insert (format "211 0 1 0 %s\n" group)))))) ! t) ! (setq nnmh-status-string "No such group") ! nil))) (defun nnmh-request-scan (&optional group server) (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) --- 162,196 ---- (defun nnmh-request-group (group &optional server dont-check) (let ((pathname (nnmail-group-pathname group nnmh-directory)) dir) ! (cond ! ((not (file-directory-p pathname)) ! (nnheader-report ! 'nnmh "Can't select group (no such directory): %s" group)) ! (t ! (setq nnmh-current-directory pathname) ! (and nnmh-get-new-mail ! nnmh-be-safe ! (nnmh-update-gnus-unreads group)) ! (cond ! (dont-check ! (nnheader-report 'nnmh "Selected group %s" group) ! t) ! (t ! (setq dir ! (sort ! (mapcar (lambda (name) (string-to-int name)) ! (directory-files pathname nil "^[0-9]+$" t)) ! '<)) ! (cond ! (dir ! (nnheader-report 'nnmh "Selected group %s" group) ! (nnheader-insert ! "211 %d %d %d %s\n" (length dir) (car dir) ! (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) ! group)) ! (t ! (nnheader-report 'nnmh "Empty group %s" group) ! (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) (defun nnmh-request-scan (&optional group server) (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) *************** *** 230,236 **** (string-match (file-truename (file-name-as-directory (expand-file-name nnmh-directory))) dir) ! (nnmail-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.)) (apply (function max) files) (apply (function min) files))))))) --- 229,235 ---- (string-match (file-truename (file-name-as-directory (expand-file-name nnmh-directory))) dir) ! (nnheader-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.)) (apply (function max) files) (apply (function min) files))))))) *************** *** 264,272 **** (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn ! (and gnus-verbose-backends ! (message "Deleting article %s in %s..." ! article newsgroup)) (condition-case () (funcall nnmail-delete-file-function article) (file-error --- 263,270 ---- (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn ! (nnheader-message 5 "Deleting article %s in %s..." ! article newsgroup) (condition-case () (funcall nnmail-delete-file-function article) (file-error *************** *** 319,325 **** (progn (write-region (point-min) (point-max) (concat nnmh-current-directory (int-to-string article)) ! nil (if gnus-verbose-backends nil 'nomesg)) t) (error nil)))) --- 317,323 ---- (progn (write-region (point-min) (point-max) (concat nnmh-current-directory (int-to-string article)) ! nil (if (nnheader-be-verbose 5) nil 'nomesg)) t) (error nil)))) *************** *** 351,359 **** (while articles (and (file-writable-p (car articles)) (progn ! (and gnus-verbose-backends ! (message (message "Deleting article %s in %s..." ! (car articles) group))) (funcall nnmail-delete-file-function (car articles)))) (setq articles (cdr articles)))) ;; Try to delete the directory itself. --- 349,356 ---- (while articles (and (file-writable-p (car articles)) (progn ! (nnheader-message 5 "Deleting article %s in %s..." ! (car articles) group) (funcall nnmail-delete-file-function (car articles)))) (setq articles (cdr articles)))) ;; Try to delete the directory itself. *************** *** 403,410 **** (while dirs (if (make-directory (directory-file-name (car dirs))) (error "Could not create directory %s" (car dirs))) ! (and gnus-verbose-backends ! (message "Creating mail directory %s" (car dirs))) (setq dirs (cdr dirs))))) (defun nnmh-save-mail (&optional noinsert) --- 400,406 ---- (while dirs (if (make-directory (directory-file-name (car dirs))) (error "Could not create directory %s" (car dirs))) ! (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) (defun nnmh-save-mail (&optional noinsert) *************** *** 428,434 **** (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. ! (add-name-to-file first file t) ;; Save the article. (write-region (point-min) (point-max) file nil nil) (setq first file))) --- 424,430 ---- (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. ! (funcall nnmail-crosspost-link-function first file t) ;; Save the article. (write-region (point-min) (point-max) file nil nil) (setq first file))) *** pub/sgnus/lisp/nnml.el Thu Dec 21 04:09:47 1995 --- sgnus/lisp/nnml.el Tue Jan 16 21:20:53 1996 *************** *** 1,5 **** ;;; nnml.el --- mail spool access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nnml.el --- mail spool access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 70,75 **** --- 70,76 ---- (defvar nnml-nov-buffer-alist nil) (defvar nnml-group-alist nil) (defvar nnml-active-timestamp nil) + (defvar nnml-article-file-alist nil) (defvar nnml-generate-active-function 'nnml-generate-active-info) *************** *** 109,120 **** (if (stringp (car sequence)) 'headers (nnml-possibly-change-directory newsgroup) (if (nnml-retrieve-headers-with-nov sequence fetch-old) 'nov (while sequence (setq article (car sequence)) ! (setq file ! (concat nnml-current-directory (int-to-string article))) (if (and (file-exists-p file) (not (file-directory-p file))) (progn --- 110,126 ---- (if (stringp (car sequence)) 'headers (nnml-possibly-change-directory newsgroup) + (unless nnml-article-file-alist + (setq nnml-article-file-alist + (nnheader-article-to-file-alist nnml-current-directory))) (if (nnml-retrieve-headers-with-nov sequence fetch-old) 'nov (while sequence (setq article (car sequence)) ! (setq file ! (concat nnml-current-directory ! (or (cdr (assq article nnml-article-file-alist)) ! ""))) (if (and (file-exists-p file) (not (file-directory-p file))) (progn *************** *** 133,146 **** (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) ! gnus-verbose-backends ! (message "nnml: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! gnus-verbose-backends ! (message "nnml: Receiving headers...done")) (nnheader-fold-continuation-lines) 'headers))))) --- 139,150 ---- (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) ! (nnheader-message 6 "nnml: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! (nnheader-message 6 "nnml: Receiving headers...done")) (nnheader-fold-continuation-lines) 'headers))))) *************** *** 176,218 **** (defun nnml-request-article (id &optional newsgroup server buffer) (nnml-possibly-change-directory newsgroup) ! (let* ((group-num (and (stringp id) (nnml-find-group-number id))) ! (number (if (numberp id) id (cdr group-num))) ! (file ! (and number ! (concat ! (if (numberp id) ! nnml-current-directory ! (nnmail-group-pathname (car group-num) nnml-directory)) ! (int-to-string number)))) ! (nntp-server-buffer (or buffer nntp-server-buffer))) ! (and file ! (file-exists-p file) ! (not (file-directory-p file)) ! (save-excursion (nnmail-find-file file)) ! ;; We return the article number. ! (cons newsgroup (string-to-int (file-name-nondirectory file)))))) (defun nnml-request-group (group &optional server dont-check) ! (if (not (nnml-possibly-change-directory group)) ! (progn ! (setq nnml-status-string "Invalid group (no such directory)") ! nil) ! (if dont-check ! t ! (nnmail-activate 'nnml) ! (let ((active (nth 1 (assoc group nnml-group-alist)))) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if (not active) ! () ! (insert (format "211 %d %d %d %s\n" ! (max (1+ (- (cdr active) (car active))) 0) ! (car active) (cdr active) group)) ! t)))))) (defun nnml-request-scan (&optional group server) (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) (defun nnml-close-group (group &optional server) --- 180,239 ---- (defun nnml-request-article (id &optional newsgroup server buffer) (nnml-possibly-change-directory newsgroup) ! (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) ! file path gpath group-num) ! (if (stringp id) ! (when (and (setq group-num (nnml-find-group-number id)) ! (setq file (cdr ! (assq (cdr group-num) ! (setq gpath ! (nnheader-article-to-file-alist ! (nnmail-group-pathname ! (car group-num) ! nnml-directory))))))) ! (setq path (concat gpath (int-to-string (cdr group-num))))) ! (unless nnml-article-file-alist ! (setq nnml-article-file-alist ! (nnheader-article-to-file-alist nnml-current-directory))) ! (when (setq file (cdr (assq id nnml-article-file-alist))) ! (setq path (concat nnml-current-directory file)))) ! (cond ! ((not path) ! (nnheader-report 'nnml "No such article: %s" id)) ! ((not (file-exists-p path)) ! (nnheader-report 'nnml "No such file: %s" path)) ! ((file-directory-p path) ! (nnheader-report 'nnml "File is a directory: %s" path)) ! ((not (save-excursion (nnmail-find-file path))) ! (nnheader-report 'nnml "Couldn't read file: %s" path)) ! (t ! (nnheader-report 'nnml "Article %s retrieved" id) ! ;; We return the article number. ! (cons newsgroup (string-to-int (file-name-nondirectory path))))))) (defun nnml-request-group (group &optional server dont-check) ! (cond ! ((not (nnml-possibly-change-directory group)) ! (nnheader-report 'nnml "Invalid group (no such directory)")) ! (dont-check ! (nnheader-report 'nnml "Group %s selected" group) ! t) ! (t ! (nnmail-activate 'nnml) ! (let ((active (nth 1 (assoc group nnml-group-alist)))) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if (not active) ! (nnheader-report 'nnml "No such group: %s" group) ! (insert (format "211 %d %d %d %s\n" ! (max (1+ (- (cdr active) (car active))) 0) ! (car active) (cdr active) group)) ! (nnheader-report 'nnml "Group %s selected" group) ! t)))))) (defun nnml-request-scan (&optional group server) + (setq nnml-article-file-alist nil) (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) (defun nnml-close-group (group &optional server) *************** *** 273,281 **** (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn ! (and gnus-verbose-backends ! (message "Deleting article %s in %s..." ! article newsgroup)) (condition-case () (funcall nnmail-delete-file-function article) (file-error --- 294,301 ---- (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn ! (nnheader-message 5 "Deleting article %s in %s..." ! article newsgroup) (condition-case () (funcall nnmail-delete-file-function article) (file-error *************** *** 346,352 **** (write-region (point-min) (point-max) (concat nnml-current-directory (int-to-string article)) ! nil (if gnus-verbose-backends nil 'nomesg)) t) (error nil))) () --- 366,372 ---- (write-region (point-min) (point-max) (concat nnml-current-directory (int-to-string article)) ! nil (if (nnheader-be-verbose 5) nil 'nomesg)) t) (error nil))) () *************** *** 390,397 **** (while articles (setq article (pop articles)) (when (file-writable-p article) ! (when gnus-verbose-backends ! (message "Deleting article %s in %s..." article group)) (funcall nnmail-delete-file-function article)))) ;; Try to delete the directory itself. (condition-case () --- 410,416 ---- (while articles (setq article (pop articles)) (when (file-writable-p article) ! (nnheader-message 5 "Deleting article %s in %s..." article group) (funcall nnmail-delete-file-function article)))) ;; Try to delete the directory itself. (condition-case () *************** *** 477,483 **** (read (current-buffer)) (error nil)))))) number)) - (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnml-nov-is-evil) --- 496,501 ---- *************** *** 507,519 **** (if (not (eobp)) (delete-region (point) (point-max))) t)))))) ! (defun nnml-possibly-change-directory (newsgroup &optional force) ! (if newsgroup ! (let ((pathname (nnmail-group-pathname newsgroup nnml-directory))) ! (and (or force (file-directory-p pathname)) ! (setq nnml-current-directory pathname ! nnml-current-group newsgroup))) ! t)) (defun nnml-possibly-create-directory (group) (let (dir dirs) --- 525,539 ---- (if (not (eobp)) (delete-region (point) (point-max))) t)))))) ! (defun nnml-possibly-change-directory (group &optional force) ! (when group ! (let ((pathname (nnmail-group-pathname group nnml-directory))) ! (when (or force ! (not (equal pathname nnml-current-directory))) ! (setq nnml-current-directory pathname ! nnml-current-group group ! nnml-article-file-alist nil)))) ! t) (defun nnml-possibly-create-directory (group) (let (dir dirs) *************** *** 523,530 **** (setq dir (file-name-directory (directory-file-name dir)))) (while dirs (make-directory (directory-file-name (car dirs))) ! (and gnus-verbose-backends ! (message "Creating mail directory %s" (car dirs))) (setq dirs (cdr dirs))))) (defun nnml-save-mail () --- 543,549 ---- (setq dir (file-name-directory (directory-file-name dir)))) (while dirs (make-directory (directory-file-name (car dirs))) ! (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) (defun nnml-save-mail () *************** *** 548,557 **** (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. ! (add-name-to-file first file t) ;; Save the article. (write-region (point-min) (point-max) file nil ! (if gnus-verbose-backends nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) ;; Generate a nov line for this article. We generate the nov --- 567,576 ---- (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. ! (funcall nnmail-crosspost-link-function first file t) ;; Save the article. (write-region (point-min) (point-max) file nil ! (if (nnheader-be-verbose 5) nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) ;; Generate a nov line for this article. We generate the nov *************** *** 641,654 **** (match-end 0))))) ;; [number subject from date id references chars lines xref] (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n" ! (or subject "(none)") ! (or from "(nobody)") (or date "") ! (or id (concat "nnml-dummy-id-" ! (mapconcat ! (lambda (time) (int-to-string time)) ! (current-time) "-"))) ! (or references "") ! (or chars 0) (or lines "0") (or xref "")))))) (defun nnml-open-nov (group) --- 660,668 ---- (match-end 0))))) ;; [number subject from date id references chars lines xref] (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n" ! (or subject "(none)") (or from "(nobody)") (or date "") ! (or id (nnmail-message-id)) ! (or references "") (or chars 0) (or lines "0") (or xref "")))))) (defun nnml-open-nov (group) *************** *** 713,721 **** (defun nnml-generate-active-info (dir) ;; Update the active info for this group. ! (let ((group (nnmail-replace-chars-in-string ! (substring dir (length nnml-directory)) ! ?/ ?.))) (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist)) (push (list group --- 727,734 ---- (defun nnml-generate-active-info (dir) ;; Update the active info for this group. ! (let ((group (nnheader-file-to-group ! (directory-file-name dir) nnml-directory))) (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist)) (push (list group *** pub/sgnus/lisp/nnsoup.el Thu Dec 21 04:09:48 1995 --- sgnus/lisp/nnsoup.el Fri Jan 12 12:34:46 1996 *************** *** 1,5 **** ;;; nnsoup.el --- SOUP access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nnsoup.el --- SOUP access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 330,337 **** ;; Ok, we delete this file. (when (condition-case nil (progn ! (when gnus-verbose-backends ! (message "Deleting %s..." (nnsoup-file prefix t))) (sit-for 1) (when (file-exists-p (nnsoup-file prefix)) (delete-file (nnsoup-file prefix))) --- 330,337 ---- ;; Ok, we delete this file. (when (condition-case nil (progn ! (nnheader-message ! 5 "Deleting %s..." (nnsoup-file prefix t)) (sit-for 1) (when (file-exists-p (nnsoup-file prefix)) (delete-file (nnsoup-file prefix))) *************** *** 567,575 **** (insert ?\n)) ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "\n")) ! (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) (if mail-aliases (expand-mail-aliases (point-min) delimline)) --- 567,576 ---- (insert ?\n)) ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) ! (if (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "\n") nil t) ! (replace-match "\n") ! (search-forward "\n\n" nil t)) (backward-char 1) (setq delimline (point-marker)) (if mail-aliases (expand-mail-aliases (point-min) delimline)) *************** *** 636,651 **** (gnus-soup-reply-prefix (car nnsoup-replies-list))))) (defun nnsoup-make-active () (let ((files (sort (directory-files nnsoup-directory t "IDX$") (lambda (f1 f2) (< (progn (string-match "/\\([0-9]+\\)\\." f1) ! (string-to-int (substring ! f1 (match-beginning 1) ! (match-end 1)))) (progn (string-match "/\\([0-9]+\\)\\." f2) ! (string-to-int (substring ! f2 (match-beginning 1) ! (match-end 1)))))))) active group lines ident elem min) (set-buffer (get-buffer-create " *nnsoup work*")) (buffer-disable-undo (current-buffer)) --- 637,650 ---- (gnus-soup-reply-prefix (car nnsoup-replies-list))))) (defun nnsoup-make-active () + "(Re-)create the SOUP active file." + (interactive) (let ((files (sort (directory-files nnsoup-directory t "IDX$") (lambda (f1 f2) (< (progn (string-match "/\\([0-9]+\\)\\." f1) ! (string-to-int (match-string 1 f1))) (progn (string-match "/\\([0-9]+\\)\\." f2) ! (string-to-int (match-string 1 f2))))))) active group lines ident elem min) (set-buffer (get-buffer-create " *nnsoup work*")) (buffer-disable-undo (current-buffer)) *************** *** 673,682 **** (vector ident group "ncm" "" lines)) (cdr elem)))) (setq files (cdr files))) (setq nnsoup-group-alist active) (while active (setcdr (car active) (nreverse (cdr (car active)))) ! (setq active (cdr active))))) (provide 'nnsoup) --- 672,683 ---- (vector ident group "ncm" "" lines)) (cdr elem)))) (setq files (cdr files))) + (message "") (setq nnsoup-group-alist active) (while active (setcdr (car active) (nreverse (cdr (car active)))) ! (setq active (cdr active))) ! (nnsoup-write-active-file))) (provide 'nnsoup) *** pub/sgnus/lisp/nnspool.el Thu Dec 21 04:09:48 1995 --- sgnus/lisp/nnspool.el Tue Jan 16 17:07:09 1996 *************** *** 1,5 **** ;;; nnspool.el --- spool access for GNU Emacs ! ;; Copyright (C) 1988,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; nnspool.el --- spool access for GNU Emacs ! ;; Copyright (C) 1988,89,90,93,94,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *************** *** 242,278 **** (let ((pathname (nnspool-article-pathname group)) dir) (if (not (file-directory-p pathname)) ! (progn ! (setq nnspool-status-string ! "Invalid group name (no such directory)") ! nil) (setq nnspool-current-directory pathname) ! (setq nnspool-status-string "") ! (if (not dont-check) (progn ! (setq dir (directory-files pathname nil "^[0-9]+$" t)) ! ;; yes, completely empty spool directories *are* possible ! ;; Fix by Sudish Joseph ! (and dir ! (setq dir ! (sort ! (mapcar ! (function ! (lambda (name) ! (string-to-int name))) ! dir) ! '<))) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if dir ! (insert ! (format "211 %d %d %d %s\n" (length dir) (car dir) ! (progn (while (cdr dir) (setq dir (cdr dir))) ! (car dir)) ! group)) ! (insert (format "211 0 0 0 %s\n" group)))))) ! t))) (defun nnspool-close-group (group &optional server) t) --- 242,277 ---- (let ((pathname (nnspool-article-pathname group)) dir) (if (not (file-directory-p pathname)) ! (nnheader-report ! 'nnspool "Invalid group name (no such directory): %s" group) (setq nnspool-current-directory pathname) ! (nnheader-report 'nnspool "Selected group %s" group) ! (if dont-check (progn ! (nnheader-report 'nnspool "Selected group %s" group) ! t) ! ;; Yes, completely empty spool directories *are* possible ! ;; Fix by Sudish Joseph ! (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) ! (setq dir ! (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if dir ! (progn ! (insert ! (format "211 %d %d %d %s\n" (length dir) (car dir) ! (progn (while (cdr dir) (setq dir (cdr dir))) ! (car dir)) ! group)) ! t) ! (insert (format "211 0 0 0 %s\n" group)) ! (nnheader-report 'nnspool "Empty group %s" group) ! t)))))) ! ! (defun nnspool-request-type (group &optional article) ! 'news) (defun nnspool-close-group (group &optional server) t) *************** *** 373,382 **** (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil ! (let ((nov (concat (file-name-as-directory nnspool-nov-directory) ! (nnspool-replace-chars-in-string ! nnspool-current-group ?. ?/) ! "/.overview"))) (if (not (file-exists-p nov)) () (save-excursion --- 372,379 ---- (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil ! (let ((nov (nnheader-group-pathname ! nnspool-current-group nnspool-nov-directory ".overview"))) (if (not (file-exists-p nov)) () (save-excursion *************** *** 447,453 **** (set-buffer (get-buffer-create " *nnspool work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) ! (call-process "grep" nil t nil id nnspool-history-file) (goto-char (point-min)) (prog1 (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") --- 444,452 ---- (set-buffer (get-buffer-create " *nnspool work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) ! (condition-case () ! (call-process "grep" nil t nil id nnspool-history-file) ! (error nil)) (goto-char (point-min)) (prog1 (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") *************** *** 476,512 **** (defun nnspool-article-pathname (group &optional article) "Find the path for GROUP." ! (concat ! (file-name-as-directory nnspool-spool-directory) ! (nnspool-replace-chars-in-string group ?. ?/) ! "/" ! (if article (int-to-string article) ""))) ! ! (defun nnspool-replace-chars-in-string (string from to) ! "Replace characters in STRING from FROM to TO." ! (let ((string (substring string 0)) ;Copy string. ! (len (length string)) ! (idx 0)) ! ;; Replace all occurrences of FROM with TO. ! (while (< idx len) ! (if (= (aref string idx) from) ! (aset string idx to)) ! (setq idx (1+ idx))) ! string)) ! ! (defun nnspool-number-base-10 (num pos) ! (if (<= pos 0) "" ! (setcdr num (+ (* (% (car num) 10) 65536) (cdr num))) ! (apply ! 'concat ! (reverse ! (list ! (char-to-string ! (aref "0123456789" (% (cdr num) 10))) ! (progn ! (setcdr num (/ (cdr num) 10)) ! (setcar num (/ (car num) 10)) ! (nnspool-number-base-10 num (1- pos)))))))) (defun nnspool-seconds-since-epoch (date) (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) --- 475,481 ---- (defun nnspool-article-pathname (group &optional article) "Find the path for GROUP." ! (nnheader-group-pathname group nnspool-spool-directory article)) (defun nnspool-seconds-since-epoch (date) (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) *** pub/sgnus/lisp/nntp.el Thu Dec 21 04:09:48 1995 --- sgnus/lisp/nntp.el Tue Jan 16 19:41:43 1996 *************** *** 1,5 **** ;;; nntp.el --- nntp access for Gnus ! ;; Copyright (C) 1987,88,89,90,92,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,5 ---- ;;; nntp.el --- nntp access for Gnus ! ;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *************** *** 64,69 **** --- 64,81 ---- do on servers that use strict access control.") (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) + (defvar nntp-server-action-alist + '(("nntpd 1\\.5\\.11t" + (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))) + "Alist of regexps to match on server types and actions to be taken. + For instance, if you want Gnus to beep every time you connect + to innd, you could say something like: + + \(setq nntp-server-action-alist + '((\"innd\" (ding)))) + + You probably don't want to do that, though.") + (defvar nntp-open-server-function 'nntp-open-network-stream "*Function used for connecting to a remote system. It will be called with the address of the remote system. *************** *** 168,173 **** --- 180,186 ---- (defvar nntp-server-xover 'try) (defvar nntp-server-list-active-group 'try) (defvar nntp-current-group "") + (defvar nntp-server-type nil) (defvar nntp-async-process nil) (defvar nntp-async-buffer nil) *************** *** 194,199 **** --- 207,213 ---- (nntp-news-default-headers ,nntp-news-default-headers) (nntp-prepare-server-hook ,nntp-prepare-server-hook) (nntp-async-number ,nntp-async-number) + (nntp-server-type nil) (nntp-async-process nil) (nntp-async-buffer nil) (nntp-async-articles nil) *************** *** 500,505 **** --- 514,522 ---- (nntp-send-command "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) + (defun nntp-request-type (group &optional article) + 'news) + (defun nntp-request-group (group &optional server dont-check) "Select GROUP." (setq nntp-current-group *************** *** 1063,1089 **** "Open connection to news server on SERVER by SERVICE (default is nntp)." (let (proc) (save-excursion - ;; Use TCP/IP stream emulation package if needed. - (or (fboundp 'open-network-stream) - (require 'tcp)) - ;; Initialize communication buffer. - (nnheader-init-server-buffer) (set-buffer nntp-server-buffer) ! (if (setq proc ! (condition-case nil ! (funcall nntp-open-server-function server) ! (error nil))) ! (progn ! (setq nntp-server-process proc) ! ;; Suggested by Hallvard B Furuseth . ! (process-kill-without-query proc) ! (setq nntp-address server) ! ;; It is possible to change kanji-fileio-code in this hook. ! (run-hooks 'nntp-server-hook) ! (push proc nntp-opened-connections) ! nntp-server-process) ! (setq nntp-status-string (format "Couldn't open server %s" server)) ! nil)))) (defun nntp-open-network-stream (server) (open-network-stream --- 1080,1117 ---- "Open connection to news server on SERVER by SERVICE (default is nntp)." (let (proc) (save-excursion (set-buffer nntp-server-buffer) ! (cond ! ((setq proc ! (condition-case nil ! (funcall nntp-open-server-function server) ! (error nil))) ! (setq nntp-server-process proc) ! (setq nntp-address server) ! ;; Suggested by Hallvard B Furuseth . ! (process-kill-without-query proc) ! (run-hooks 'nntp-server-hook) ! (push proc nntp-opened-connections) ! (nntp-read-server-type) ! nntp-server-process) ! (t ! (nnheader-report 'nntp (format "Couldn't open server %s" server))))))) ! ! (defun nntp-read-server-type () ! "Find out what the name of the server we have connected to is." ! ;; Wait for the status string to arrive. ! (nntp-wait-for-response "^.*\n") ! (setq nntp-server-type (buffer-string)) ! (let ((alist nntp-server-action-alist) ! entry) ! ;; Run server-specific commmands. ! (while alist ! (setq entry (pop alist)) ! (when (string-match (car entry) nntp-server-type) ! (if (and (listp (cadr entry)) ! (not (eq 'lambda (caadr entry)))) ! (eval (cadr entry)) ! (funcall (cadr entry))))))) (defun nntp-open-network-stream (server) (open-network-stream *************** *** 1143,1149 **** (sleep-for 1) (message "")) (condition-case errorcode ! (accept-process-output nntp-server-process) (error (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode)) --- 1171,1177 ---- (sleep-for 1) (message "")) (condition-case errorcode ! (accept-process-output nntp-server-process 1) (error (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode)) *** pub/sgnus/lisp/nnvirtual.el Thu Dec 21 04:09:48 1995 --- sgnus/lisp/nnvirtual.el Tue Jan 9 21:37:06 1996 *************** *** 1,5 **** ;;; nnvirtual.el --- virtual newsgroups access for Gnus ! ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA --- 1,5 ---- ;;; nnvirtual.el --- virtual newsgroups access for Gnus ! ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA *************** *** 33,38 **** --- 33,45 ---- (require 'nnheader) (require 'gnus) + (defvar nnvirtual-always-rescan nil + "*If non-nil, always scan groups for unread articles when entering a group. + If this variable is nil (which is the default) and you read articles + in a component group after the virtual group has been activated, the + read articles from the component group will show up when you enter the + virtual group.") + (defconst nnvirtual-version "nnvirtual 1.0" *************** *** 40,108 **** (defvar nnvirtual-group-alist nil) (defvar nnvirtual-current-group nil) ! (defvar nnvirtual-current-groups nil) ! (defvar nnvirtual-current-mapping nil) ! ! (defvar nnvirtual-do-not-open nil) (defvar nnvirtual-status-string "") ;;; Interface functions. ! (defun nnvirtual-retrieve-headers (sequence &optional newsgroup server fetch-old) ! "Retrieve the headers for the articles in SEQUENCE." ! (nnvirtual-possibly-change-newsgroups newsgroup server t) ! (save-excursion ! (set-buffer (get-buffer-create "*virtual headers*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (if (stringp (car sequence)) ! 'headers ! (let ((map nnvirtual-current-mapping) ! (offset 0) ! articles beg group active top article result prefix ! fetched-articles group-method) ! (while sequence ! (while (< (car (car map)) (car sequence)) ! (setq offset (car (car map))) ! (setq map (cdr map))) ! (setq top (car (car map))) ! (setq group (nth 1 (car map))) ! (setq prefix (gnus-group-real-prefix group)) ! (setq active (nth 2 (car map))) ! (setq articles nil) ! (while (and sequence (<= (car sequence) top)) ! (setq articles (cons (- (+ active (car sequence)) offset) ! articles)) ! (setq sequence (cdr sequence))) ! (setq articles (nreverse articles)) ! (if (and articles ! (setq result ! (progn ! (setq group-method ! (gnus-find-method-for-group group)) ! (and (or (gnus-server-opened group-method) ! (gnus-open-server group-method)) ! (gnus-request-group group t) ! (gnus-retrieve-headers articles group))))) ! (save-excursion ! (set-buffer nntp-server-buffer) ;; If we got HEAD headers, we convert them into NOV ! ;; headers. This is slow, inefficient and, come to think ! ;; of it, downright evil. So sue me. I couldn't be ;; bothered to write a header parse routine that could ;; parse a mixed HEAD/NOV buffer. ! (and (eq result 'headers) (nnvirtual-convert-headers)) (goto-char (point-min)) - (setq fetched-articles nil) (while (not (eobp)) ! (setq beg (point) ! article (read nntp-server-buffer) ! fetched-articles (cons article fetched-articles)) ! (delete-region beg (point)) ! (insert (int-to-string (+ (- article active) offset))) (beginning-of-line) (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") --- 47,97 ---- (defvar nnvirtual-group-alist nil) (defvar nnvirtual-current-group nil) ! (defvar nnvirtual-component-groups nil) ! (defvar nnvirtual-mapping nil) (defvar nnvirtual-status-string "") + (eval-and-compile + (autoload 'gnus-cache-articles-in-group "gnus-cache")) + ;;; Interface functions. ! (defun nnvirtual-retrieve-headers (articles &optional newsgroup server fetch-old) ! (when (nnvirtual-possibly-change-group newsgroup server t) ! (save-excursion ! (if (stringp (car articles)) ! 'headers ! (let ((map nnvirtual-mapping) ! (vbuf (nnheader-set-temp-buffer ! (get-buffer-create " *virtual headers*"))) ! (unfetched (mapcar (lambda (g) (list g)) ! nnvirtual-component-groups)) ! beg cgroup active article result prefix) ! (while articles ! (setq article (assq (pop articles) nnvirtual-mapping)) ! (setq cgroup (cadr article)) ! (gnus-request-group cgroup t) ! (setq prefix (gnus-group-real-prefix cgroup)) ! (when (setq result (gnus-retrieve-headers ! (list (caddr article)) cgroup)) ! (set-buffer nntp-server-buffer) ! (if (zerop (buffer-size)) ! (nconc (assq cgroup unfetched) (caddr article)) ;; If we got HEAD headers, we convert them into NOV ! ;; headers. This is slow, inefficient and, come to think ! ;; of it, downright evil. So sue me. I couldn't be ;; bothered to write a header parse routine that could ;; parse a mixed HEAD/NOV buffer. ! (when (eq result 'headers) ! (nnvirtual-convert-headers)) (goto-char (point-min)) (while (not (eobp)) ! (delete-region ! (point) (progn (read nntp-server-buffer) (point))) ! (insert (int-to-string (car article))) (beginning-of-line) (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") *************** *** 119,125 **** (or (= (char-after (1- (point))) ?\t) (insert ?\t)) (insert (format "Xref: %s %s:%d\t" (system-name) ! group article))) (if (not (string= "" prefix)) (while (re-search-forward "[^ ]+:[0-9]+" --- 108,114 ---- (or (= (char-after (1- (point))) ?\t) (insert ?\t)) (insert (format "Xref: %s %s:%d\t" (system-name) ! cgroup (caddr article)))) (if (not (string= "" prefix)) (while (re-search-forward "[^ ]+:[0-9]+" *************** *** 130,247 **** (end-of-line) (or (= (char-after (1- (point))) ?\t) (insert ?\t))) ! (forward-line 1)))) ! (goto-char (point-max)) ! (insert-buffer-substring nntp-server-buffer) ! ;; We have now massaged and inserted the headers from one ! ;; group. In case some of the articles have expired or been ! ;; cancelled, we have to mark them as read in the component ! ;; group. ! (let ((unfetched (gnus-sorted-complement ! articles (nreverse fetched-articles)))) ! (and unfetched ! (gnus-group-make-articles-read group unfetched)))) ! ;; The headers are ready for reading, so they are inserted into ! ;; the nntp-server-buffer, which is where Gnus expects to find ! ;; them. ! (prog1 ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring "*virtual headers*") ! 'nov) ! (kill-buffer (current-buffer))))))) ! (defun nnvirtual-open-server (newsgroups &optional something) ! "Open a virtual newsgroup that contains NEWSGROUPS." (nnheader-init-server-buffer)) (defun nnvirtual-close-server (&rest dum) - "Close news server." t) (defun nnvirtual-request-close () (setq nnvirtual-current-group nil ! nnvirtual-current-groups nil ! nnvirtual-current-mapping nil nnvirtual-group-alist nil) t) (defun nnvirtual-server-opened (&optional server) - "Return server process status, T or NIL. - If the stream is opened, return T, otherwise return NIL." (and nntp-server-buffer (get-buffer nntp-server-buffer))) (defun nnvirtual-status-message (&optional server) - "Return server status response as string." nnvirtual-status-string) ! (defun nnvirtual-request-article (article &optional newsgroup server buffer) ! "Select article by message number." ! (nnvirtual-possibly-change-newsgroups newsgroup server t) ! (and (numberp article) ! (let ((map nnvirtual-current-mapping) ! (offset 0) ! group-method) ! (while (< (car (car map)) article) ! (setq offset (car (car map))) ! (setq map (cdr map))) ! (setq group-method (gnus-find-method-for-group (nth 1 (car map)))) ! (or (gnus-server-opened group-method) ! (gnus-open-server group-method)) ! (gnus-request-group (nth 1 (car map)) t) ! (gnus-request-article (- (+ (nth 2 (car map)) article) offset) ! (nth 1 (car map)) buffer)))) (defun nnvirtual-request-group (group &optional server dont-check) ! "Make GROUP the current newsgroup." ! (nnvirtual-possibly-change-newsgroups group server dont-check) ! (let ((map nnvirtual-current-mapping)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if map ! (progn ! (while (cdr map) ! (setq map (cdr map))) ! (insert (format "211 %d 1 %d %s\n" (car (car map)) ! (car (car map)) group)) ! t) ! (setq nnvirtual-status-string "No component groups") ! (setq nnvirtual-current-group nil) ! nil)))) (defun nnvirtual-request-type (group &optional article) ! (nnvirtual-possibly-change-newsgroups group nil) ! (if (not article) ! 'unknown ! (gnus-request-type (car (nnvirtual-art-group article))))) (defun nnvirtual-close-group (group &optional server) ! (if (not nnvirtual-current-group) ! () ! (nnvirtual-possibly-change-newsgroups group server t) (nnvirtual-update-marked) (setq nnvirtual-current-group nil ! nnvirtual-current-groups nil ! nnvirtual-current-mapping nil) (setq nnvirtual-group-alist ! (delq (assoc group nnvirtual-group-alist) nnvirtual-group-alist)))) ! (defun nnvirtual-request-list (&optional server) ! (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.") ! nil) (defun nnvirtual-request-newgroups (date &optional server) ! "List new groups." ! (setq nnvirtual-status-string "NEWGROUPS is not supported.") ! nil) (defun nnvirtual-request-list-newsgroups (&optional server) ! (setq nnvirtual-status-string ! "nnvirtual: LIST NEWSGROUPS is not implemented.") ! nil) ;;; Internal functions. --- 119,280 ---- (end-of-line) (or (= (char-after (1- (point))) ?\t) (insert ?\t))) ! (forward-line 1)) ! (set-buffer vbuf) ! (goto-char (point-max)) ! (insert-buffer-substring nntp-server-buffer)))) ! ! ;; In case some of the articles have expired or been ! ;; cancelled, we have to mark them as read in the ! ;; component group. ! (while unfetched ! (when (cdar unfetched) ! (gnus-group-make-articles-read ! (caar unfetched) (sort (cdar unfetched) '<))) ! (setq unfetched (cdr unfetched))) ! ! ;; The headers are ready for reading, so they are inserted into ! ;; the nntp-server-buffer, which is where Gnus expects to find ! ;; them. ! (prog1 ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring vbuf) ! 'nov) ! (kill-buffer vbuf))))))) ! (defun nnvirtual-open-server (server &optional something) (nnheader-init-server-buffer)) (defun nnvirtual-close-server (&rest dum) t) (defun nnvirtual-request-close () (setq nnvirtual-current-group nil ! nnvirtual-component-groups nil ! nnvirtual-mapping nil nnvirtual-group-alist nil) t) (defun nnvirtual-server-opened (&optional server) (and nntp-server-buffer (get-buffer nntp-server-buffer))) (defun nnvirtual-status-message (&optional server) nnvirtual-status-string) ! (defun nnvirtual-request-article (article &optional group server buffer) ! (when (and (nnvirtual-possibly-change-group group server t) ! (numberp article)) ! (let* ((amap (assq article nnvirtual-mapping)) ! (cgroup (cadr amap))) ! (cond ! ((not amap) ! (nnheader-report 'nnvirtual "No such article: %s" article)) ! ((not (gnus-check-group cgroup)) ! (nnheader-report ! 'nnvirtual "Can't open server where %s exists" cgroup)) ! ((not (gnus-request-group cgroup t)) ! (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) ! (t ! (if buffer ! (save-excursion ! (set-buffer buffer) ! (gnus-request-article-this-buffer (caddr amap) cgroup)) ! (gnus-request-article (caddr amap) cgroup))))))) (defun nnvirtual-request-group (group &optional server dont-check) ! (cond ! ((null (nnvirtual-possibly-change-group ! group server ! (if nnvirtual-always-rescan nil dont-check))) ! (setq nnvirtual-current-group nil) ! (nnheader-report 'nnvirtual "No component groups in %s" group)) ! (t ! (let ((len (length nnvirtual-mapping))) ! (nnheader-insert "211 %d 1 %d %s\n" len len group))))) (defun nnvirtual-request-type (group &optional article) ! (when (nnvirtual-possibly-change-group group nil t) ! (if (not article) ! 'unknown ! (let ((mart (assq article nnvirtual-mapping))) ! (when mart ! (gnus-request-type (cadr mart) (car mart))))))) ! ! (defun nnvirtual-request-update-mark (group article mark) ! (when (nnvirtual-possibly-change-group group nil t) ! (let* ((nart (assq article nnvirtual-mapping)) ! (cgroup (cadr nart)) ! ;; The component group might be a virtual group. ! (nmark (gnus-request-update-mark cgroup (caddr nart) mark))) ! (when (and (= mark nmark) ! (gnus-group-auto-expirable-p cgroup)) ! (setq mark gnus-expirable-mark)))) ! mark) (defun nnvirtual-close-group (group &optional server) ! (when (nnvirtual-possibly-change-group group server t) ! ;; We copy the marks from this group to the component ! ;; groups here. (nnvirtual-update-marked) + ;; Reset all relevant variables. (setq nnvirtual-current-group nil ! nnvirtual-component-groups nil ! nnvirtual-mapping nil) (setq nnvirtual-group-alist ! (delq (assoc group nnvirtual-group-alist) nnvirtual-group-alist))) ! t) ! (defun nnvirtual-request-list (&optional server) ! (nnheader-report 'nnvirtual "LIST is not implemented.")) (defun nnvirtual-request-newgroups (date &optional server) ! (nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) (defun nnvirtual-request-list-newsgroups (&optional server) ! (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented.")) ! ! (defun nnvirtual-request-update-info (group info &optional server) ! (when (nnvirtual-possibly-change-group group server) ! (let ((map nnvirtual-mapping) ! (marks (mapcar (lambda (m) (list (cdr m))) gnus-article-mark-lists)) ! reads marks mr m op) ! (while map ! (setq m (pop map)) ! (unless (nth 3 m) ! (push (car m) reads)) ! (when (setq mr (nth 4 m)) ! (while mr ! (setcdr (setq op (assq (pop mr) marks)) (cons (car m) (cdr op)))))) ! (setq mr marks) ! (while mr ! (setcdr (car mr) (gnus-compress-sequence (sort (cdar mr) '<))) ! (setq mr (cdr mr))) ! (setcar (cddr info) (gnus-compress-sequence (nreverse reads))) ! ! ;; Enter these new marks into the info of the group. ! (if (nthcdr 3 info) ! (setcar (nthcdr 3 info) marks) ! ;; Add the marks lists to the end of the info. ! (when marks ! (setcdr (nthcdr 2 info) (list marks)))) ! t))) ! ! (defun nnvirtual-catchup-group (group &optional server all) ! (nnvirtual-possibly-change-group group server t) ! (let ((gnus-group-marked nnvirtual-component-groups) ! (gnus-expert-user t)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-group-catchup-current nil all)))) ! ! (defun nnvirtual-find-group-art (group article) ! "Return the real group and article for virtual GROUP and ARTICLE." ! (nnvirtual-possibly-change-group group nil t) ! (let ((mart (assq article nnvirtual-mapping))) ! (cons (cadr mart) (caddr mart)))) ;;; Internal functions. *************** *** 254,261 **** (headers (gnus-get-newsgroup-headers dependencies)) header) (erase-buffer) ! (while headers ! (setq header (pop headers)) (insert (int-to-string (mail-header-number header)) "\t" (or (mail-header-subject header) "") "\t" (or (mail-header-from header) "") "\t" --- 287,293 ---- (headers (gnus-get-newsgroup-headers dependencies)) header) (erase-buffer) ! (while (setq header (pop headers)) (insert (int-to-string (mail-header-number header)) "\t" (or (mail-header-subject header) "") "\t" (or (mail-header-from header) "") "\t" *************** *** 268,473 **** (concat "Xref: " (mail-header-xref header) "\t") "") "\n"))))) ! (defun nnvirtual-possibly-change-newsgroups (group regexp &optional check) (let ((inf t)) ! (or (not group) ! (and nnvirtual-current-group ! (string= group nnvirtual-current-group)) ! (and (setq inf (assoc group nnvirtual-group-alist)) ! (string= (nth 3 inf) regexp) ! (progn ! (setq nnvirtual-current-group (car inf)) ! (setq nnvirtual-current-groups (nth 1 inf)) ! (setq nnvirtual-current-mapping (nth 2 inf))))) ! (if (or (not check) (not inf)) ! (progn ! (and inf (setq nnvirtual-group-alist ! (delq inf nnvirtual-group-alist))) ! (setq nnvirtual-current-mapping nil) ! (setq nnvirtual-current-group group) ! (let ((newsrc gnus-newsrc-alist) ! (virt-group (gnus-group-prefixed-name ! nnvirtual-current-group '(nnvirtual "")))) ! (setq nnvirtual-current-groups nil) ! (while newsrc ! (and (string-match regexp (car (car newsrc))) ! (not (string= (car (car newsrc)) virt-group)) ! (setq nnvirtual-current-groups ! (cons (car (car newsrc)) nnvirtual-current-groups))) ! (setq newsrc (cdr newsrc)))) ! (if nnvirtual-current-groups ! (progn ! (nnvirtual-create-mapping group) ! (setq nnvirtual-group-alist ! (cons (list group nnvirtual-current-groups ! nnvirtual-current-mapping regexp) ! nnvirtual-group-alist))) ! (setq nnvirtual-status-string ! (format ! "nnvirtual: No newsgroups for this virtual newsgroup")))))) ! nnvirtual-current-groups) ! ! (defun nnvirtual-create-mapping (group) ! (let* ((group (gnus-group-prefixed-name group (list 'nnvirtual ""))) ! (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) ! (groups nnvirtual-current-groups) ! (offset 0) ! reads unread igroup itotal ireads) ! ;; The virtual group doesn't exist. (?) ! (or info (error "No such group: %s" group)) ! (setq nnvirtual-current-mapping nil) ! (while groups ! ;; Added by Sudish Joseph . ! (setq igroup (car groups)) ! (let ((info (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb))) ! (active (gnus-gethash igroup gnus-active-hashtb))) ! ;; See if the group has had its active list read this session ! ;; if not, we do it now. ! (if (null active) ! (if (gnus-activate-group igroup) ! (progn ! (gnus-get-unread-articles-in-group ! info (gnus-gethash igroup gnus-active-hashtb)) ! (setq active (gnus-gethash igroup gnus-active-hashtb))) ! (message "Couldn't open component group %s" igroup))) ! (if (null active) ! () ! ;; And then we do the mapping for this component group. If ! ;; you feel tempted to cast your eyes to the soup below - ! ;; don't. It'll hurt your soul. Suffice to say that it ! ;; assigns ranges of nnvirtual article numbers to the ! ;; different component groups. To get the article number ! ;; from the nnvirtual number, one does something like ! ;; (+ (- number offset) (car active)), where `offset' is the ! ;; slice the mess below assigns, and active is the lowest ! ;; active article in the component group. ! (setq itotal (1+ (- (cdr active) (car active)))) ! (if (setq ireads (nth 2 info)) ! (let ((itreads ! (if (not (listp (cdr ireads))) ! (setq ireads (list (cons (car ireads) (cdr ireads)))) ! (setq ireads (copy-alist ireads))))) ! (if (< (or (and (numberp (car ireads)) (car ireads)) ! (cdr (car ireads))) (car active)) ! (setq ireads (setq itreads (cdr ireads)))) ! (if (and ireads (< (or (and (numberp (car ireads)) ! (car ireads)) ! (car (car ireads))) (car active))) ! (setcar (or (and (numberp (car ireads)) ireads) ! (car ireads)) (1+ (car active)))) ! (while itreads ! (setcar (or (and (numberp (car itreads)) itreads) ! (car itreads)) ! (+ (max ! 1 (- (if (numberp (car itreads)) ! (car itreads) ! (car (car itreads))) ! (car active))) ! offset)) ! (if (not (numberp (car itreads))) ! (setcdr (car itreads) ! (+ (- (cdr (car itreads)) (car active)) offset))) ! (setq itreads (cdr itreads))) ! (setq reads (nconc reads ireads)))) ! (setq offset (+ offset (1- itotal))) ! (setq nnvirtual-current-mapping ! (cons (list offset igroup (car active)) ! nnvirtual-current-mapping))) ! (setq groups (cdr groups)))) ! (setq nnvirtual-current-mapping ! (nreverse nnvirtual-current-mapping)) ! ;; Set Gnus active info. ! (gnus-sethash group (cons 1 (1- offset)) gnus-active-hashtb) ! ;; Set Gnus read info. ! (setcar (nthcdr 2 info) reads) ! ! ;; Then we deal with the marks. ! (let ((map nnvirtual-current-mapping) ! (marks '(tick dormant reply expire score)) ! (offset 0) ! tick dormant reply expire score marked active) ! (while map ! (setq igroup (nth 1 (car map))) ! (setq active (nth 2 (car map))) ! (setq marked (nth 3 (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb)))) ! (let ((m marks)) ! (while m ! (and (assq (car m) marked) ! (set (car m) ! (nconc (mapcar ! (lambda (art) ! (if (numberp art) ! (if (< art active) ! 0 (+ (- art active) offset)) ! (cons (+ (- (car art) active) offset) ! (cdr art)))) ! (cdr (assq (car m) marked))) ! (symbol-value (car m))))) ! (setq m (cdr m)))) ! (setq offset (car (car map))) ! (setq map (cdr map))) ! ;; Put the list of marked articles in the info of the virtual group. ! (let ((m marks) ! marked) ! (while m ! (and (symbol-value (car m)) ! (setq marked (cons (cons (car m) (symbol-value (car m))) ! marked))) ! (setq m (cdr m))) ! (if (nthcdr 3 info) ! (setcar (nthcdr 3 info) marked) ! (setcdr (nthcdr 2 info) (list marked))))))) (defun nnvirtual-update-marked () ! (let ((mark-lists '((gnus-newsgroup-marked . tick) ! (gnus-newsgroup-dormant . dormant) ! (gnus-newsgroup-expirable . expire) ! (gnus-newsgroup-replied . reply))) ! marks art-group group-alist g) (while mark-lists ! (setq marks (symbol-value (car (car mark-lists)))) ! ;; Find out what groups the mark belong to. ! (while marks ! (setq art-group (nnvirtual-art-group (car marks))) ! (if (setq g (assoc (car art-group) group-alist)) ! (nconc g (list (cdr art-group))) ! (setq group-alist (cons (list (car art-group) (cdr art-group)) ! group-alist))) ! (setq marks (cdr marks))) ! ;; The groups that don't have marks must have no marks. (Yup.) ! (let ((groups nnvirtual-current-groups)) ! (while groups ! (or (assoc (car groups) group-alist) ! (setq group-alist (cons (list (car groups)) group-alist))) ! (setq groups (cdr groups)))) ! ;; The we update the list of marks. ! (while group-alist ! (gnus-add-marked-articles ! (car (car group-alist)) (cdr (car mark-lists)) ! (cdr (car group-alist)) nil t) ! (gnus-group-update-group (car (car group-alist)) t) ! (setq group-alist (cdr group-alist))) ! (setq mark-lists (cdr mark-lists))))) ! ! (defun nnvirtual-art-group (article) ! (let ((map nnvirtual-current-mapping) ! (offset 0)) ! (while (< (car (car map)) (if (numberp article) article (car article))) ! (setq offset (car (car map)) ! map (cdr map))) ! (cons (nth 1 (car map)) ! (if (numberp article) ! (- (+ article (nth 2 (car map))) offset) ! (cons (- (+ (car article) (nth 2 (car map))) offset) ! (cdr article)))))) ! ! (defun nnvirtual-catchup-group (group &optional server all) ! (nnvirtual-possibly-change-newsgroups group server) ! (let ((gnus-group-marked nnvirtual-current-groups) ! (gnus-expert-user t)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-group-catchup-current nil all)))) (provide 'nnvirtual) --- 300,402 ---- (concat "Xref: " (mail-header-xref header) "\t") "") "\n"))))) ! (defun nnvirtual-possibly-change-group (group regexp &optional dont-check) (let ((inf t)) ! (unless (equal group nnvirtual-current-group) ! (and (setq inf (assoc group nnvirtual-group-alist)) ! regexp ! (string= (nth 3 inf) regexp) ! (progn ! (setq nnvirtual-current-group (car inf)) ! (setq nnvirtual-component-groups (nth 1 inf)) ! (setq nnvirtual-mapping (nth 2 inf))))) ! (when (and regexp ! (or (not inf) ! (not dont-check))) ! (and inf (setq nnvirtual-group-alist ! (delq inf nnvirtual-group-alist))) ! (setq nnvirtual-mapping nil) ! (setq nnvirtual-current-group group) ! (let ((newsrc gnus-newsrc-alist) ! (virt-group (gnus-group-prefixed-name ! nnvirtual-current-group '(nnvirtual "")))) ! (setq nnvirtual-component-groups nil) ! (while newsrc ! (and (string-match regexp (car (car newsrc))) ! (not (string= (car (car newsrc)) virt-group)) ! (setq nnvirtual-component-groups ! (cons (car (car newsrc)) nnvirtual-component-groups))) ! (setq newsrc (cdr newsrc)))) ! (if nnvirtual-component-groups ! (progn ! (nnvirtual-create-mapping) ! (setq nnvirtual-group-alist ! (cons (list group nnvirtual-component-groups ! nnvirtual-mapping regexp) ! nnvirtual-group-alist))) ! (nnheader-report 'nnvirtual "No component groups: %s" group)))) ! nnvirtual-component-groups) (defun nnvirtual-update-marked () ! "Copy marks from the virtual group to the component groups." ! (let ((mark-lists gnus-article-mark-lists) ! (uncompressed '(score bookmark)) ! type list calist mart cgroups) (while mark-lists ! (setq type (cdar mark-lists)) ! (when (setq list (symbol-value (intern (format "gnus-newsgroup-%s" ! (car (pop mark-lists)))))) ! (setq cgroups ! (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) ! (while list ! (nconc (assoc (cadr (setq mart (assq (pop list) nnvirtual-mapping))) ! cgroups) ! (list (caddr mart)))) ! (while cgroups ! (when (cdar cgroups) ! (gnus-add-marked-articles ! (caar cgroups) type (cdar cgroups) nil t) ! (gnus-group-update-group (caar cgroups) t)) ! (setq cgroups (cdr cgroups))))))) ! ! (defun nnvirtual-marks (article marks) ! "Return a list of mark types for ARTICLE." ! (let (out) ! (while marks ! (when (memq article (cdar marks)) ! (push (caar marks) out)) ! (setq marks (cdr marks))) ! out)) ! ! (defun nnvirtual-create-mapping () ! "Create an article mapping for the current group." ! (let* (div ! (map (sort ! (apply ! 'nconc ! (mapcar ! (lambda (g) ! (let* ((active (or (gnus-active g) (gnus-activate-group g))) ! (unreads (gnus-list-of-unread-articles g)) ! (marks (gnus-uncompress-marks ! (gnus-info-marks (gnus-get-info g))))) ! (when gnus-use-cache ! (push (cons 'cache (gnus-cache-articles-in-group g)) ! marks)) ! (when active ! (setq div (/ (float (car active)) (cdr active))) ! (mapcar (lambda (n) ! (list (* div (- n (car active))) ! g n (and (memq n unreads) t) ! (nnvirtual-marks n marks))) ! (gnus-uncompress-range active))))) ! nnvirtual-component-groups)) ! (lambda (m1 m2) ! (< (car m1) (car m2))))) ! (i 0)) ! (setq nnvirtual-mapping map) ! (while map ! (setcar (pop map) (incf i))))) (provide 'nnvirtual) *** pub/sgnus/lisp/ChangeLog Thu Dec 21 04:10:00 1995 --- sgnus/lisp/ChangeLog Tue Jan 16 21:14:52 1996 *************** *** 1,7 **** --- 1,610 ---- + Tue Jan 16 21:14:44 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-message-archive-method): Never get new mail. + + Tue Jan 16 19:42:21 1996 Ken Raeburn + + * nnmail.el (nnmail-process-babyl-mail-format): Some movemails do + not add an EOOH line. + + Tue Jan 16 19:26:31 1996 Lars Magne Ingebrigtsen + + * nnml.el (nnml-request-article): Would try to retrieve + non-qualified path. + (nnml-possibly-change-directory): Nix out the file alist. + + * nnheader.el (nnheader-article-to-file-alist): Translated twice. + + * gnus.el (gnus-article-hidden-text-p): New function. + + Tue Jan 16 15:20:08 1996 Lars Ingebrigtsen + + * nnspool.el (nnspool-retrieve-headers-with-nov): Extra slash in + path. + + * gnus-topic.el (gnus-topic-check-topology): Hardcoded "Gnus" + topic name. + + * gnus-soup.el (gnus-soup-unique-prefix): Be silent. + + * gnus.el (gnus-summary-insert-pseudos): Put text props instead of + adding. + + * gnus-cite.el (gnus-article-hide-citation, + gnus-article-hide-citation-maybe): Toggle. + + * gnus.el (gnus-article-show-hidden-text): Also hide. + (gnus-article-check-hidden-text): New function. + (gnus-article-hide-headers, gnus-article-hide-boring-headers, + gnus-article-hide-pgp, gnus-article-hide-signature): Toggle. + + Mon Jan 15 14:00:32 1996 Lars Ingebrigtsen + + * gnus.el (gnus-group-sort-groups): Make composite sort function. + + * gnus-msg.el (gnus-inews-do-gcc): Put the message in its own + buffer before archiving. + + * gnus-topic.el (gnus-topic-mode-map): Bugged totally out. + (gnus-topic-mode): change-level-function is a function, not a + hook. + (gnus-topic-yank-group): Yank into the line under point. + + * gnus-score.el (gnus-score-check-syntax): Would always report + errors. + + Sat Jan 13 00:31:02 1996 Lars Magne Ingebrigtsen + + * gnus-salt.el (gnus-possibly-generate-tree): Cut thread before + generating. + + * gnus.el (gnus-cut-threads): New function. + (gnus-summary-prepare): Use it. + (gnus-id-to-header): New function. + (gnus-read-header): Use it. + (gnus-get-newsgroup-headers): Allow reading new versions of + headers. + (gnus-get-newsgroup-headers-xover): Ditto. + + * nntp.el (nntp-accept-response): Never hang waiting for process + output. + + * gnus.el (gnus-ask-server-for-new-groups): Wouldn't subscribe + groups from odd servers. + + Fri Jan 12 11:36:07 1996 Lars Magne Ingebrigtsen + + * nnfolder.el (nnfolder-possibly-change-group): Create parent + dirs. + + * gnus-ems.el: Would remove intangible props under 19.30. + + * nnmail.el (nnmail-expired-article-p): Accept inhibition. + (nnmail-save-active): Create the directory if it doesn't exist. + (nnmail-procmail-suffix): Changed default. + + * gnus-msg.el (gnus-inews-do-gcc): Report failures. + + * gnus.el (gnus-request-create-group): Accept a method parameter. + + * gnus-msg.el (gnus-tokenize-header): Accept a separator. + + * nnfolder.el (nnfolder-inhibit-expiry): New variable. + + * gnus-msg.el (gnus-message-archive-group): New variable. + (gnus-inews-insert-archive-gcc): New function. + + * gnus.el (gnus-message-archive-method): New variable. + (gnus-ask-server-for-new-groups): Use it. + (gnus-read-active-file): Ditto. + (gnus-read-all-descriptions-files): Ditto. + + * nndraft.el (nndraft-request-accept-article): Don't be so + chatty. + + * gnus-score.el (gnus-score-default-header): New variable. + (gnus-score-default-type): Ditto. + (gnus-score-default-duration): Ditto. + + * nnheader.el (nntp-header-number): Removed all `nntp-header-' + aliases. + (mail-header-number): Rewrote all macros. + (nnheader-insert-file-contents-literally): Removed. + + * gnus-score.el (gnus-score-adaptive): Wrap macros. + + * nnheader.el (mail-header-message-id): New alias for + `mail-header-id'. + + * gnus.el (gnus-replace-chars-in-string): Removed. + (gnus-summary-find-matching): Wrap `mail-header-' macros in + lambdas instead of using the Gnus functions. + (gnus-header-number): Removed all functional equivalents. + + * nnmail.el: Changed gnus-verbose-backends in all backends. + + * nnspool.el (nnspool-replace-chars-in-string): Removed. + (nnspool-number-base-10): Removed. + + * nnheader.el (nnheader-message): New function. + (gnus-verbose-backends): Changed default. + (nnheader-be-verbose): New function. + (nnheader-group-pathname): New function. + + * nnfolder.el (nnfolder-generate-active-file): New command. + + * nnheader.el (nnheader-mail-file-mbox-p): New function. + (nnheader-file-to-group): New function. + + * gnus-cache.el (gnus-uncacheable-groups): New default. + + Thu Jan 11 22:26:42 1996 Lars Magne Ingebrigtsen + + * gnus-salt.el (gnus-pick-display-summary): New variable. + (gnus-pick-start-reading): Use it. + + Wed Jan 10 19:45:33 1996 Paul Eggert + + * gnus.el (gnus-article-date-ut): Avoid race condition when + computing current time and zone. + * gnus-msg.el (gnus-inews-date): Likewise. + + Thu Jan 11 10:55:34 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-goto-colon): New function; use horizontal + recentering. + + * gnus-salt.el (gnus-generate-tree): Use new recenter function. + (gnus-highlight-selected-tree): Ditto. + + * gnus.el (gnus-set-mode-line): Make tree buffer mode line. + (gnus-article-goto-next-page): Didn't work all the time. + (gnus-article-read-summary-keys): Allow proper paging from the + tree buffer. + (gnus-horizontal-recenter): New function. + + * gnus-vis.el (gnus-article-add-buttons): New implementation. + (gnus-button-alist): New default. + + * gnus.el (gnus-select-article-hook): Changed default. + (gnus-summary-display-article): Removed call to + `gnus-summary-show-thread'. + + * gnus-vis.el (gnus-article-highlight-headers): New implementation. + + * gnus-soup.el (gnus-soup-write-areas): Be silent. + (gnus-soup-write-replies): Ditto. + + Wed Jan 10 09:50:39 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-sort-articles): New function. + (gnus-summary-prepare): Use it. + (gnus-sort-threads): New implementation. + (gnus-sort-articles): Ditto. + (gnus-make-sort-function): New function. + + * nnmail.el (nnmail-pre-get-new-mail-hook): New variable. + (nnmail-post-get-new-mail-hook): New variable. + (nnmail-split-incoming): Do more checking for babyl file format. + (nnmail-process-babyl-mail-format): Really remove bogus Message-IDs. + (nnmail-process-unix-mail-format): Ditto. + (nnmail-process-mmdf-mail-format): Ditto. + + * nndraft.el (nndraft-request-associate-buffer): Clear modtime. + + * gnus-vis.el (gnus-button-marker-list): New variable. + (gnus-article-add-buttons): Use it to delete all old markers. + + * nnkiboze.el (nnkiboze-close-group): Don't delete all NOV lines + on Gnus startup. + + * gnus.el (gnus-sort-threads): Use `gnus-article-sort-functions'. + + * gnus-score.el (gnus-summary-increase-score): Prompt when + matching on References. + + * nnsoup.el (nnsoup-make-active): Clear message. + + * gnus.el (gnus-window-min-width): New variable. + (gnus-window-min-height): New variable. + (gnus-configure-frame): Use them. + (gnus-summary-prepare-exit-hook): Defun instead of defvar. + (gnus-summary-exit-hook): Ditto. + (gnus-parse-headers-hook): Ditto. + + * gnus-salt.el (gnus-generate-tree-function): New variable. + (gnus-tree-edge): New macro. + + * gnus-ems.el: Set a default + `nnheader-file-name-translation-alist' based on system-type. + + * gnus-msg.el (gnus-bug): Don't `message' emacs-version. + + Tue Jan 09 10:51:22 1996 Lars Magne Ingebrigtsen + + * nnvirtual.el (nnvirtual-possibly-change-group): Would choke on + exit when using cache. + + * gnus.el (gnus-request-article-this-buffer): Didn't allow reading + from virtual groups. + + * gnus-salt.el (gnus-tree-mode): New major mode. + + * gnus.el (gnus-read-init-file): Give better error messages when + reading the init file. + + * gnus-srvr.el (gnus-browse-mode): Moved to this file. + + * gnus.el (gnus-summary-display-article): Don't call the visual + updating functions twice. + (gnus-id-to-article): New function. + (gnus-article-displayed-root-p): New function. + (gnus-summary-top-thread): New command and keystroke. + (gnus-parent-id): Would bug out on empty References. + (gnus-add-configuration): Doc fix. + + * gnus-vis.el (gnus-summary-highlight-line-function): New + variable. + (gnus-summary-highlight-line): Use it. + + * gnus.el (gnus-article-read-summary-keys): Accept parameter to + not restore window config. + + * nnspool.el (nnspool-find-id): Condition-case the grep call. + + * gnus.el (gnus-updated-mode-lines): New default. + + Mon Jan 08 00:00:32 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-use-trees): New variable. + + * gnus-salt.el (gnus-binary-mode): New minor mode. + (gnus-tree-mode): New major mode. + + * gnus-msg.el (gnus-mail-method): New variable. + (gnus-mail-setup): Use it. + + * gnus.el (gnus-build-sparse-threads): New function. + (gnus-sparse-mark): New variable. + (gnus-build-sparse-threads): New variable. + (gnus-summary-read-group): Use the new function. + (gnus-cut-thread): New subst. + (gnus-cut-thread): Limit fetch-old-headers 'some properly. + + * nnheader.el (make-mail-header): New function. + + * nnml.el (nnml-make-nov-line): Fudge better Message-IDs. + + * nnheader.el (nnheader-narrow-to-headers): Moved the function here. + + * gnus.el (gnus-summary-import-article): Make arpa date. + + * nnheader.el (nnheader-replace-header): New function. + + * gnus.el (gnus-summary-move-article): Move, copy and crosspost in + one function. + (gnus-summary-copy-article): Just use the move function. + (gnus-summary-crosspost-article): New command and keystroke. + + Sun Jan 07 06:25:00 1996 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-followup): Allow "thread" scoring. + + * nnml.el (nnml-request-article): Allow fetching gzipped articles. + (nnml-retrieve-headers): Ditto. + (nnmail-article-file-alist): New variable. + + * nnheader.el (nnheader-article-to-file-alist): New function. + + * gnus-demon.el (gnus-demon-time-to-step): Use gnus-encode-date. + + * gnus.el (gnus-encode-date): New function. + (gnus-time-minus): New function. + (gnus-article-date-ut): Use them. + (gnus-seconds-since-epoch): Removed. + (gnus-define-keys): New macro. + (gnus-define-keys-1): New function. + + * gnus.el: Rewrote all keymaps. + + * gnus-msg.el (gnus-tokenize-header): New function. + + * gnus-cus.el: Hide boring headers by default. + + * gnus-msg.el (gnus-use-followup-to): Changed default. + (gnus-check-before-posting): Ditto. + (gnus-inews-check-post): Check for totally redirected followups. + + * nnmh.el (nnmh-request-group): Would insert into group buffer. + + * gnus-uu.el (gnus-uu-unmark-by-regexp): New command. + (gnus-uu-unmark-region): New command. + (gnus-uu-unmark-buffer): New command. + + * gnus-salt.el (gnus-pick-mode): New function. + (gnus-pick-start-reading): New command. + + * gnus.el (gnus-summary-mark-excluded-as-read): New command and + keystroke. + + * gnus-salt.el: New file. + + * gnus-uu.el (gnus-uu-mark-all): Rewrite. + + * gnus-msg.el (gnus-inews-news): Use new method. + + * nnsoup.el (nnsoup-store-reply): Accept already prepared news. + + * gnus-msg.el (gnus-post-method): Allow a 0 prefix to prompt the + user for a post method. + (gnus-inews-news): Doc fix. + + * gnus.el (gnus-summary-prepare): Don't try to generate the + summary buffer when there are no headers. + + Sat Jan 06 15:04:34 1996 Lars Magne Ingebrigtsen + + * gnus-vis.el: Inserted all new commands in all menus. + + * gnus-topic.el (gnus-topic-make-menu-bar): New function. + + * gnus-score.el (gnus-score-check-syntax): Do further syntax + checking. + + * gnus.el (gnus-configure-frame): Don't bug out on the `nil' + buffer. + + * gnus-score.el (gnus-score-update-all-lines): New function. + (gnus-summary-rescore): Use it. + + * gnus.el (gnus-simplify-subject-fully): Didn't strip leading Re: + if `gnus-summary-gather-subject-limit' was a number. + (gnus-short-group-name): Collapse more. + + Tue Jan 2 19:22:12 1996 Michael Ernst + + * gnus.el (gnus-simplify-subject-ignored-prefixes): new variable. + (gnus-simplify-subject): use above to simplify subjects. + + Sat Jan 06 14:14:24 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-strict-mime): Doc fix. + + Tue Jan 2 17:27:34 1996 Michael Ernst + + * gnus.el (gnus-simplify-subject): Remove more kinds of "Re:" + prefixes, and remove multiple prefixes when they exist. + + Sat Jan 06 12:55:37 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-initial-limit): Don't always show groups + that have had all articles expunged. + (gnus-summary-read-group): Would bug out when deadening buffers. + (gnus-summary-exit): Wouldn't update windows when deadening. + (gnus-summary-isearch-article): Use proper window config. + (gnus-article-remove-trailing-blank-lines): New command and + keystroke. Suggested by Michael Ernst . + + * gnus-score.el (gnus-score-edit-alist): Make sure the score dir + exists. + (gnus-score-edit-file): Ditto. + + * nnml.el (nnml-generate-active-info): Could {pre,ap}pend all + lines with ".". + + Fri Jan 05 02:14:34 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-insert-pseudos): Add mouse face to + pseudos. + + * nnmail.el (nnmail-check-duplication): New function. + (nnmail-treat-duplicates): Renamed variable; new values. + (nnmail-process-babyl-mail-format): Use it. + (nnmail-process-unix-mail-format): Ditto. + (nnmail-process-mmdf-mail-format): Ditto. + + * gnus.el (gnus-visible-headers): Changed default. + + * gnus-xmas.el (gnus-xmas-define): Provide a sloppy + `encode-time'. + + * nnvirtual.el (nnvirtual-always-rescan): New variable. + (nnvirtual-request-group): Use it. + + * nntp.el (nntp-read-server-type): New function. + (nntp-server-action-alist): New variable. + + * gnus-cache.el (gnus-cache-possibly-remove-articles): Allow + caching in virtual groups. + + * nnvirtual.el (nnvirtual-find-group-art): New function + * gnus-cache.el (gnus-cache-possibly-enter-article): Use it. + + * gnus.el (gnus-group-exit): Close the cache instead of open it. + (gnus-group-quit): Ditto. + (gnus-virtual-group-p): New function. + (gnus-mark-xrefs-as-read): Use it. + (gnus-select-newsgroup): Allow cache lists to be displayed in + virtual groups. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Check for + pseudos. + + * nnvirtual.el (nnvirtual-request-update-mark): New function. + * gnus.el (gnus-summary-mark-article-as-read): Use it. + + * nntp.el (nntp-request-type): New function. + + * nnspool.el (nnspool-request-type): New function. + + * nnvirtual.el: Complete rewrite. Now much slower. + + * gnus.el (gnus-request-update-info): Changed into a subst. + (gnus-get-unread-articles-in-group): Allow updating from the + backends here. + (gnus-check-group): New function. + + * nnheader.el (nnheader-get-report): New function. + + * gnus.el (gnus-adjust-marked-articles): Would uncompess killed + lists. + + * gnus-topic.el (gnus-topic-grok-active-1): New function. + (gnus-topic-grok-active): New function. + (gnus-group-active-topic-p): New function. + (gnus-topic-fold): Use it. + (gnus-topic-list-active): New command and keystroke. + + * nneething.el (nneething-exclude-files): Changed default. + + * nnheader.el (nnheader-insert): New function. + + Thu Jan 04 01:45:08 1996 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-request-group): Report. + + * nnmbox.el (nnmbox-request-group): Report. + + * nnml.el (nnml-request-group): Report. + (nnml-request-article): Report. + + * nnmh.el: Report. + + * nnfolder.el (nnfolder-request-group): Report. + + * nnheader.el (nnheader-report): New function. + + * gnus.el (gnus-sort-gathered-threads): New function. + (gnus-summary-prepare): Use it. + (gnus-gather-threads-by-subject): Renamed function. + (gnus-ids-in-references): New function. + (gnus-summary-thread-gathering-function): New variable. + (gnus-summary-prepare): Use it. + (gnus-summary-gather-threads-by-references): New function. + + * nneething.el (nneething-create-mapping): Add timestamps to + mappings. + + * gnus.el (gnus-article-setup-buffer): Also allow several + `gnus-original-article-buffer's. + (gnus-configure-frame): Allow `frame' in buffer confuguration. + (gnus-other-frame): New command. + (gnus-build-get-header): Don't mark unread old-fetched headers as + read if they are unread. + (gnus-article-read-summary-keys): New command. + (gnus-article-mode-map): New implementation -- actually works. + (gnus-article-goto-next-page): New command. + (gnus-article-goto-prev-page): New command. + (gnus-summary-rescan-group): New implementation. + + * gnus-msg.el (gnus-mail-send-and-exit): Add `to-list' instead of + `to-address'. + (gnus-mail-reply): Use `broken-reply-to' group parameter. + (gnus-news-followup): Ditto. + + * nnheader.el (nnheader-file-name-translation-alist): New variable. + (nnheader-translate-file-chars): New function. + * nnkiboze.el (nnkiboze-score-file): Use it. + (nnkiboze-nov-file-name): Ditto. + * gnus-score.el (gnus-score-file-name): Use it. + * gnus.el (gnus-read-save-file-name): Use it. + + * gnus.el (gnus-group-universal-argument): New command and + keystroke. + (gnus-summary-universal-argument): Rewrite. + (gnus-group-unmark-all-groups): New command and keystroke. + (gnus-read-save-file-name): If the user types a directory name, + append the default file name to the directory. + (gnus-summary-insert-subject): Wouldn't allow `P'-ing past an + undisplayed canceled article. + (gnus-summary-update-article): New function. + (gnus-summary-edit-article-done): Use it. + + Wed Jan 03 10:42:48 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-article-hide-header): New function. + (gnus-article-hide-boring-headers): New command and keystroke. + (gnus-boring-article-headers): New variable. + + * gnus-score.el (gnus-score-expiry-days): Allow nil as a value. + (gnus-update-score-entry-dates): New variable. + (gnus-score-string): Use it. + + * gnus.el (gnus-summary-limit-to-author): New command and + keystroke. + (gnus-summary-goto-unread): Allow `never' value. + (gnus-summary-next-page): Use it. + (gnus-summary-mark-forward): Ditto. + + Wed Jan 03 09:58:14 1996 Masaharu Onishi + + * gnus.el (gnus-parent-id): Didn't return the last Message-ID if + the References contained newlines. + + Wed Jan 03 03:51:05 1996 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-modify-mail-mode-map): Typo. + + * nndoc.el (nndoc-guess-type): Look for babyl before forward. + + * nnmail.el (nnmail-crosspost-link-function): New variable. + * nnml.el (nnml-save-mail): Use it. + * nnmh.el (nnmh-save-mail): Ditto. + + * gnus.el (gnus-group-set-current-level): Would bug out on killed + groups. + + * gnus-topic.el (gnus-topic-yank-group): Would yank articles into + wrong topics. + + * gnus.el (gnus-summary-exit): Run the exit hook at an earlier + point. + (gnus-summary-mode-map): "T T" clobbering. + (gnus-summary-number-of-articles-in-thread): Wouldn't count + adopted threads. + (gnus-summary-walk-group-buffer): Respect the gnus-keep-same-level + variable. + + * gnus-topic.el (gnus-topic-change-level): New function. + + * gnus.el (gnus-group-change-level-function): New variable. + + * gnus-topic.el (gnus-topic-mode): Toggling the mode off would bug + out. + (gnus-topic-check-topology): Make sure that the topic-alist does + exist. + + * gnus-xmas.el (gnus-xmas-read-event-char): Typo. + + * gnus.el (gnus-summary-mark-article-as-read): Auto-expire ancient + articles. + (gnus-goto-next-group-when-activating): New variable. + (gnus-group-get-new-news-this-group): Use it. + + * nndoc.el (nndoc-transform-clari-briefs): New function. + (nndoc-type-alist): Understand ClariNet briefs. + + * gnus.el (gnus-group-read-ephemeral-group): Return whether the + group could be entered. + + * gnus-cache.el (gnus-cache-write-active): Would bug out when the + cache dir didn't exist. + + Tue Jan 02 08:31:45 1996 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-set-point): New function. + (gnus-sendmail-mail-setup): Use it. + (gnus-new-news): Ditto. + + * gnus.el (gnus-group-browse-foreign-server): Place point before + prompt. + Thu Dec 21 02:57:06 1995 Lars Magne Ingebrigtsen * gnus.el (gnus-summary-walk-group-buffer): Would skip every other group. + + * gnus.el: 0.26 is released. Wed Dec 20 10:18:18 1995 Hideki Ono *** pub/sgnus/texi/gnus.texi Thu Dec 21 04:10:04 1995 --- sgnus/texi/gnus.texi Tue Jan 16 15:33:44 1996 *************** *** 185,191 **** The @code{gnus-uu} package has changed drastically. @xref{Decoding Articles}. ! One major compatibility question if the presence of several summary buffers. All variables that are relevant while reading a group are buffer-local to the summary buffer they belong in. Although most important variables have their values copied into their global --- 185,191 ---- The @code{gnus-uu} package has changed drastically. @xref{Decoding Articles}. ! One major compatibility question is the presence of several summary buffers. All variables that are relevant while reading a group are buffer-local to the summary buffer they belong in. Although most important variables have their values copied into their global *************** *** 525,563 **** @item Native @sc{mime} support is something that should be done. @item - @code{trn}-like trees. - @item - @code{nn}-like pick-and-read summary interface. - @item - Frame configuration. - @item - Automatic re-scan of incoming mail. - @item - Buttonize more stuff in the article buffer. - @item A better and simpler method for specifying mail composing methods. - @item - Marks for saved, forwarded, etc articles. - @item - Gather thread by filling in missing Message-IDs. - @item - PGP support. @item Allow posting through mail-to-news gateways. @item - @code{jka-compr} isn't fully supported. - @item - Do better word-wrap on cited text. - @item - Better X-Face support with X-Face databases and stuff. - @item Really do unbinhexing. - @item - XEmacs toolbar. - @item - Don't kill summary buffers upon exit from the groups. - @item - Allow adaption on secondary marks. @end itemize And much, much, much more. There is more to come than has already been --- 525,535 ---- *************** *** 666,679 **** --- 638,658 ---- This means that the group probably doesn't exist (any more). @end table + @node Starting Up @chapter Starting Gnus @cindex starting up @kindex M-x gnus + @findex gnus If your system administrator has set things up properly, starting Gnus and reading news is extremely easy---you just type @kbd{M-x gnus}. + @findex gnus-other-frame + @kindex M-x gnus-other-frame + If you want to start Gnus in a different frame, you can use the command + @kbd{M-x gnus-other-frame} instead. + If things do not go smoothly at startup, you have to twiddle some variables. *************** *** 963,968 **** --- 942,959 ---- Saves disk space, too. Why isn't this the default, then? Unfortunately, not all servers support this function. + I bet I know what you're thinking now: How do I find out whether my + server supports @code{ask-server}? No? Good, because I don't have a + fail-safe answer. I would suggest just setting this variable to + @code{ask-server} and see whether any new groups appear after a few + days. If they do, then it works. If they don't, then it doesn't work. + I could write a function to make Gnus guess whether the server supports + @code{ask-server}, but it would just be a guess. So I won't. You could + @code{telnet} to the server and say @samp{HELP} and see whether it lists + @samp{NEWGROUPS} among the commands it understands. If it does, then it + might work. (But there are servers that lists @samp{NEWGROUPS} without + supporting the function properly.) + This variable can also be a list of select methods. If so, Gnus will issue an @code{ask-server} command to each of the select methods, and subscribe them (or not) using the normal methods. This might be handy *************** *** 1365,1370 **** --- 1356,1362 ---- the commands that say they move to the next unread group. The default is @code{t}. + @node Selecting a Group @section Selecting a Group @cindex group selection *************** *** 1464,1493 **** If you are using a threaded summary display, you can sort the threads by setting @code{gnus-thread-sort-functions}, which is a list of functions. By default, sorting is done on article numbers. Ready-made sorting ! functions include @code{gnus-thread-sort-by-number}, @code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, @code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and @code{gnus-thread-sort-by-total-score}. Each function takes two threads and return non-@code{nil} if the first ! thread should be sorted before the other. If you use more than one ! function, the primary sort key should be the last function in the list. If you would like to sort by score, then by subject, and finally by ! date, you could do something like: @lisp (setq gnus-thread-sort-functions ! '(gnus-thread-sort-by-date gnus-thread-sort-by-subject gnus-thread-sort-by-score)) @end lisp @vindex gnus-thread-score-function The function in the @code{gnus-thread-score-function} variable (default @code{+}) is used for calculating the total score of a thread. Useful functions might be @code{max}, @code{min}, or squared means, or whatever ! tickles you fancy. @findex gnus-article-sort-functions @findex gnus-article-sort-by-date --- 1456,1507 ---- If you are using a threaded summary display, you can sort the threads by setting @code{gnus-thread-sort-functions}, which is a list of functions. By default, sorting is done on article numbers. Ready-made sorting ! predicate functions include @code{gnus-thread-sort-by-number}, @code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, @code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and @code{gnus-thread-sort-by-total-score}. Each function takes two threads and return non-@code{nil} if the first ! thread should be sorted before the other. Note that sorting really is ! normally done by looking only at the roots of each thread. If you use ! more than one function, the primary sort key should be the last function ! in the list. You should probably always include ! @code{gnus-thread-sort-by-number} in the list of sorting ! functions---preferably first. This will ensure that threads that are ! equal with respect to the other sort criteria will be displayed in ! ascending article order. If you would like to sort by score, then by subject, and finally by ! number, you could do something like: @lisp (setq gnus-thread-sort-functions ! '(gnus-thread-sort-by-number gnus-thread-sort-by-subject gnus-thread-sort-by-score)) @end lisp + The threads that have highest score will be displayed first in the + summary buffer. When threads have the same score, they will be sorted + alphabetically. The threads that have the same score and the same + subject will be sorted by number, which is (normally) the sequence in + which the articles arrived. + + If you want to sort by score and then reverse arrival order, you could + say something like: + + @lisp + (setq gnus-thread-sort-functions + '((lambda (t1 t2) + (not (gnus-thread-sort-by-number t1 t2))) + gnus-thread-sort-by-score)) + @end lisp + @vindex gnus-thread-score-function The function in the @code{gnus-thread-score-function} variable (default @code{+}) is used for calculating the total score of a thread. Useful functions might be @code{max}, @code{min}, or squared means, or whatever ! tickles your fancy. @findex gnus-article-sort-functions @findex gnus-article-sort-by-date *************** *** 1496,1508 **** @findex gnus-article-sort-by-author @findex gnus-article-sort-by-number If you are using an unthreaded display for some strange reason or other, ! you have to fiddle with the @code{gnus-article-sort-functions} ! variable. It is very similar to the @code{gnus-thread-sort-functions}, ! except that is uses slightly different functions for article ! comparison. Available functions are @code{gnus-article-sort-by-number}, @code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject}, @code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}. @node Subscription Commands @section Subscription Commands --- 1510,1531 ---- @findex gnus-article-sort-by-author @findex gnus-article-sort-by-number If you are using an unthreaded display for some strange reason or other, ! you have to fiddle with the @code{gnus-article-sort-functions} variable. ! It is very similar to the @code{gnus-thread-sort-functions}, except that ! is uses slightly different functions for article comparison. Available ! sorting predicate functions are @code{gnus-article-sort-by-number}, @code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject}, @code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}. + If you want to sort an unthreaded summary display by subject, you could + say something like: + + @lisp + (setq gnus-article-sort-functions + '(gnus-article-sort-by-number + gnus-article-sort-by-subject)) + @end lisp + @node Subscription Commands @section Subscription Commands *************** *** 1708,1713 **** --- 1731,1741 ---- Remove the mark from the current group (@code{gnus-group-unmark-group}). + @item M U + @kindex M U (Group) + @findex gnus-group-unmark-all-groups + Remove the mark from all groups (@code{gnus-group-unmark-all-groups}). + @item M w @kindex M w (Group) @findex gnus-group-mark-region *************** *** 1722,1727 **** --- 1750,1761 ---- Also @xref{Process/Prefix}. + If you want to execute some command on all groups that have been marked + with the process mark, you can use the @kbd{M-&} + (@code{gnus-group-universal-argument}) command. It will prompt you for + the command to be executed. + + @node Foreign Groups @section Foreign Groups *************** *** 1912,1917 **** --- 1946,1974 ---- popular function is @code{nntp-send-authinfo}, which will prompt you for an @sc{nntp} password and stuff. + @item nntp-server-action-alist + @vindex nntp-server-action-alist + This is an list of regexps to match on server types and actions to be + taken when matches are made. For instance, if you want Gnus to beep + every time you connect to innd, you could say something like: + + @lisp + (setq nntp-server-action-alist + '(("innd" (ding)))) + @end lisp + + You probably don't want to do that, though. + + The default value is + + @lisp + '(("nntpd 1\\.5\\.11t" + (remove-hook 'nntp-server-opened-hook nntp-send-mode-reader))) + @end lisp + + This ensures that Gnus doesn't send the @samp{MODE READER} command to + nntpd 1.5.11t, since that command chokes that server, I've been told. + @item nntp-maximum-request @vindex nntp-maximum-request If the @sc{nntp} server doesn't support @sc{nov} headers, this backend *************** *** 2085,2090 **** --- 2142,2148 ---- @end table + @node nnvirtual @subsection nnvirtual @cindex @code{nnvirtual} *************** *** 2135,2140 **** --- 2193,2210 ---- group has to be alive (i.e., subscribed or unsubscribed). Killed or zombie groups can't be component groups for @code{nnvirtual} groups. + @vindex nnvirtual-always-rescan + If the @code{nnvirtual-always-rescan} is non-@code{nil}, + @code{nnvirtual} will always scan groups for unread articles when + entering a virtual group. If this variable is @code{nil} (which is the + default) and you read articles in a component group after the virtual + group has been activated, the read articles from the component group + will show up when you enter the virtual group. You'll also see this + effect if you have two virtual groups that contain the same component + group. If that's the case, you should set this variable to @code{t}. + Or you can just tap @code{M-g} on the virtual group every time before + you enter it---it'll have much the same effect. + @node nnkiboze @subsection nnkiboze *************** *** 2183,2188 **** --- 2253,2259 ---- Articles that are marked as read in the @code{nnkiboze} group will have their @sc{nov} lines removed from the @sc{nov} file. + @node nndir @subsection nndir @cindex @code{nndir} *************** *** 2208,2213 **** --- 2279,2285 ---- whatever you use @code{nndir} for, so you could switch to any of those methods if you feel the need to have a non-read-only @code{nndir}. + @node nneething @subsection nneething @cindex @code{nneething} *************** *** 2622,2628 **** your name is not @samp{"larsi"}, you should probably modify that slightly, but you may have guessed that already, you smart & handsome devil! You can also set this variable to @code{pop}, and Gnus will try ! to figure out the POP mail string by itself. When you use a mail backend, Gnus will slurp all your mail from your inbox and plonk it down in your home directory. Gnus doesn't move any --- 2694,2702 ---- your name is not @samp{"larsi"}, you should probably modify that slightly, but you may have guessed that already, you smart & handsome devil! You can also set this variable to @code{pop}, and Gnus will try ! to figure out the POP mail string by itself. In any case, Gnus will ! call @code{movemail} which will contact the POP server named in the ! @samp{MAILHOST} environment variable. When you use a mail backend, Gnus will slurp all your mail from your inbox and plonk it down in your home directory. Gnus doesn't move any *************** *** 2642,2647 **** --- 2716,2738 ---- @code{nnmail-prepare-incoming-hook} is run in a buffer that holds all the new incoming mail, and can be used for, well, anything, really. + @vindex nnmail-pre-get-new-mail-hook + @vindex nnmail-post-get-new-mail-hook + There are two more useful hooks executed when treating new incoming + mail---@code{nnmail-pre-get-new-mail-hook} (which is called just before + starting to handle the new mail) and + @code{nnmail-post-get-new-mail-hook} (which is called when the mail + handling is done). Here's and example of using these two hooks to + change the default file modes the new mail files get: + + @lisp + (add-hook 'gnus-pre-get-new-mail-hook + (lambda () (set-default-file-modes 511))) + + (add-hook 'gnus-post-get-new-mail-hook + (lambda () (set-default-file-modes 551))) + @end lisp + @vindex nnmail-tmp-directory @code{nnmail-tmp-directory} says where to move the incoming mail to while processing it. This is usually done in the same directory that *************** *** 2665,2689 **** @vindex nnmail-message-id-cache-length @vindex nnmail-message-id-cache-file ! @vindex nnmail-delete-duplicates @cindex duplicate mails If you are a member of a couple of mailing list, you will sometime receive two copies of the same mail. This can be quite annoying, so ! @code{nnmail} checks for and discards any duplicates it might find. To ! do this, it keeps a cache of old @code{Message-ID}s - @code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by default. The approximate maximum number of @code{Message-ID}s stored there is controlled by the @code{nnmail-message-id-cache-length} variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be stored.) If all this sounds scary to you, you can set ! @code{nnmail-delete-duplicates} to @code{nil} (which is what it is by ! default), and @code{nnmail} won't do any duplicate checking. Here's a neat feature: If you know that the recipient reads her mail ! with Gnus, and that she has @code{nnmail-delete-duplicates} set to ! @code{t}, you can send her as many insults as you like, just by using a ! @code{Message-ID} of a mail that you know that she's already received. ! Think of all the fun! She'll never see any of it! Whee! Gnus gives you all the opportunity you could possibly want for shooting yourself in the foot. Let's say you create a group that will contain --- 2756,2784 ---- @vindex nnmail-message-id-cache-length @vindex nnmail-message-id-cache-file ! @vindex nnmail-treat-duplicates @cindex duplicate mails If you are a member of a couple of mailing list, you will sometime receive two copies of the same mail. This can be quite annoying, so ! @code{nnmail} checks for and treats any duplicates it might find. To do ! this, it keeps a cache of old @code{Message-ID}s - @code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by default. The approximate maximum number of @code{Message-ID}s stored there is controlled by the @code{nnmail-message-id-cache-length} variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be stored.) If all this sounds scary to you, you can set ! @code{nnmail-delete-duplicates} to @code{warn} (which is what it is by ! default), and @code{nnmail} won't delete duplicate mails. Instead it ! will generate a brand new @code{Message-ID} for the mail and insert a ! warning into the head of the mail saying that it thinks that this is a ! duplicate of a different message. Or you can turn this feature off ! completely by setting the variable to @code{nil}. Here's a neat feature: If you know that the recipient reads her mail ! with Gnus, and that she has @code{nnmail-treat-duplicates} set to ! @code{delete}, you can send her as many insults as you like, just by ! using a @code{Message-ID} of a mail that you know that she's already ! received. Think of all the fun! She'll never see any of it! Whee! Gnus gives you all the opportunity you could possibly want for shooting yourself in the foot. Let's say you create a group that will contain *************** *** 2751,2756 **** --- 2846,2859 ---- @code{nnmail-crosspost} says whether to use this mechanism or not. Note that no articles are crossposted to the general (@samp{""}) group. + @vindex nnmail-crosspost-link-function + @cindex crosspost + @cindex links + @code{nnmh} and @code{nnml} makes crossposts by creating hard links to + the crossposted articles. However, not all files systems support hard + links. If that's the case for you, set + @code{nnmail-crosspost-link-function} to @code{copy-file}. (This + variable is @code{add-name-to-file} by default.) @node Fancy Mail Splitting *************** *** 2772,2783 **** ;; the ordinary groups. Warnings are put in a separate group ;; from real errors. (| ("from" mail (| ("subject" "warn.*" "mail.warning") ! "mail.misc")) ;; Non-error messages are crossposted to all relevant ;; groups, but we don't crosspost between the group for the ;; (ding) list and the group for other (ding) related mail. (& (| (any "ding@@ifi\\.uio\\.no" "ding.list") ! ("subject" "ding" "ding.misc")) ;; Other mailing lists... (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list") (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list") --- 2875,2886 ---- ;; the ordinary groups. Warnings are put in a separate group ;; from real errors. (| ("from" mail (| ("subject" "warn.*" "mail.warning") ! "mail.misc")) ;; Non-error messages are crossposted to all relevant ;; groups, but we don't crosspost between the group for the ;; (ding) list and the group for other (ding) related mail. (& (| (any "ding@@ifi\\.uio\\.no" "ding.list") ! ("subject" "ding" "ding.misc")) ;; Other mailing lists... (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list") (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list") *************** *** 3157,3162 **** --- 3260,3266 ---- to set this variable to @code{t}. @end table + @node nnfolder @subsubsection nnfolder @cindex @code{nnfolder} *************** *** 3187,3192 **** --- 3291,3303 ---- If non-@code{nil}, @code{nnfolder} will read incoming mail. @end table + @findex nnfolder-generate-active-file + @kindex M-x nnfolder-generate-active-file + If you have lots of @code{nnfolder}-like files you'd like to read with + @code{nnfolder}, you can use the @key{M-x nnfolder-generate-active-file} + command to make @code{nnfolder} aware of all likely files in + @code{nnfolder-directory}. + @node Group Parameters @section Group Parameters *************** *** 3221,3244 **** If the group parameter list contains an element that looks like @samp{(to-address . "some@@where.com")}, that address will be used by the backend when doing followups and posts. This is primarily useful in ! mail groups that represent close mailing lists. You just set this ! address to whatever the list address is. ! ! This trick will actually work whether the group is foreign or not. ! Let's say there's a group on the server that is called @samp{fa.4ad-l}. ! This is a real newsgroup, but the server has gotten the articles from a ! mail-to-news gateway. Posting directly to this group is therefore ! impossible---you have to send mail to the mailing list address instead. ! Also @xref{Mail & Post}. @item to-list @cindex to-list If the group parameter list has an element that looks like ! @samp{(to-list . "some@@where.com")}, that address will be used when doing a @kbd{a} in any group. It is totally ignored when doing a followup---except that if it is present in a news group, you'll get mail group semantics when doing @kbd{f}. @item to-group @cindex to-group If the group parameter list contains an element like @code{(to-group --- 3332,3366 ---- If the group parameter list contains an element that looks like @samp{(to-address . "some@@where.com")}, that address will be used by the backend when doing followups and posts. This is primarily useful in ! mail groups that represent closed mailing lists---mailing lists where ! it's expected that everybody that writes to the mailing list is ! subscribed to it. Since using this parameter ensures that the mail only ! goes to the mailing list itself, it means that members won't receive two ! copies of your followups. ! ! Using @code{to-address} will actually work whether the group is foreign ! or not. Let's say there's a group on the server that is called ! @samp{fa.4ad-l}. This is a real newsgroup, but the server has gotten ! the articles from a mail-to-news gateway. Posting directly to this ! group is therefore impossible---you have to send mail to the mailing ! list address instead. Also @xref{Mail & Post}. @item to-list @cindex to-list If the group parameter list has an element that looks like ! @code{(to-list . "some@@where.com")}, that address will be used when doing a @kbd{a} in any group. It is totally ignored when doing a followup---except that if it is present in a news group, you'll get mail group semantics when doing @kbd{f}. + @item broken-reply-to + @cindex broken-reply-to + Elements like @code{(broken-reply-to . t)} signals that @code{Reply-To} + headers in this group are to be ignored. This can be useful if you're + reading a mailing list group where the listserv has inserted + @code{Reply-To} headers that point back to the listserv itself. This is + broken behavior. So there! + @item to-group @cindex to-group If the group parameter list contains an element like @code{(to-group *************** *** 3773,3778 **** --- 3895,3906 ---- @findex gnus-topic-delete Delete an empty topic (@code{gnus-topic-delete}). + @item A T + @kindex A T (Group) + @findex gnus-topic-list-active + List all groups that Gnus knows about in a topicsified way + (@code{gnus-topic-list-active}). + @end table *************** *** 3841,3848 **** @item M-g @kindex M-g (Group) @findex gnus-group-get-new-news-this-group Check whether new articles have arrived in the current group ! (@code{gnus-group-get-new-news-this-group}). @findex gnus-activate-all-groups @item C-c M-g --- 3969,3980 ---- @item M-g @kindex M-g (Group) @findex gnus-group-get-new-news-this-group + @vindex gnus-goto-next-group-when-activating Check whether new articles have arrived in the current group ! (@code{gnus-group-get-new-news-this-group}). The ! @code{gnus-goto-next-group-when-activating} variable controls whether ! this command is to move point to the next group or not. It is @code{t} ! by default. @findex gnus-activate-all-groups @item C-c M-g *************** *** 3976,3981 **** --- 4108,4115 ---- * Article Treatment:: The article buffer can be mangled at will. * Summary Sorting:: You can sort the summary buffer four 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. * Mail Group Commands:: Some commands can only be used in mail groups. * Various Summary Stuff:: What didn't fit anywhere else. @end menu *************** *** 4068,4073 **** --- 4202,4209 ---- default level. If the difference between @code{gnus-summary-default-level} and the score is less than @code{gnus-summary-zcore-fuzz}, this spec will not be used. + @item V + Total thread score. @item x @code{Xref}. @item D *************** *** 4183,4223 **** (@code{gnus-summary-goto-subject}). @end table - @vindex gnus-auto-select-next - If you are at the end of the group and issue one of the movement - commands, Gnus will offer to go to the next group. If - @code{gnus-auto-select-next} is @code{t} and the next group is empty, - Gnus will exit summary mode and return to the group buffer. If this - variable is neither @code{t} nor @code{nil}, Gnus will select the next - group, no matter whether it has any unread articles or not. As a - special case, if this variable is @code{quietly}, Gnus will select the - next group without asking for confirmation. If this variable is - @code{almost-quietly}, the same will happen only if you are located on - the last article in the group. Also @xref{Group Levels}. - If Gnus asks you to press a key to confirm going to the next group, you can use the @kbd{C-n} and @kbd{C-p} keys to move around the group buffer, searching for the next group to read without actually returning to the group buffer. @vindex gnus-auto-select-same ! If @code{gnus-auto-select-same} is non-@code{nil}, all the movement ! commands will try to go to the next article with the same subject as the ! current. This variable is not particularly useful if you use a threaded ! display. @vindex gnus-summary-check-current ! If @code{gnus-summary-check-current} is non-@code{nil}, all the "unread" ! movement commands will not proceed to the next (or previous) article if ! the current article is unread. Instead, they will choose the current ! article. @vindex gnus-auto-center-summary ! If @code{gnus-auto-center-summary} is non-@code{nil}, Gnus will keep the ! point in the summary buffer centered at all times. This makes things ! quite tidy, but if you have a slow network connection, or simply do not ! like this un-Emacsism, you can set this variable to @code{nil} to get ! the normal Emacs scrolling action. @node Choosing Articles @section Choosing Articles --- 4319,4370 ---- (@code{gnus-summary-goto-subject}). @end table If Gnus asks you to press a key to confirm going to the next group, you can use the @kbd{C-n} and @kbd{C-p} keys to move around the group buffer, searching for the next group to read without actually returning to the group buffer. + Variables related to summary movement: + + @table @code + + @vindex gnus-auto-select-next + @item gnus-auto-select-next + If you are at the end of the group and issue one of the movement + commands, Gnus will offer to go to the next group. If this variable is + @code{t} and the next group is empty, Gnus will exit summary mode and + return to the group buffer. If this variable is neither @code{t} nor + @code{nil}, Gnus will select the next group, no matter whether it has + any unread articles or not. As a special case, if this variable is + @code{quietly}, Gnus will select the next group without asking for + confirmation. If this variable is @code{almost-quietly}, the same will + happen only if you are located on the last article in the group. Also + @xref{Group Levels}. + + @item gnus-auto-select-same @vindex gnus-auto-select-same ! If non-@code{nil}, all the movement commands will try to go to the next ! article with the same subject as the current. This variable is not ! particularly useful if you use a threaded display. + @item gnus-summary-check-current @vindex gnus-summary-check-current ! If non-@code{nil}, all the "unread" movement commands will not proceed ! to the next (or previous) article if the current article is unread. ! Instead, they will choose the current article. + @item gnus-auto-center-summary @vindex gnus-auto-center-summary ! If non-@code{nil}, Gnus will keep the point in the summary buffer ! centered at all times. This makes things quite tidy, but if you have a ! slow network connection, or simply do not like this un-Emacsism, you can ! set this variable to @code{nil} to get the normal Emacs scrolling ! action. This will also inhibit horizontal recentering of the summary ! buffer, which might make it more inconvenient to read extremely long ! threads. ! ! @end table ! @node Choosing Articles @section Choosing Articles *************** *** 4419,4424 **** --- 4566,4572 ---- * Post:: Posting and following up. * Posting Server:: What server should you post via? * Mail & Post:: Mailing and posting at the same time. + * Archived Messages:: Where Gnus stores the messages you've sent. * Posting Styles:: An easier way to configure some key elements. * Drafts:: Postponing messages and rejected messages. * Rejected Articles:: What happens if the server doesn't like your article? *************** *** 4936,4941 **** --- 5084,5090 ---- @end table + @node Posting Server @subsection Posting Server *************** *** 4958,4965 **** Now, if you've done this, and then this server rejects your article, or this server is down, what do you do then? To override this variable you ! can use a prefix to the @kbd{C-c C-c} command to force using the ! "current" server for posting. @node Mail & Post --- 5107,5121 ---- Now, if you've done this, and then this server rejects your article, or this server is down, what do you do then? To override this variable you ! can use a non-zero prefix to the @kbd{C-c C-c} command to force using ! the "current" server for posting. ! ! If you give a zero prefix (i. e., @kbd{C-u 0 C-c C-c}) to that command, ! Gnus will prompt you for what method to use for posting. ! ! You can also set @code{gnus-post-method} to a list of select methods. ! If that's the case, Gnus will always prompt you for what method to use ! for posting. @node Mail & Post *************** *** 5086,5103 **** This is a string that will be prepended to all mails that are the result of using the variable described above. - @item gnus-outgoing-message-group - @vindex gnus-outgoing-message-group - All outgoing messages will be put in this group. If you want to store - all your outgoing mail and articles in the group @samp{nnml:archive}, - you set this variable to that value. This variable can also be a list of - group names. - - If you want to have greater control over what group to put each - message in, you can set this variable to a function that checks the - current newsgroup name and then returns a suitable group name (or list - of names). - @item gnus-mailing-list-groups @findex gnus-mailing-list-groups @cindex mailing lists --- 5242,5247 ---- *************** *** 5121,5128 **** @vindex news-inews-hook @lisp ! (add-hook 'news-inews-hook 'ispell-message) ;For news posts ! (add-hook 'mail-send-hook 'ispell-message) ;for mail posts via sendmail @end lisp @findex gnus-inews-insert-mime-headers --- 5265,5272 ---- @vindex news-inews-hook @lisp ! (add-hook 'news-inews-hook 'ispell-message) ;For news posts ! (add-hook 'mail-send-hook 'ispell-message) ;for mail posts via sendmail @end lisp @findex gnus-inews-insert-mime-headers *************** *** 5131,5136 **** --- 5275,5414 ---- @code{gnus-inews-insert-mime-headers} to @code{gnus-inews-article-hook}. + + @node Archived Messages + @subsection Archived Messages + @cindex archived messages + @cindex sent messages + + Gnus provides a few different methods for storing the mail you send. + The default method is to use the @dfn{archive virtual server} to store + the mail. + + @vindex gnus-message-archive-method + @code{gnus-message-archive-method} says what virtual server Gnus is to + use to store sent messages. It is @code{(nnfolder "archive" + (nnfolder-directory "~/Mail/archive/"))} by default, but you can use any + mail select method (@code{nnml}, @code{nnmbox}, etc.). However, + @code{nnfolder} is a quite likable select method for doing this sort of + thing. If you don't like the default directory chosen, you could say + something like: + + @lisp + (setq gnus-message-archive-method + '((nnfolder "archive" + (nnfolder-inhibit-expiry t) + (nnfolder-active-file "~/Mail/sent-mail/active") + (nnfolder-directory "~/News/sent-mail/")))) + @end lisp + + @vindex gnus-message-archive-group + Gnus will insert @code{Gcc} headers in all outgoing messages that point + to one or more group(s) on that server. Which group to use is + determined by the @code{gnus-message-archive-group} variable. + + This variable can be: + + @itemize @bullet + @item a string + Messages will be saved in that group. + @item a list of strings + Messages will be saved in all those groups. + @item an alist of regexps, functions and forms + When a key "matches", the result is used. + @end itemize + + Let's illustrate: + + Just saving to a single group called @samp{"MisK"}: + @lisp + (setq gnus-message-archive-group "MisK") + @end lisp + + Saving to two groups, @samp{"MisK"} and @samp{"safe"}: + @lisp + (setq gnus-message-archive-group '("MisK" "safe")) + @end lisp + + Save to different groups based on what group you are in: + @lisp + (setq gnus-message-archive-group + '(("^alt" "sent-to-alt") + ("mail" "sent-to-mail") + (".*" "sent-to-misc"))) + @end lisp + + More complex stuff: + @lisp + (setq gnus-message-archive-group + '((if (eq major-mode news-reply-mode) "misc-news" "misc-mail))) + @end lisp + + This last one is the default. + + Now, when you send a message off, it will be stored in the appropriate + group. (If you want to disable storing for just one particular article, + you can just remove the @code{Gcc} header that has been inserted.) The + archive group will appear in the group buffer the next time you start + Gnus, or the next time you press @key{F} in the group buffer. You can + enter it and read the articles in it just like you'd read any other + group. If the group gets really big and annoying, you can simply rename + if (using @kbd{G r} in the group buffer) to something nice -- + @samp{"misc-mail-september-1995"}, or whatever. New messages will + continue to be stored in the old (now empty) group. + + + That's the default method of archiving sent mail. Gnus also offers two + other variables for the people who don't like the default method. In + that case you should set @code{gnus-message-archive-group} to + @code{nil}; this will disable archiving. + + @table @code + @item gnus-author-copy + @vindex gnus-author-copy + This is a file name, and all outgoing articles will be saved in that + file. Initialized from the @code{AUTHORCOPY} environment variable. + + If this variable begins with the character @samp{"|"}, outgoing articles + will be piped to the named program. It is possible to save an article in + an MH folder as follows: + + @lisp + (setq gnus-author-copy + "|/usr/local/lib/mh/rcvstore +Article") + @end lisp + + If the first character is not a pipe, articles are saved using the + function specified by the @code{gnus-author-copy-saver} variable. + + @item gnus-author-copy-saver + @vindex gnus-author-copy-saver + A function called to save outgoing articles. This function will be + called with the same of the file to store the article in. The default + function is @code{rmail-output} which saves in the Unix mailbox format. + + @item gnus-mail-self-blind + @vindex gnus-mail-self-blind + Non-@code{nil} means insert a BCC header in all outgoing articles + pointing to yourself. This will result you receiving a copy of the + article mailed to yourself. The BCC header is inserted when the post + buffer is initialized, so you can remove or alter the BCC header to + override the default. + + @item gnus-outgoing-message-group + @vindex gnus-outgoing-message-group + All outgoing messages will be put in this group. If you want to store + all your outgoing mail and articles in the group @samp{nnml:archive}, + you set this variable to that value. This variable can also be a list of + group names. + + If you want to have greater control over what group to put each + message in, you can set this variable to a function that checks the + current newsgroup name and then returns a suitable group name (or list + of names). + @end table + + @node Posting Styles @subsection Posting Styles @cindex posting styles *************** *** 5617,5627 **** (@code{gnus-summary-clear-above}). @end table ! @code{gnus-summary-goto-unread} ! The @code{gnus-summary-goto-unread} variable controls what action should ! be taken after setting a mark. If non-@code{nil}, point will move to ! the next/previous unread article. If @code{nil}, point will just move ! one line up or down. The default is @code{t}. @node Setting Process Marks --- 5895,5907 ---- (@code{gnus-summary-clear-above}). @end table ! @code{gnus-summary-goto-unread} The @code{gnus-summary-goto-unread} ! variable controls what action should be taken after setting a mark. If ! non-@code{nil}, point will move to the next/previous unread article. If ! @code{nil}, point will just move one line up or down. As a special ! case, if this variable is @code{never}, all the marking commands as well ! as other commands (like @kbd{SPC}) will move to the next article, ! whether it is unread or not. The default is @code{t}. @node Setting Process Marks *************** *** 5710,5720 **** --- 5990,6007 ---- @table @kbd @item / / + @itemx / s @kindex / / (Summary) @findex gnus-summary-limit-to-subject Limit the summary buffer to articles that match some subject (@code{gnus-summary-limit-to-subject}). + @item / a + @kindex / a (Summary) + @findex gnus-summary-limit-to-author + Limit the summary buffer to articles that match some author + (@code{gnus-summary-limit-to-author}). + @item / u @itemx x @kindex / u (Summary) *************** *** 5745,5758 **** (@code{gnus-summary-pop-limit}). If given a prefix, pop all limits off the stack. - @item / s - @itemx / - @kindex / s (Summary) - @kindex / (Summary) - @findex gnus-summary-limit-to-subject - Limit the summary buffer to articles that have a subject that matches a - regexp (@code{gnus-summary-limit-to-subject}). - @item / v @kindex / v (Summary) @findex gnus-summary-limit-to-score --- 6032,6037 ---- *************** *** 5783,5788 **** --- 6062,6074 ---- Hide all dormant articles that have no children (@code{gnus-summary-limit-exclude-childless-dormant}). + @item / C + @kindex / C (Summary) + @findex gnus-summary-limit-mark-excluded-as-read + Mark all excluded unread articles as read + (@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix, + also mark exluded ticked and dormant articles as read. + @end table *************** *** 5828,5834 **** --- 6114,6134 ---- @code{nnml}. Also remember that if the root of the thread has been expired by the server, there's not much Gnus can do about that. + @item gnus-build-sparse-threads + @vindex gnus-build-sparse-threads + Fetching old headers can be slow. A low-rent similar effect can be + gotten by setting this variable to @code{some}. Gnus will then look at + the complete @code{References} headers of all articles and try to string + articles that belong in the same thread together. This will leave + @dfn{gaps} in the threading display where Gnus guesses that an article + is missing from the thread. (These gaps appear like normal summary + lines. If you select a gap, Gnus will try to fetch the article in + question.) If this variable is @code{t}, Gnus will display all these + "gaps" without regard for whether they are useful for completing the + thread or not. This variable is @code{nil} by default. + @item gnus-summary-gather-subject-limit + @vindex gnus-summary-gather-subject-limit Loose threads are gathered by comparing subjects of articles. If this variable is @code{nil}, Gnus requires an exact match between the subjects of the loose threads before gathering them into one big *************** *** 5836,5848 **** presence of stupid newsreaders that chop off long subjects lines. If you think so, set this variable to, say, 20 to require that only the first 20 characters of the subjects have to match. If you set this ! variable to a real low number, you'll find that Gnus will gather everything in sight into one thread, which isn't very helpful. @cindex fuzzy article gathering If you set this variable to the special value @code{fuzzy}, Gnus will use a fuzzy string comparison algorithm on the subjects. @vindex gnus-summary-gather-exclude-subject Since loose thread gathering is done on subjects only, that might lead to many false hits, especially with certain common subjects like --- 6136,6175 ---- presence of stupid newsreaders that chop off long subjects lines. If you think so, set this variable to, say, 20 to require that only the first 20 characters of the subjects have to match. If you set this ! variable to a really low number, you'll find that Gnus will gather everything in sight into one thread, which isn't very helpful. @cindex fuzzy article gathering If you set this variable to the special value @code{fuzzy}, Gnus will use a fuzzy string comparison algorithm on the subjects. + @item gnus-simplify-ignored-prefixes + @vindex gnus-simplify-ignored-prefixes + If you set @code{gnus-summary-gather-subject-limit} to something as low + as 10, you might consider setting this variable to something sensible: + + @c Written by Michael Ernst + @lisp + (setq gnus-simplify-ignored-prefixes + (concat + "\\`\\[?\\(" + (mapconcat 'identity + '("looking" + "wanted" "followup" "summary\\( of\\)?" + "help" "query" "problem" "question" + "answer" "reference" "announce" + "How can I" "How to" "Comparison of" + ;; ... + ) + "\\|") + "\\)\\s *\\(" + (mapconcat 'identity + '("for" "for reference" "with" "about") + "\\|") + "\\)?\\]?:?[ \t]*")) + @end lisp + + @item gnus-summary-gather-exclude-subject @vindex gnus-summary-gather-exclude-subject Since loose thread gathering is done on subjects only, that might lead to many false hits, especially with certain common subjects like *************** *** 5851,5856 **** --- 6178,6213 ---- what subjects should be excluded from the gathering process. The default is @samp{"^ *$\\|^(none)$"}. + @item gnus-summary-thread-gathering-function + @vindex gnus-summary-thread-gathering-function + Gnus gathers threads by looking at @code{Subject} headers. This means + that totally unrelated articles may end up in the same "thread", which + is confusing. An alternate approach is to look at all the + @code{Message-ID}s in all the @code{References} headers to find + matches. This will ensure that no gathered threads ever includes + unrelated articles, but it's also means that people who have posted with + broken newsreaders won't be gathered properly. The choice is + yours---plague or cholera: + + @table @code + @item gnus-summary-gather-threads-by-subject + @findex gnus-summary-gather-threads-by-subject + This function is the default gathering function and looks at + @code{Subject}s exclusively. + + @item gnus-summary-gather-threads-by-references + @findex gnus-summary-gather-threads-by-references + This function looks at @code{References} headers exclusively. + @end table + + If you want to test gathering by @code{References}, you could say + something like: + + @lisp + (setq gnus-summary-thread-gathering-function + 'gnus-summary-gather-threads-by-references) + @end lisp + @item gnus-summary-make-false-root @vindex gnus-summary-make-false-root If non-@code{nil}, Gnus will gather all loose subtrees into one big tree *************** *** 6016,6021 **** --- 6373,6383 ---- @kindex T u (Summary) @findex gnus-summary-up-thread Ascend the thread (@code{gnus-summary-up-thread}). + + @item T o + @kindex T o (Summary) + @findex gnus-summary-top-thread + Go to the top of the thread (@code{gnus-summary-top-thread}). @end table @vindex gnus-thread-operation-ignore-subject *************** *** 6142,6150 **** sense to cache it somewhere else under your home directory. Unless you feel that it's neat to use twice as much space. To limit the caching, you could set the @code{gnus-uncacheable-groups} regexp to ! @samp{"^nnml"}, for instance. This variable is @samp{"^nnvirtual"} by ! default, since caching doesn't really work in @code{nnvirtual} groups, ! since @code{nnvirtual} assigns random article numbers to its articles. @findex gnus-cache-generate-nov-databases @findex gnus-cache-generate-active --- 6504,6511 ---- sense to cache it somewhere else under your home directory. Unless you feel that it's neat to use twice as much space. To limit the caching, you could set the @code{gnus-uncacheable-groups} regexp to ! @samp{"^nnml"}, for instance. This variable is @code{nil} by ! default. @findex gnus-cache-generate-nov-databases @findex gnus-cache-generate-active *************** *** 7087,7093 **** @cindex article hiding Or rather, hiding certain things in each article. There usually is much ! to much gruft in most articles. @table @kbd --- 7448,7454 ---- @cindex article hiding Or rather, hiding certain things in each article. There usually is much ! too much gruft in most articles. @table @kbd *************** *** 7102,7107 **** --- 7463,7474 ---- Hide headers (@code{gnus-article-hide-headers}). @xref{Hiding Headers}. + @item W W b + @kindex W W b (Summary) + @findex gnus-article-hide-boring-headers + Hide headers that aren't particularly interesting + (@code{gnus-article-hide-boring-headers}). @xref{Hiding Headers}. + @item W W s @kindex W W s (Summary) @findex gnus-article-hide-signature *************** *** 7142,7149 **** @end table ! All these "hide" functions take a prefix to undo the hiding. @kbd{C-u W ! W c} will show any hidden signatures, for instance. Also see @xref{Article Highlighting} for further variables for citation customization. --- 7509,7517 ---- @end table ! All these "hiding" commands are toggles, but if you give a negative ! prefix to these commands, they will show what they have previously ! hidden. If you give a positive prefix, they will always hide. Also see @xref{Article Highlighting} for further variables for citation customization. *************** *** 7210,7215 **** --- 7578,7589 ---- @findex gnus-article-remove-cr Remove CR (@code{gnus-article-remove-cr}). + @item W L + @kindex W L (Summary) + @findex gnus-article-remove-trailing-blank-lines + Remove all blank lines at the end of the article + (@code{gnus-article-remove-trailing-blank-lines}). + @item W q @kindex W q (Summary) @findex gnus-article-de-quoted-unreadable *************** *** 7448,7453 **** --- 7822,8035 ---- consuming.) @code{nnmh} does not support this at all. + @node Alternative Approaches + @section Alternative Approaches + + Different people like to read news using different methods. This being + Gnus, we offer a small selection of minor modes for the summary buffers. + + @menu + * Pick and Read:: First mark articles and then read them. + * Binary Groups:: Auto-decode all articles. + @end menu + + + @node Pick and Read + @subsection Pick and Read + @cindex pick and read + + Some newsreaders (like @code{nn} and, uhm, @code{nn}) use a two-phased + reading interface. The user first marks the articles she wants to read + from a summary buffer. Then she starts reading the articles with just + an article buffer displayed. + + @findex gnus-pick-mode + @kindex M-x gnus-pick-mode + Gnus provides a summary buffer minor mode that allows + this---@code{gnus-pick-mode}. This basically means that a few process + mark commands becode one-keystroke commands to allow easy marking, and + it makes one additional command for switching to the summary buffer + available. + + Here are the available keystrokes when using pick mode: + + @table @kbd + @item SPC + Pick the article (@code{gnus-summary-mark-as-processable}). + + @item u + Unpick the article (@code{gnus-summary-unmark-as-processable}). + + @item U + Unpick all articles (@code{gnus-summary-unmark-all-processable}). + + @item t + Pick the thread (@code{gnus-uu-mark-thread}). + + @item T + Unpick the thread (@code{gnus-uu-unmark-thread}). + + @item r + Pick the region (@code{gnus-uu-mark-region}). + + @item R + Unpick the region (@code{gnus-uu-unmark-region}). + + @item e + Pick articles that match a regexp (@code{gnus-uu-unmark-regexp}). + + @item E + Unpick articles that match a regexp (@code{gnus-uu-unmark-regexp}). + + @item b + Pick the buffer (@code{gnus-uu-mark-buffer}). + + @item B + Unpick the buffer (@code{gnus-uu-unmark-buffer}). + + @item RET + @vindex gnus-pick-display-summary + Start reading the picked articles (@code{gnus-pick-start-reading}). If + given a prefix, mark all unpicked articles as read first. If + @code{gnus-pick-display-summary} is non-@code{nil}, the summary buffer + will still be visible when you are reading. + + @end table + + If this sounds like a good idea to you, you could say: + + @lisp + (add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) + @end lisp + + + @node Binary Groups + @subsection Binary Groups + @cindex binary groups + + @findex gnus-binary-mode + @kindex M-x gnus-binary-mode + If you spend much time in binary groups, you may grow tired of hitting + @kbd{X u}, @kbd{n}, @kbd{RET} all the time. @kbd{M-x gnus-binary-mode} + is a minor mode for summary buffers that makes all ordinary Gnus article + selection functions uudecode series of articles and display the result + instead of just displaying the articles the normal way. + + @kindex g (Binary) + @findex gnus-binary-show-article + In fact, the only way to see the actual articles if you have turned this + mode on is the @kbd{g} command (@code{gnus-binary-show-article}). + + + @node Tree Display + @section Tree Display + @cindex trees + + @vindex gnus-use-trees + If you don't like the normal Gnus summary display, you might try setting + @code{gnus-use-trees} to @code{t}. This will create (by default) an + additional @dfn{tree buffer}. You can execute all summary mode commands + in the tree buffer. + + There are a few variables to customize the tree display, of course: + + @table @code + @item gnus-tree-mode-hook + A hook called in all tree mode buffers. + + @item gnus-tree-mode-line-format + A format string for the mode bar in the tree mode buffers. The default + is @samp{"Gnus: %%b [%A] %Z"}. For a list of legal specs, @xref{Summary + Buffer Mode Line}. + + @item gnus-selected-tree-face + Face used for highlighting the selected article in the tree buffer. The + default is @code{modeline}. + + @item gnus-tree-line-format + A format string for the tree nodes. The name is a bit of a misnomer, + though---it doesn't define a line, but just the node. The default value + is @samp{"%(%[%3,3n%]%)"}, which displays the first three characters of + the name of the poster. It is vital that all nodes are of the same + length, so you @emph{must} use @samp{%4,4n}-like specifiers. + + Legal specs are: + + @table @samp + @item n + The name of the poster. + @item f + The @code{From} header. + @item N + The number of the article. + @item [ + The opening bracket. + @item ] + The closing bracket. + @item s + The subject. + @end table + + @xref{Formatting Variables}. + + Variables related to the display are: + + @table @code + @item gnus-tree-brackets + This is used for differentiating between "real" articles and "sparse" + articles. The format is @var{((real-open . real-close) (sparse-open + . sparse-close) (dummy-open . dummy-close))}, and the default is + @code{((?[ . ?]) (?( . ?)) (?@{ . ?@}))}. + + @item gnus-tree-parent-child-edges + This is a list that contains the characters used for connecting parent + nodes to their children. The default is @code{(?- ?\\ ?|)}. + + @end table + + @item gnus-tree-minimize-window + If this variable is non-@code{nil}, Gnus will try to keep the tree + buffer as small as possible to allow more room for the other Gnus + windows. If this variable is a number, the tree buffer will never be + higher than that number. The default is @code{t}. + + @item gnus-generate-tree-function + @findex gnus-generate-horizontal-tree + @findex gnus-generate-vertical-tree + The function that actually generates the thread tree. Two predefined + functions are available: @code{gnus-generate-horizontal-tree} and + @code{gnus-generate-vertical-tree} (which is the default). + + @end table + + Here's and example from a horizontal tree buffer: + + @example + @{***@}-(***)-[odd]-[Gun] + | \[Jan] + | \[odd]-[Eri] + | \(***)-[Eri] + | \[odd]-[Paa] + \[Bjo] + \[Gun] + \[Gun]-[Jor] + @end example + + Here's the same thread displayed in a vertical tree buffer: + + @example + @{***@} + |--------------------------\-----\-----\ + (***) [Bjo] [Gun] [Gun] + |--\-----\-----\ | + [odd] [Jan] [odd] (***) [Jor] + | | |--\ + [Gun] [Eri] [Eri] [odd] + | + [Paa] + @end example + + @node Mail Group Commands @section Mail Group Commands @cindex mail group commands *************** *** 7495,7500 **** --- 8077,8091 ---- Copy the article from one group (mail group or not) to a mail group (@code{gnus-summary-copy-article}). + @item B C + @kindex B C (Summary) + @cindex crosspost mail + @findex gnus-summary-crosspost-article + Crosspost the current article to some other group + (@code{gnus-summary-crosspost-article}). This will create a new copy of + the article in the other group, and the Xref headers of the article will + be properly updated. + @item B i @kindex B i (Summary) @findex gnus-summary-import-article *************** *** 7661,7671 **** @cindex article buffer The articles are displayed in the article buffer, of which there is only ! one. All the summary buffer share the same article buffer. @menu * Hiding Headers:: Deciding what headers should be displayed. ! * Using Mime:: Pushing articles through @sc{mime} before reading them. * Customizing Articles:: Tailoring the look of the articles. * Article Keymap:: Keystrokes available in the article buffer * Misc Article:: Other stuff. --- 8252,8263 ---- @cindex article buffer The articles are displayed in the article buffer, of which there is only ! one. All the summary buffers share the same article buffer unless you ! tell Gnus otherwise. @menu * Hiding Headers:: Deciding what headers should be displayed. ! * Using MIME:: Pushing articles through @sc{mime} before reading them. * Customizing Articles:: Tailoring the look of the articles. * Article Keymap:: Keystrokes available in the article buffer * Misc Article:: Other stuff. *************** *** 7749,7756 **** variable, will be displayed in random order after all the headers that are listed in this variable. ! @node Using Mime ! @section Using Mime @cindex @sc{mime} Mime is a standard for waving your hands through the air, aimlessly, --- 8341,8386 ---- variable, will be displayed in random order after all the headers that are listed in this variable. ! @findex gnus-article-hide-boring-headers ! @vindex gnus-article-display-hook ! @vindex gnus-boring-article-headers ! You can hide further boring headers by entering ! @code{gnus-article-hide-boring-headers} into ! @code{gnus-article-display-hook}. What this function does depends on ! the @code{gnus-boring-article-headers} variable. It's a list, but this ! list doesn't actually contain header names. Instead is lists various ! @dfn{boring conditions} that Gnus can check and remove from sight. ! ! These conditions are: ! @table @code ! @item empty ! Remove all empty headers. ! @item newsgroups ! Remove the @code{Newsgroups} header if it only contains the current group ! name. ! @item followup-to ! Remove the @code{Followup-To} header if it is identical to the ! @code{Newsgroups} header. ! @item reply-to ! Remove the @code{Reply-To} header if it lists the same address as the ! @code{From} header. ! @item date ! Remove the @code{Date} header if the article is less than three days ! old. ! @end table ! ! To include the four first elements, you could say something like; ! ! @lisp ! (setq gnus-boring-article-headers ! '(empty newsgroups followup-to reply-to)) ! @end lisp ! ! This is also the default value for this variable. ! ! ! @node Using MIME ! @section Using @sc{mime} @cindex @sc{mime} Mime is a standard for waving your hands through the air, aimlessly, *************** *** 7765,7785 **** @vindex gnus-show-mime @vindex gnus-show-mime-method Gnus handles @sc{mime} by shoving the articles through @code{gnus-show-mime-method}, which is @code{metamail-buffer} by ! default. If @code{gnus-strict-mime} is non-@code{nil}, the @sc{mime} ! method will only be used it there are @sc{mime} headers in the article. ! Set @code{gnus-show-mime} to @code{t} if you want to use @sc{mime} all ! the time; it might be best to just use the toggling functions from the ! summary buffer to avoid getting nasty surprises. (For instance, you ! enter the group @samp{alt.sing-a-long} and, before you know it, ! @sc{mime} has decoded the sound file in the article and some horrible ! sing-a-long song comes streaming out out your speakers, and you can't ! find the volume button, because there isn't one, and people are starting ! to look at you, and you try to stop the program, but you can't, and you ! can't find the program to control the volume, and everybody else in the ! room suddenly decides to look at you disdainfully, and you'll feel ! rather stupid.) Any similarity to real events and people is purely coincidental. Ahem. --- 8395,8417 ---- @vindex gnus-show-mime @vindex gnus-show-mime-method + @vindex gnus-strict-mime Gnus handles @sc{mime} by shoving the articles through @code{gnus-show-mime-method}, which is @code{metamail-buffer} by ! default. Set @code{gnus-show-mime} to @code{t} if you want to use ! @sc{mime} all the time. However, if @code{gnus-strict-mime} is ! non-@code{nil}, the @sc{mime} method will only be used if there are ! @sc{mime} headers in the article. ! ! It might be best to just use the toggling functions from the summary ! buffer to avoid getting nasty surprises. (For instance, you enter the ! group @samp{alt.sing-a-long} and, before you know it, @sc{mime} has ! decoded the sound file in the article and some horrible sing-a-long song ! comes streaming out out your speakers, and you can't find the volume ! button, because there isn't one, and people are starting to look at you, ! and you try to stop the program, but you can't, and you can't find the ! program to control the volume, and everybody else in the room suddenly ! decides to look at you disdainfully, and you'll feel rather stupid.) Any similarity to real events and people is purely coincidental. Ahem. *************** *** 7810,7820 **** @node Article Keymap @section Article Keymap ! @c Most of the keystrokes in the summary buffer can also be used in the ! @c article buffer. They should behave as if you typed them in the summary ! @c buffer, which means that you don't actually have to have a summary ! @c buffer displayed while reading. You can do it all from the article ! @c buffer. A few additional keystrokes are available: --- 8442,8452 ---- @node Article Keymap @section Article Keymap ! Most of the keystrokes in the summary buffer can also be used in the ! article buffer. They should behave as if you typed them in the summary ! buffer, which means that you don't actually have to have a summary ! buffer displayed while reading. You can do it all from the article ! buffer. A few additional keystrokes are available: *************** *** 8531,8539 **** @item gnus-score-expiry-days @vindex gnus-score-expiry-days This variable says how many days should pass before an unused score file ! entry is expired. The default is 7. @end table @node Score File Format @section Score File Format @cindex score file format --- 9163,9183 ---- @item gnus-score-expiry-days @vindex gnus-score-expiry-days This variable says how many days should pass before an unused score file ! entry is expired. If this variable is @code{nil}, no score file entries ! are expired. It's 7 by default. ! ! @item gnus-update-score-entry-dates ! @vindex gnus-update-score-entry-dates ! If this variable is non-@code{nil}, matching score entries will have ! their dates updated. (This is how Gnus controls expiry---all ! non-matching entries will become too old while matching entries will ! stay fresh and young.) However, if you set this variable to @code{nil}, ! even matching entries will grow old and will have to face that oh-so ! grim reaper. ! @end table + @node Score File Format @section Score File Format @cindex score file format *************** *** 8652,8657 **** --- 9296,9306 ---- @item Followup This match key will add a score entry on all articles that followup to some author. Uses the same match types as the @code{From} header uses. + + @item Thread + This match key will add a ascore entry on all articles that are part of + a thread. Uses the same match types as the @code{References} header + uses. @end table @end enumerate *************** *** 8798,8804 **** @code{chars} and @code{date}. In addition, you can score on @code{followup}, which will create an adaptive score entry that matches on the @code{References} header using the @code{Message-ID} of the ! current article, thereby matching the following thread. If you use this scheme, you should set @code{mark-below} to something small---like -300, perhaps, to avoid having small random changes result --- 9447,9460 ---- @code{chars} and @code{date}. In addition, you can score on @code{followup}, which will create an adaptive score entry that matches on the @code{References} header using the @code{Message-ID} of the ! current article, thereby matching the following thread. ! ! You can also score on @code{thread}, which will try to score all ! articles that appear in a thread. @code{thread} matches uses a ! @code{Message-ID} to match on the @code{References} header of the ! article. If the match is made, the @code{Message-ID} of the article is ! added to the @code{thread} rule. (Think about it. I'd recommend two ! aspirins afterwards.) If you use this scheme, you should set @code{mark-below} to something small---like -300, perhaps, to avoid having small random changes result *************** *** 9085,9092 **** @item gnus-expert-user @vindex gnus-expert-user If this variable is non-@code{nil}, you will never ever be asked any ! questions by Gnus. It will simply assume you know what your are doing, ! no matter how strange. @item gnus-interactive-catchup @vindex gnus-interactive-catchup --- 9741,9748 ---- @item gnus-expert-user @vindex gnus-expert-user If this variable is non-@code{nil}, you will never ever be asked any ! questions by Gnus. It will simply assume you know what you're doing, no ! matter how strange. @item gnus-interactive-catchup @vindex gnus-interactive-catchup *************** *** 9202,9210 **** @lisp ((group (vertical 1.0 (group 1.0 point) ! (if gnus-carpal (group-carpal 4)))) (article (vertical 1.0 (summary 0.25 point) ! (article 1.0)))) @end lisp This is an alist. The @dfn{key} is a symbol that names some action or --- 9858,9866 ---- @lisp ((group (vertical 1.0 (group 1.0 point) ! (if gnus-carpal (group-carpal 4)))) (article (vertical 1.0 (summary 0.25 point) ! (article 1.0)))) @end lisp This is an alist. The @dfn{key} is a symbol that names some action or *************** *** 9283,9294 **** @example split = frame | horizontal | vertical | buffer | form ! frame = "(frame " frame-size *split ")" horizontal = "(horizontal " size *split ")" vertical = "(vertical " size *split ")" buffer = "(" buffer-name " " size *[ "point" ] ")" ! frame-size = "(" number " . " number ")" ! size = number buffer-name = group | article | summary ... @end example --- 9939,9949 ---- @example split = frame | horizontal | vertical | buffer | form ! frame = "(frame " size *split ")" horizontal = "(horizontal " size *split ")" vertical = "(vertical " size *split ")" buffer = "(" buffer-name " " size *[ "point" ] ")" ! size = number | frame-params buffer-name = group | article | summary ... @end example *************** *** 9297,9305 **** return a valid split. We see that each split is fully recursive, and may contain any number of @samp{vertical} and @samp{horizontal} splits. Finding the right sizes can be a bit complicated. No window may be less ! than 4 characters high, and all windows must be at least 10 characters ! wide. Gnus will try to enforce this before applying the splits. If you're not familiar with Emacs terminology, @samp{horizontal} and @samp{vertical} splits may work the opposite way of what you'd expect. --- 9952,9967 ---- return a valid split. We see that each split is fully recursive, and may contain any number of @samp{vertical} and @samp{horizontal} splits. + @vindex gnus-window-min-width + @vindex gnus-window-min-height + @cindex window height + @cindex window width Finding the right sizes can be a bit complicated. No window may be less ! than @code{gnus-window-min-height} (default 2) characters high, and all ! windows must be at least @code{gnus-window-min-wide} (default 1) ! characters wide. Gnus will try to enforce this before applying the ! splits. If you want to use the normal Emacs window width/height limit, ! you can just set these two variables to @code{nil}. If you're not familiar with Emacs terminology, @samp{horizontal} and @samp{vertical} splits may work the opposite way of what you'd expect. *************** *** 9318,9324 **** @code{gnus-add-configuration} to add your new creation to the buffer configuration list. ! @example (gnus-configure-frame '(horizontal 1.0 (vertical 10 --- 9980,9986 ---- @code{gnus-add-configuration} to add your new creation to the buffer configuration list. ! @lisp (gnus-configure-frame '(horizontal 1.0 (vertical 10 *************** *** 9329,9335 **** (horizontal 4 (group 1.0) (article 10))))) ! @end example Here's a list of all possible keys for @code{gnus-buffer-configuaration}: --- 9991,10020 ---- (horizontal 4 (group 1.0) (article 10))))) ! @end lisp ! ! You might want to have several frames as well. No prob---just use the ! @code{frame} split: ! ! @lisp ! (gnus-configure-frame ! '(frame 1.0 ! (vertical 1.0 ! (summary 0.25 point) ! (article 1.0)) ! (vertical ((height . 5) (width . 15) ! (user-position . t) ! (left . -1) (top . 1)) ! (picon 1.0)))) ! ! @end lisp ! ! This split will result in the familiar summary/article window ! configuration in the first (or "main") frame, while a small additional ! frame will be created where picons will be shown. As you can see, ! instead of the normal @samp{1.0} top-level spec, each additional split ! should have a frame parameter alist as the size spec. ! @xref{(elisp)Frame Parameters}. Here's a list of all possible keys for @code{gnus-buffer-configuaration}: *************** *** 9562,9567 **** --- 10247,10257 ---- most important messages will be shown, and if it is ten, Gnus won't ever shut up, but will flash so many messages it will make your head swim. + @item gnus-verbose-backends + @vindex gnus-verbose-backends + This variable works the same way as @code{gnus-verbose}, but it applies + to the Gnus backends instead of Gnus proper. + @item gnus-updated-mode-lines @vindex gnus-updated-mode-lines This is a list of buffers that should keep their mode lines updated. *************** *** 9582,9593 **** non-info part). If you put additional elements on the mode line (eg. a clock), you should modify this variable: ! @c Hook written by Keinonen Kari . @lisp (add-hook 'display-time-hook ! (lambda () ! (setq gnus-mode-non-string-length ! (+ 21 (length display-time-string))))) @end lisp If this variable is @code{nil} (which is the default), the mode line --- 10272,10285 ---- non-info part). If you put additional elements on the mode line (eg. a clock), you should modify this variable: ! @c Hook written by Francesco Potorti` @lisp (add-hook 'display-time-hook ! (lambda () (setq gnus-mode-non-string-length ! (+ 21 ! (if line-number-mode 5 0) ! (if column-number-mode 4 0) ! (length display-time-string))))) @end lisp If this variable is @code{nil} (which is the default), the mode line *************** *** 9682,9687 **** --- 10374,10395 ---- but read the entire articles. This makes sense with some versions of @code{ange-ftp}. + @item nnheader-file-name-translation-alist + @vindex nnheader-file-name-translation-alist + @cindex file names + @cindex illegal characters in file names + @cindex characters in file names + This is an alist that says how to translate characters in file names. + For instance, if @samp{:} is illegal as a file character in file names + on your system (you OS/2 user you), you could say something like: + + @lisp + (setq nnheader-file-name-translation-alist + '((?: . ?_))) + @end lisp + + In fact, this is the default value for this variable on OS/2 and MS + Windows (phooey) systems. @end table *************** *** 9733,9739 **** @item gnus-auto-center-summary Set this to @code{nil} to inhibit Gnus from recentering the summary ! buffer all the time. @item gnus-visible-headers Cut down on the headers that are included in the articles to the --- 10441,10447 ---- @item gnus-auto-center-summary Set this to @code{nil} to inhibit Gnus from recentering the summary ! buffer all the time. @item gnus-visible-headers Cut down on the headers that are included in the articles to the *************** *** 9906,9912 **** @node A Programmer@'s Guide to Gnus ! @section A Programmer@'s Guide to Gnus It is my hope that other people will figure out smart stuff that Gnus can do, and that other people will write those smart things as well. To --- 10614,10620 ---- @node A Programmer@'s Guide to Gnus ! @section A Programmer's Guide to Gnus It is my hope that other people will figure out smart stuff that Gnus can do, and that other people will write those smart things as well. To *************** *** 10247,10253 **** information (as is the case with virtual an imap groups). This function may alter the info in any manner it sees fit, and should return the (altered) group info. This function may alter the group info ! destructively, so no copying is needed before boogying. There should be no result data from this function. --- 10955,10990 ---- information (as is the case with virtual an imap groups). This function may alter the info in any manner it sees fit, and should return the (altered) group info. This function may alter the group info ! destructively, so no copying is needed before boogeying. ! ! There should be no result data from this function. ! ! ! @item (nnchoke-request-type GROUP &optional ARTICLE) ! ! When the user issues commands for "sending news" (@kbd{F} in the summary ! buffer, for instance), Gnus has to know whether the article the user is ! following up is news or mail. This function should return @code{news} ! if @var{article} in @var{group} is news, @code{mail} if it is mail and ! @code{unknown} if the type can't be decided. (The @var{article} ! parameter is necessary in @code{nnvirtual} groups which might very well ! combine mail groups and news groups.) ! ! There should be no result data from this function. ! ! ! @item (nnchoke-request-update-mark GROUP ARTICLE MARK) ! ! If the user tries to set a mark that the backend doesn't like, this ! function may change the mark. Gnus will use whatever this function ! returns as the mark for @var{article} instead of the original ! @var{mark}. If the backend doesn't care, it must return the original ! @var{mark}, and not @code{nil} or any other type of garbage. ! ! The only use for this that I can see is what @code{nnvirtual} does with ! it---if a component group is auto-expirable, marking an article as read ! in the virtual group should result in the article being marked as ! expirable. There should be no result data from this function. *** pub/sgnus/texi/ChangeLog Thu Dec 21 04:10:01 1995 --- sgnus/texi/ChangeLog Tue Jan 16 15:33:46 1996 *************** *** 1,3 **** --- 1,86 ---- + Tue Jan 16 15:33:04 1996 Lars Ingebrigtsen + + * gnus.texi (Article Hiding): Fix. + + Mon Jan 15 21:00:55 1996 Lars Ingebrigtsen + + * gnus.texi (Group Parameters): Addition. + (A Programmer@'s Guide to Gnus): Fix. + (Summary Buffer Lines): Addition. + + Fri Jan 12 00:33:38 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Summary Maneuvering): Change. + (Article Caching): Change. + (nnfolder): Addition. + (Various Various): Addition. + (Tree Display): Addition. + (Archived Messages): New. + + Thu Jan 11 10:26:31 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Selecting a Group): Addition. + (Using MIME): Change. + (Customizing Threading): Change. + + Wed Jan 10 09:56:34 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Various Various): Addition. + (Tree Display): Change. + (Reading Mail): Addition. + (Reading Mail): Addition. + + Tue Jan 09 13:27:06 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Thread Commands): Addition. + (Tree Display): New. + + Mon Jan 08 00:38:17 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Group Commands): Addition. + (Customizing Threading): Addition. + (Binary Groups): New. + (Alternative Approaches): New. + + Sun Jan 07 07:16:43 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Posting Server): Addition. + (Limiting): Addition. + (Pick and Read): New. + (Score File Format): Addition. + + Sat Jan 06 14:04:31 1996 Lars Magne Ingebrigtsen + + * gnus.texi (New Groups): Addition. + (Customizing Threading): Addition. + + Fri Jan 05 03:52:42 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Addition. + (nntp): Addition. + (nnvirtual): Addition. + (Reading Mail): Addition. + + Thu Jan 04 01:48:22 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Various Various): Addition. + (Marking Groups): Addition. + (Marking Groups): Addition. + (Group Parameters): Addition. + (Windows Configuration): Addition. + (Starting Up): Addition. + (Article Keymap): Addition. + (Customizing Threading): Addition. + + Wed Jan 03 06:12:24 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Hiding Headers): Addition. + (Article Hiding): Addition. + + * gnus.texi (Misc Group Stuff): Addition. + (Creating Mail Groups): Addition. + (Limiting): Addition. + Wed Dec 20 01:13:35 1995 Lars Ingebrigtsen * gnus.texi (Finding the News): Change.