*** pub/rgnus/lisp/article.el Tue Jul 30 22:59:13 1996 --- rgnus/lisp/article.el Tue Jul 30 22:36:47 1996 *************** *** 0 **** --- 1,791 ---- + ;;; article.el --- article treatment functions + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'nnheader) + (require 'gnus-util) + (require 'message) + + (defvar article-ignored-headers + "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" + "*All headers that match this regexp will be hidden. + This variable can also be a list of regexps of headers to be ignored. + If `article-visible-headers' is non-nil, this variable will be ignored.") + + (defvar article-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, `article-ignored-headers' will be ignored.") + + (defvar article-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 article-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 article-signature-separator "^-- *$" + "Regexp matching signature separator.") + + (defvar gnus-signature-separator "^-- *$" + "Regexp matching signature separator.") + + (defvar article-signature-limit nil + "Provide a limit to what is considered a signature. + If it is a number, no signature may not be longer (in characters) than + that number. If it is a function, the function will be called without + any parameters, and if it returns nil, there is no signature in the + buffer. If it is a string, it will be used as a regexp. If it + matches, the text in question is not a signature.") + + (defvar article-hidden-properties '(invisible t intangible t) + "Property list to use for hiding text.") + + (defvar article-x-face-command + "{ 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 article-x-face-too-ugly nil + "Regexp matching posters whose face shouldn't be shown automatically.") + + (defvar article-emphasis-alist + '(("_\\(\\w+\\)_" 0 1 'underline) + ("\\W\\(/\\(\\w+\\)/\\)\\W" 1 2 'italic) + ("\\(_\\*\\|\\*_\\)\\(\\w+\\)\\(_\\*\\|\\*_\\)" 0 2 'bold-underline) + ("\\*\\(\\w+\\)\\*" 0 1 'bold)) + "Alist that says how to fontify certain phrases. + Each item looks like this: + + (\"_\\\\([[\\w+\\\\)_\" 0 1 'underline) + + The first element is a regular expression to be matched. The second + is a number that says what regular expression grouping used to find + the entire emphasized word. The third is a number that says what + regexp grouping should be displayed and highlighted. The fourth + is the face used for highlighting.") + + (eval-and-compile + (autoload 'hexl-hex-string-to-integer "hexl") + (autoload 'timezone-make-date-arpa-standard "timezone") + (autoload 'mail-extract-address-components "mail-extr")) + + ;;; Internal variables. + + (defvar article-inhibit-hiding nil) + (defvar gnus-newsgroup-name) + + (defsubst article-hide-text (b e props) + "Set text PROPS on the B to E region, extending `intangible' 1 past B." + (add-text-properties b e props) + (when (memq 'intangible props) + (put-text-property + (max (1- b) (point-min)) + b 'intangible (cddr (memq 'intangible props))))) + + (defsubst article-unhide-text (b e) + "Remove hidden text properties from region between B and E." + (remove-text-properties b e article-hidden-properties) + (when (memq 'intangible article-hidden-properties) + (put-text-property (max (1- b) (point-min)) + b 'intangible nil))) + + (defun article-hide-text-type (b e type) + "Hide text of TYPE between B and E." + (article-hide-text + b e (cons 'article-type (cons type article-hidden-properties)))) + + (defun article-unhide-text-type (b e type) + "Hide text of TYPE between B and E." + (remove-text-properties + b e (cons 'article-type (cons type article-hidden-properties))) + (when (memq 'intangible article-hidden-properties) + (put-text-property (max (1- b) (point-min)) + b 'intangible nil))) + + (defsubst article-header-rank () + "Give the rank of the string HEADER as given by `article-sorted-header-list'." + (let ((list article-sorted-header-list) + (i 0)) + (while list + (when (looking-at (car list)) + (setq list nil)) + (setq list (cdr list)) + (incf i)) + i)) + + (defun 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 (article-hidden-arg)) + (if (article-check-hidden-text 'headers arg) + ;; Show boring headers as well. + (article-show-hidden-text 'boring-headers) + ;; This function might be inhibited. + (unless article-inhibit-hiding + (save-excursion + (save-restriction + (let ((buffer-read-only nil) + (props (nconc (list 'article-type 'headers) + article-hidden-properties)) + (max (1+ (length article-sorted-header-list))) + (ignored (when (not (stringp article-visible-headers)) + (cond ((stringp article-ignored-headers) + article-ignored-headers) + ((listp article-ignored-headers) + (mapconcat 'identity article-ignored-headers + "\\|"))))) + (visible + (cond ((stringp article-visible-headers) + article-visible-headers) + ((and article-visible-headers + (listp article-visible-headers)) + (mapconcat 'identity article-visible-headers "\\|")))) + (inhibit-point-motion-hooks t) + want-list beg) + ;; 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) + (if delete + (delete-region (point-min) (point)) + (article-hide-text (point-min) (point) props))) + ;; 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 + ;; `article-ignored-headers' and `article-visible-headers' to + ;; select which header lines is to remain visible in the + ;; article buffer. + (goto-char (point-min)) + (while (re-search-forward "^[^ \t]*:" nil t) + (beginning-of-line) + ;; We add the headers we want to keep to a list and delete + ;; them from the buffer. + (put-text-property + (point) (1+ (point)) 'message-rank + (if (or (and visible (looking-at visible)) + (and ignored + (not (looking-at ignored)))) + (article-header-rank) + (+ 2 max))) + (forward-line 1)) + (message-sort-headers-1) + (when (setq beg (text-property-any + (point-min) (point-max) 'message-rank (+ 2 max))) + ;; We make the unwanted headers invisible. + (if delete + (delete-region beg (point-max)) + ;; Suggested by Sudish Joseph . + (article-hide-text-type beg (point-max) 'headers)) + ;; Work around XEmacs lossage. + (put-text-property (point-min) beg 'invisible nil)))))))) + + (defun 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 (article-hidden-arg)) + (unless (article-check-hidden-text 'boring-headers arg) + (save-excursion + (save-restriction + (let ((buffer-read-only nil) + (list article-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) + (article-hide-text-type + (progn (beginning-of-line) (point)) + (progn + (end-of-line) + (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + (point-max))) + 'boring-headers))) + ;; Hide boring Newsgroups header. + ((eq elem 'newsgroups) + (when (equal (gnus-fetch-field "newsgroups") + (gnus-group-real-name + (if (boundp 'gnus-newsgroup-name) + gnus-newsgroup-name + ""))) + (article-hide-header "newsgroups"))) + ((eq elem 'followup-to) + (when (equal (message-fetch-field "followup-to") + (message-fetch-field "newsgroups")) + (article-hide-header "followup-to"))) + ((eq elem 'reply-to) + (let ((from (message-fetch-field "from")) + (reply-to (message-fetch-field "reply-to"))) + (when (and + from reply-to + (equal + (nth 1 (mail-extract-address-components from)) + (nth 1 (mail-extract-address-components reply-to)))) + (article-hide-header "reply-to")))) + ((eq elem 'date) + (let ((date (message-fetch-field "date"))) + (when (and date + (< (gnus-days-between date (current-time-string)) + 4)) + (article-hide-header "date"))))))))))) + + (defun article-hide-header (header) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (concat "^" header ":") nil t) + (article-hide-text-type + (progn (beginning-of-line) (point)) + (progn + (end-of-line) + (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + (point-max))) + 'boring-headers)))) + + ;; Written by Per Abrahamsen . + (defun article-treat-overstrike () + "Translate overstrikes into bold text." + (interactive) + (save-excursion + (let ((buffer-read-only nil)) + (while (search-forward "\b" nil t) + (let ((next (following-char)) + (previous (char-after (- (point) 2)))) + ;; We do the boldification/underlining by hiding the + ;; overstrikes and putting the proper text property + ;; on the letters. + (cond + ((eq next previous) + (article-hide-text-type (- (point) 2) (point) 'overstrike) + (put-text-property (point) (1+ (point)) 'face 'bold)) + ((eq next ?_) + (article-hide-text-type (1- (point)) (1+ (point)) 'overstrike) + (put-text-property + (- (point) 2) (1- (point)) 'face 'underline)) + ((eq previous ?_) + (article-hide-text-type (- (point) 2) (point) 'overstrike) + (put-text-property + (point) (1+ (point)) 'face 'underline)))))))) + + (defun article-fill () + "Format too long lines." + (interactive) + (save-excursion + (let ((buffer-read-only nil)) + (widen) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (end-of-line 1) + (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") + (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") + (adaptive-fill-mode t)) + (while (not (eobp)) + (and (>= (current-column) (min fill-column (window-width))) + (/= (preceding-char) ?:) + (fill-paragraph nil)) + (end-of-line 2)))))) + + (defun article-remove-cr () + "Remove carriage returns from an article." + (interactive) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (search-forward "\r" nil t) + (replace-match "" t t))))) + + (defun article-remove-trailing-blank-lines () + "Remove all trailing blank lines from the article." + (interactive) + (save-excursion + (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 article-display-x-face (&optional force) + "Look for an X-Face header and display it if present." + (interactive (list 'force)) + (save-excursion + ;; Delete the old process, if any. + (when (process-status "article-x-face") + (delete-process "article-x-face")) + (let ((inhibit-point-motion-hooks t) + (case-fold-search nil) + from) + (save-restriction + (nnheader-narrow-to-headers) + (setq from (message-fetch-field "from")) + (goto-char (point-min)) + (when (and article-x-face-command + (or force + ;; Check whether this face is censored. + (not article-x-face-too-ugly) + (and article-x-face-too-ugly from + (not (string-match article-x-face-too-ugly + from)))) + ;; Has to be present. + (re-search-forward "^X-Face: " nil t)) + ;; We now have the area of the buffer where the X-Face is stored. + (let ((beg (point)) + (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) + ;; We display the face. + (if (symbolp article-x-face-command) + ;; The command is a lisp function, so we call it. + (if (gnus-functionp article-x-face-command) + (funcall article-x-face-command beg end) + (error "%s is not a function" article-x-face-command)) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name shell-command-switch + article-x-face-command)) + (process-send-region "article-x-face" beg end) + (process-send-eof "article-x-face"))))))))) + + (defalias 'article-headers-decode-quoted-printable 'article-decode-rfc1522) + (defun article-decode-rfc1522 () + "Hack to remove QP encoding from headers." + (let ((case-fold-search t) + (inhibit-point-motion-hooks t) + (buffer-read-only nil) + string) + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-max))) + + (goto-char (point-min)) + (while (re-search-forward + "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) + (setq string (match-string 1)) + (narrow-to-region (match-beginning 0) (match-end 0)) + (delete-region (point-min) (point-max)) + (insert string) + (article-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) + (subst-char-in-region (point-min) (point-max) ?_ ? ) + (widen) + (goto-char (point-min)))))) + + (defun 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 + (let ((case-fold-search t) + (buffer-read-only nil) + (type (gnus-fetch-field "content-transfer-encoding"))) + (article-decode-rfc1522) + (when (or force + (and type (string-match "quoted-printable" (downcase type)))) + (goto-char (point-min)) + (search-forward "\n\n" nil 'move) + (article-mime-decode-quoted-printable (point) (point-max)))))) + + (defun article-mime-decode-quoted-printable (from to) + "Decode Quoted-Printable in the region between FROM and TO." + (interactive "r") + (goto-char from) + (while (search-forward "=" to t) + (cond ((eq (following-char) ?\n) + (delete-char -1) + (delete-char 1)) + ((looking-at "[0-9A-F][0-9A-F]") + (subst-char-in-region + (1- (point)) (point) ?= + (hexl-hex-string-to-integer + (buffer-substring (point) (+ 2 (point))))) + (delete-char 2)) + ((looking-at "=") + (delete-char 1)) + ((gnus-message 3 "Malformed MIME quoted-printable message"))))) + + (defun 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 (article-hidden-arg)) + (unless (article-check-hidden-text 'pgp arg) + (save-excursion + (let (buffer-read-only beg end) + (widen) + (goto-char (point-min)) + ;; Hide the "header". + (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) + (article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) + (setq beg (point)) + ;; Hide the actual signature. + (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) + (setq end (1+ (match-beginning 0))) + (article-hide-text-type + end + (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) + (match-end 0) + ;; Perhaps we shouldn't hide to the end of the buffer + ;; if there is no end to the signature? + (point-max)) + 'pgp)) + ;; Hide "- " PGP quotation markers. + (when (and beg end) + (narrow-to-region beg end) + (goto-char (point-min)) + (while (re-search-forward "^- " nil t) + (article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) + (widen)))))) + + (defun article-hide-pem (&optional arg) + "Toggle hiding of any PEM headers and signatures in the current article. + If given a negative prefix, always show; if given a positive prefix, + always hide." + (interactive (article-hidden-arg)) + (unless (article-check-hidden-text 'pem arg) + (save-excursion + (let (buffer-read-only end) + (widen) + (goto-char (point-min)) + ;; hide the horrendously ugly "header". + (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" + nil + t) + (setq end (1+ (match-beginning 0))) + (article-hide-text-type + end + (if (search-forward "\n\n" nil t) + (match-end 0) + (point-max)) + 'pem)) + ;; hide the trailer as well + (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" + nil + t) + (article-hide-text-type + (match-beginning 0) (match-end 0) 'pem)))))) + + (defun 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 (article-hidden-arg)) + (unless (article-check-hidden-text 'signature arg) + (save-excursion + (save-restriction + (let ((buffer-read-only nil)) + (when (article-narrow-to-signature) + (article-hide-text-type (point-min) (point-max) 'signature))))))) + + (defun article-strip-leading-blank-lines () + "Remove all blank lines from the beginning of the article." + (interactive) + (save-excursion + (let (buffer-read-only) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (while (looking-at "[ \t]$") + (gnus-delete-line)))))) + + (defvar mime::preview/content-list) + (defvar mime::preview-content-info/point-min) + (defun article-narrow-to-signature () + "Narrow to the signature." + (widen) + (if (and (boundp 'mime::preview/content-list) + mime::preview/content-list) + (let ((pcinfo (car (last mime::preview/content-list)))) + (condition-case () + (narrow-to-region + (funcall (intern "mime::preview-content-info/point-min") pcinfo) + (point-max)) + (error nil)))) + (goto-char (point-max)) + (when (re-search-backward article-signature-separator nil t) + (forward-line 1) + (when (or (null article-signature-limit) + (and (numberp article-signature-limit) + (< (- (point-max) (point)) article-signature-limit)) + (and (gnus-functionp article-signature-limit) + (funcall article-signature-limit)) + (and (stringp article-signature-limit) + (not (re-search-forward article-signature-limit nil t)))) + (narrow-to-region (point) (point-max)) + t))) + + (defun article-hidden-arg () + "Return the current prefix arg as a number, or 0 if no prefix." + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 0))) + + (defun article-check-hidden-text (type arg) + "Return nil if hiding is necessary. + Arg can be nil or a number. Nil and positive means hide, negative + means show, 0 means toggle." + (save-excursion + (let ((hide (article-hidden-text-p type))) + (cond + ((or (null arg) + (> arg 0)) + nil) + ((< arg 0) + (article-show-hidden-text type)) + (t + (if (eq hide 'hidden) + (article-show-hidden-text type) + nil)))))) + + (defun 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) 'article-type type))) + (when pos + (if (get-text-property pos 'invisible) + 'hidden + 'shown)))) + + (defun article-show-hidden-text (type &optional hide) + "Show all hidden text of type TYPE. + If HIDE, hide the text instead." + (save-excursion + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (beg (point-min))) + (while (gnus-goto-char (text-property-any + beg (point-max) 'article-type type)) + (setq beg (point)) + (forward-char) + (if hide + (article-hide-text beg (point) article-hidden-properties) + (article-unhide-text beg (point))) + (setq beg (point))) + t))) + + (defvar article-time-units + `((year . ,(* 365.25 24 60 60)) + (week . ,(* 7 24 60 60)) + (day . ,(* 24 60 60)) + (hour . ,(* 60 60)) + (minute . 60) + (second . 1)) + "Mapping from time units to seconds.") + + (defun article-date-ut (&optional type highlight header) + "Convert DATE date to universal time in the current article. + If TYPE is `local', convert to local time; if it is `lapsed', output + how much time has lapsed since DATE." + (interactive (list 'ut t)) + (let* ((header (or header (message-fetch-field "date") "")) + (date (and (vectorp header) (mail-header-date header))) + (date-regexp "^Date: \\|^X-Sent: ") + (now (current-time)) + (inhibit-point-motion-hooks t) + bface eface) + (when (and date (not (string= date ""))) + (save-excursion + (save-restriction + (nnheader-narrow-to-headers) + (let ((buffer-read-only nil)) + ;; Delete any old Date headers. + (if (re-search-forward date-regexp nil t) + (progn + (setq bface (get-text-property (gnus-point-at-bol) 'face) + eface (get-text-property (1- (gnus-point-at-eol)) + 'face)) + (message-remove-header date-regexp t) + (beginning-of-line)) + (goto-char (point-max))) + (insert (article-make-date-line date type)) + ;; Do highlighting. + (forward-line -1) + (when (looking-at "\\([^:]+\\): *\\(.*\\)$") + (put-text-property (match-beginning 1) (match-end 1) + 'face bface) + (put-text-property (match-beginning 2) (match-end 2) + 'face eface)))))))) + + (defun article-make-date-line (date type) + "Return a DATE line of TYPE." + (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. + ((eq type 'local) + (concat "Date: " (condition-case () + (timezone-make-date-arpa-standard date) + (error date)) + "\n")) + ;; Convert to Universal Time. + ((eq type 'ut) + (concat "Date: " + (condition-case () + (timezone-make-date-arpa-standard date nil "UT") + (error date)) + "\n")) + ;; Get the original date from the article. + ((eq type 'original) + (concat "Date: " date "\n")) + ;; Do an X-Sent lapsed format. + ((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* ((now (current-time)) + (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) + (cond + ((equal real-time '(0 0)) + "X-Sent: Unknown\n") + ((zerop sec) + "X-Sent: Now\n") + (t + (concat + "X-Sent: " + ;; This is a bit convoluted, but basically we go + ;; 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" "")) + (setq prev t)))) + article-time-units "") + ;; If dates are odd, then it might appear like the + ;; article was sent in the future. + (if (> real-sec 0) + " ago\n" + " in the future\n")))))) + (t + (error "Unknown conversion type: %s" type)))) + + (defun article-date-local (&optional highlight) + "Convert the current article date to the local timezone." + (interactive (list t)) + (article-date-ut 'local highlight)) + + (defun article-date-original (&optional highlight) + "Convert the current article date to what it was originally. + This is only useful if you have used some other date conversion + function and want to see what the date was before converting." + (interactive (list t)) + (article-date-ut 'original highlight)) + + (defun article-date-lapsed (&optional highlight) + "Convert the current article date to time lapsed since it was sent." + (interactive (list t)) + (article-date-ut 'lapsed highlight)) + + (defun article-show-all () + "Show all hidden text in the article buffer." + (interactive) + (save-excursion + (let ((buffer-read-only nil)) + (article-unhide-text (point-min) (point-max))))) + + (defun article-emphasize (&optional arg) + "Empasize text according to `article-emphasis-alist'." + (interactive (article-hidden-arg)) + (unless (article-check-hidden-text 'emphasis arg) + (save-excursion + (let ((alist article-emphasis-alist) + (buffer-read-only nil) + (props (append '(article-type emphasis) + article-hidden-properties)) + regexp elem beg invisible visible face) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (setq beg (point)) + (while (setq elem (pop alist)) + (goto-char beg) + (setq regexp (car elem) + invisible (nth 1 elem) + visible (nth 2 elem) + face (nth 3 elem)) + (while (re-search-forward regexp nil t) + (article-hide-text + (match-beginning invisible) (match-end invisible) props) + (article-unhide-text-type + (match-beginning visible) (match-end visible) 'emphasis) + (put-text-property + (match-beginning visible) (match-end visible) + 'face face))))))) + + (provide 'article) + + ;;; article.el ends here *** pub/rgnus/lisp/gnus-art.el Tue Jul 30 22:59:14 1996 --- rgnus/lisp/gnus-art.el Mon Jul 29 21:34:02 1996 *************** *** 0 **** --- 1,1164 ---- + ;;; gnus-art.el --- article mode commands for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-sum) + (require 'article) + (require 'gnus-spec) + (require 'gnus-int) + + (defvar gnus-article-save-directory gnus-directory + "*Name of the directory articles will be saved in (default \"~/News\").") + + (defvar gnus-save-all-headers t + "*If non-nil, don't remove any headers before saving.") + + (defvar gnus-prompt-before-saving 'always + "*This variable says how much prompting is to be done when saving articles. + If it is nil, no prompting will be done, and the articles will be + saved to the default files. If this variable is `always', each and + every article that is saved will be preceded by a prompt, even when + saving large batches of articles. If this variable is neither nil not + `always', there the user will be prompted once for a file name for + each invocation of the saving commands.") + + (defvar gnus-saved-headers article-visible-headers + "*Headers to keep if `gnus-save-all-headers' is nil. + If `gnus-save-all-headers' is non-nil, this variable will be ignored. + If that variable is nil, however, all headers that match this regexp + will be kept while the rest will be deleted before saving.") + + (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail + "*A function to save articles in your favorite format. + The function must be interactively callable (in other words, it must + be an Emacs command). + + Gnus provides the following functions: + + * gnus-summary-save-in-rmail (Rmail format) + * gnus-summary-save-in-mail (Unix mail format) + * gnus-summary-save-in-folder (MH folder) + * gnus-summary-save-in-file (article format). + * gnus-summary-save-in-vm (use VM's folder format).") + + (defvar gnus-rmail-save-name (function gnus-plain-save-name) + "*A function generating a file name to save articles in Rmail format. + The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") + + (defvar gnus-mail-save-name (function gnus-plain-save-name) + "*A function generating a file name to save articles in Unix mail format. + The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") + + (defvar gnus-folder-save-name (function gnus-folder-save-name) + "*A function generating a file name to save articles in MH folder. + The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.") + + (defvar gnus-file-save-name (function gnus-numeric-save-name) + "*A function generating a file name to save articles in article format. + 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 + the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", + you could set this variable to something like: + + '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") + (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) + + This variable is an alist where the where the key is the match and the + 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. + + If this form or function returns a string, this string will be used as + a possible file name; and if it returns a non-nil list, that list will + be used as possible file names.") + + (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.") + + (defvar gnus-decode-encoded-word-method (lambda ()) + "*Function to decode a MIME encoded-words. + The function is called from the article buffer.") + + (defvar gnus-page-delimiter "^\^L" + "*Regexp describing what to use as article page delimiters. + The default value is \"^\^L\", which is a form linefeed at the + beginning of a line.") + + (defvar gnus-article-mode-line-format "Gnus: %%b %S" + "*The format specification for the article mode line. + See `gnus-summary-mode-line-format' for a closer description.") + + (defvar gnus-article-mode-hook nil + "*A hook for Gnus article mode.") + + (defvar gnus-article-prepare-hook nil + "*A hook called after an article has been prepared in the article buffer. + If you want to run a special decoding program like nkf, use this hook.") + + ;(defvar gnus-article-display-hook nil + ; "*A hook called after the article is displayed in the article buffer. + ;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) + ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike) + ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) + + ;;; Internal variables + + (defvar gnus-article-mode-line-format-alist + (nconc '((?w (gnus-article-wash-status) ?s)) + gnus-summary-mode-line-format-alist)) + + ;;; Provide a mapping from `gnus-*' commands to Article commands. + + (eval-and-compile + (mapcar + (lambda (func) + (let (afunc gfunc) + (if (consp func) + (setq afunc (car func) + gfunc (cdr func)) + (setq afunc func + gfunc (intern (format "gnus-%s" func)))) + (fset gfunc + `(lambda (&optional interactive &rest args) + ,(documentation afunc t) + (interactive (list t)) + (save-excursion + (set-buffer gnus-article-buffer) + (if interactive + (call-interactively ',afunc) + (apply ',afunc args))))))) + '(article-hide-headers + article-hide-boring-headers + article-treat-overstrike + (article-fill . gnus-article-word-wrap) + article-remove-cr + article-remove-trailing-blank-lines + article-display-x-face + article-de-quoted-unreadable + article-mime-decode-quoted-printable + article-hide-pgp + article-hide-pem + article-hide-signature + article-strip-leading-blank-lines + article-date-local + article-date-original + article-date-lapsed + article-emphasize + (article-show-all . gnus-article-show-all-headers)))) + + (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) + + ;;; Saving functions. + + (defun gnus-article-save (save-buffer file) + "Save the currently selected article." + (unless gnus-save-all-headers + ;; Remove headers accoring to `gnus-saved-headers'. + (let ((article-visible-headers + (or gnus-saved-headers article-visible-headers)) + (gnus-article-buffer save-buffer)) + (gnus-article-hide-headers 1 t))) + (save-window-excursion + (if (not gnus-default-article-saver) + (error "No default saver is defined.") + ;; !!! Magic! The saving functions all save + ;; `gnus-original-article-buffer' (or so they think), + ;; but we bind that variable to our save-buffer. + (set-buffer gnus-article-buffer) + (let ((gnus-original-article-buffer save-buffer)) + (set-buffer gnus-summary-buffer) + (funcall + gnus-default-article-saver + (cond + ((not gnus-prompt-before-saving) + 'default) + ((eq gnus-prompt-before-saving 'always) + nil) + (t file))))))) + + (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)) + (let* ((name (car split-name)) + (dir (cond ((file-directory-p name) + (file-name-as-directory name)) + ((file-exists-p name) name) + (t gnus-article-save-directory)))) + (read-file-name + (concat prompt " (default " name ") ") + dir name))) + ;; A list of splits was found. + (t + (setq split-name (nreverse split-name)) + (let (result) + (let ((file-name-history (nconc split-name file-name-history))) + (setq result + (read-file-name + (concat prompt " (`M-p' for defaults) ") + gnus-article-save-directory + (car split-name)))) + (car (push result file-name-history))))))) + ;; Create the directory. + (unless (equal (directory-file-name file) file) + (make-directory (file-name-directory file) t)) + ;; 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 characters. + (nnheader-translate-file-chars file))) + + (defun gnus-article-archive-name (group) + "Return the first instance of an \"Archive-name\" in the current buffer." + (let ((case-fold-search t)) + (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) + (nnheader-concat gnus-article-save-directory + (match-string 1))))) + + (defun gnus-summary-save-in-rmail (&optional filename) + "Append this article to Rmail file. + Optional argument FILENAME specifies file name. + Directory to save to is default to `gnus-article-save-directory'." + (interactive) + (gnus-set-global-variables) + (let ((default-name + (funcall gnus-rmail-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-rmail))) + (setq filename + (cond ((eq filename 'default) + default-name) + (filename filename) + (t (gnus-read-save-file-name + "Save in rmail file:" default-name)))) + (make-directory (file-name-directory filename) t) + (gnus-eval-in-buffer-window gnus-original-article-buffer + (save-excursion + (save-restriction + (widen) + (gnus-output-to-rmail filename)))) + ;; Remember the directory name to save articles + (setq gnus-newsgroup-last-rmail filename))) + + (defun gnus-summary-save-in-mail (&optional filename) + "Append this article to Unix mail file. + Optional argument FILENAME specifies file name. + Directory to save to is default to `gnus-article-save-directory'." + (interactive) + (gnus-set-global-variables) + (let ((default-name + (funcall gnus-mail-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-mail))) + (setq filename + (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)))) + (make-directory (file-name-directory filename) t) + (gnus-eval-in-buffer-window gnus-original-article-buffer + (save-excursion + (save-restriction + (widen) + (if (and (file-readable-p filename) (mail-file-babyl-p filename)) + (gnus-output-to-rmail filename) + (let ((mail-use-rfc822 t)) + (rmail-output filename 1 t t)))))) + ;; Remember the directory name to save articles. + (setq gnus-newsgroup-last-mail filename))) + + (defun gnus-summary-save-in-file (&optional filename) + "Append this article to file. + Optional argument FILENAME specifies file name. + Directory to save to is default to `gnus-article-save-directory'." + (interactive) + (gnus-set-global-variables) + (let ((default-name + (funcall gnus-file-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-file))) + (setq filename + (cond ((eq filename 'default) + default-name) + (filename filename) + (t (gnus-read-save-file-name + "Save in file:" default-name)))) + (make-directory (file-name-directory filename) t) + (gnus-eval-in-buffer-window gnus-original-article-buffer + (save-excursion + (save-restriction + (widen) + (gnus-output-to-file filename)))) + ;; Remember the directory name to save articles. + (setq gnus-newsgroup-last-file filename))) + + (defun gnus-summary-save-body-in-file (&optional filename) + "Append this article body to a file. + Optional argument FILENAME specifies file name. + The directory to save in defaults to `gnus-article-save-directory'." + (interactive) + (gnus-set-global-variables) + (let ((default-name + (funcall gnus-file-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-file))) + (setq filename + (cond ((eq filename 'default) + default-name) + (filename filename) + (t (gnus-read-save-file-name + "Save body in file:" default-name)))) + (make-directory (file-name-directory filename) t) + (gnus-eval-in-buffer-window gnus-original-article-buffer + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (and (search-forward "\n\n" nil t) + (narrow-to-region (point) (point-max))) + (gnus-output-to-file filename)))) + ;; Remember the directory name to save articles. + (setq gnus-newsgroup-last-file filename))) + + (defun gnus-summary-save-in-pipe (&optional command) + "Pipe this article to subprocess." + (interactive) + (gnus-set-global-variables) + (setq command + (cond ((eq command 'default) + gnus-last-shell-command) + (command command) + (t (read-string "Shell command on article: " + 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) + (shell-command-on-region (point-min) (point-max) command nil))) + (setq gnus-last-shell-command command)) + + ;;; Article file names when saving. + + (defun gnus-capitalize-newsgroup (newsgroup) + "Capitalize NEWSGROUP name." + (and (not (zerop (length newsgroup))) + (concat (char-to-string (upcase (aref newsgroup 0))) + (substring newsgroup 1)))) + + (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 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) + (gnus-capitalize-newsgroup newsgroup) + (gnus-newsgroup-directory-form newsgroup)) + "/" (int-to-string (mail-header-number headers))) + gnus-article-save-directory))) + (if (and last-file + (string-equal (file-name-directory default) + (file-name-directory last-file)) + (string-match "^[0-9]+$" (file-name-nondirectory last-file))) + default + (or last-file default)))) + + (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) + newsgroup + (gnus-newsgroup-directory-form newsgroup)) + "/" (int-to-string (mail-header-number headers))) + gnus-article-save-directory))) + (if (and last-file + (string-equal (file-name-directory default) + (file-name-directory last-file)) + (string-match "^[0-9]+$" (file-name-nondirectory last-file))) + default + (or last-file default)))) + + (defun gnus-Plain-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. Otherwise, it is like ~/News/news/group/news." + (or last-file + (expand-file-name + (if (gnus-use-long-file-name 'not-save) + (gnus-capitalize-newsgroup newsgroup) + (concat (gnus-newsgroup-directory-form newsgroup) "/news")) + gnus-article-save-directory))) + + (defun gnus-plain-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. Otherwise, it is like ~/News/news/group/news." + (or last-file + (expand-file-name + (if (gnus-use-long-file-name 'not-save) + newsgroup + (concat (gnus-newsgroup-directory-form newsgroup) "/news")) + gnus-article-save-directory))) + + + ;;; + ;;; Gnus article mode + ;;; + + (defvar gnus-article-mode-map nil) + (put 'gnus-article-mode 'mode-class 'special) + + (if gnus-article-mode-map + 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 + [delete] 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 + "<" beginning-of-buffer + ">" end-of-buffer + "\C-c\C-i" gnus-info-find-node + "\C-c\C-b" gnus-bug) + + (substitute-key-definition + 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) + + (defun gnus-article-mode () + "Major mode for displaying an article. + + All normal editing commands are switched off. + + The following commands are available: + + \\ + \\[gnus-article-next-page]\t Scroll the article one page forwards + \\[gnus-article-prev-page]\t Scroll the article one page backwards + \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point + \\[gnus-article-show-summary]\t Display the summary buffer + \\[gnus-article-mail]\t Send a reply to the address near point + \\[gnus-article-describe-briefly]\t Describe the current mode briefly + \\[gnus-info-find-node]\t Go to the Gnus info node" + (interactive) + (when (and menu-bar-mode + (gnus-visual-p 'article-menu 'menu)) + (gnus-article-make-menu-bar)) + (kill-all-local-variables) + (gnus-simplify-mode-line) + (setq mode-name "Article") + (setq major-mode 'gnus-article-mode) + (make-local-variable 'minor-mode-alist) + (or (assq 'gnus-show-mime minor-mode-alist) + (setq minor-mode-alist + (cons (list 'gnus-show-mime " MIME") minor-mode-alist))) + (use-local-map gnus-article-mode-map) + (gnus-update-format-specifications nil 'article-mode) + (make-local-variable 'page-delimiter) + (setq page-delimiter gnus-page-delimiter) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) ;Disable modification + (run-hooks 'gnus-article-mode-hook)) + + (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) + (gnus-set-global-variables)) + (make-local-variable 'gnus-summary-buffer)) + ;; Init original article buffer. + (save-excursion + (set-buffer (get-buffer-create gnus-original-article-buffer)) + (buffer-disable-undo (current-buffer)) + (setq major-mode 'gnus-original-article-mode) + (gnus-add-current-to-buffer-list) + (make-local-variable 'gnus-original-article)) + (if (get-buffer name) + (save-excursion + (set-buffer name) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) + (gnus-add-current-to-buffer-list) + (or (eq major-mode 'gnus-article-mode) + (gnus-article-mode)) + (current-buffer)) + (save-excursion + (set-buffer (get-buffer-create name)) + (gnus-add-current-to-buffer-list) + (gnus-article-mode) + (current-buffer))))) + + ;; 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 t) + (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (if (not line) + (point-min) + (gnus-message 6 "Moved to bookmark") + (search-forward "\n\n" nil t) + (forward-line line) + (point))))) + + (defun gnus-article-prepare (article &optional all-headers header) + "Prepare ARTICLE in article mode buffer. + ARTICLE should either be an article number or a Message-ID. + If ARTICLE is an id, HEADER should be the article headers. + If ALL-HEADERS is non-nil, no headers are hidden." + (save-excursion + ;; Make sure we start in a summary buffer. + (unless (eq major-mode 'gnus-summary-mode) + (set-buffer gnus-summary-buffer)) + (setq gnus-summary-buffer (current-buffer)) + ;; Make sure the connection to the server is alive. + (unless (gnus-server-opened + (gnus-find-method-for-group gnus-newsgroup-name)) + (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) + (gnus-request-group gnus-newsgroup-name t)) + (let* ((article (if header (mail-header-number header) article)) + (summary-buffer (current-buffer)) + (internal-hook gnus-article-internal-prepare-hook) + (group gnus-newsgroup-name) + result) + (save-excursion + (gnus-article-setup-buffer) + (set-buffer gnus-article-buffer) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + 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-error + 1 "No such article (may have expired or been canceled)"))) + (if (or (eq result 'pseudo) (eq result 'nneething)) + (progn + (save-excursion + (set-buffer summary-buffer) + (setq gnus-last-article gnus-current-article + gnus-newsgroup-history (cons gnus-current-article + gnus-newsgroup-history) + gnus-current-article 0 + gnus-current-headers nil + gnus-article-current nil) + (if (eq result 'nneething) + (gnus-configure-windows 'summary) + (gnus-configure-windows 'article)) + (gnus-set-global-variables)) + (gnus-set-mode-line 'article)) + ;; The result from the `request' was an actual article - + ;; or at least some text that is now displayed in the + ;; article buffer. + (if (and (numberp article) + (not (eq article gnus-current-article))) + ;; Seems like a new article has been selected. + ;; `gnus-current-article' must be an article number. + (save-excursion + (set-buffer summary-buffer) + (setq gnus-last-article gnus-current-article + 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)) + (gnus-summary-show-thread) + (run-hooks 'gnus-mark-article-hook) + (gnus-set-mode-line 'summary) + (and (gnus-visual-p 'article-highlight 'highlight) + (run-hooks 'gnus-visual-mark-article-hook)) + ;; Set the global newsgroup variables here. + ;; 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 + (gnus-summary-article-header article) + (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-dormant) + (memq article gnus-newsgroup-unreads))))) + (when (or (numberp article) + (stringp article)) + ;; Hooks for getting information from the article. + ;; This hook must be called before being narrowed. + (let (buffer-read-only) + (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. + (goto-char (point-min)) + (and gnus-break-pages (gnus-narrow-to-page))) + (gnus-set-mode-line 'article) + (gnus-configure-windows 'article) + (goto-char (point-min)) + t)))))) + + (defun gnus-article-wash-status () + "Return a string which display status of article washing." + (save-excursion + (set-buffer gnus-article-buffer) + (let ((cite (article-hidden-text-p 'cite)) + (headers (article-hidden-text-p 'headers)) + (boring (article-hidden-text-p 'boring-headers)) + (pgp (article-hidden-text-p 'pgp)) + (pem (article-hidden-text-p 'pem)) + (signature (article-hidden-text-p 'signature)) + (overstrike (article-hidden-text-p 'overstrike)) + (emphasis (article-hidden-text-p 'emphasis)) + (mime gnus-show-mime)) + (format "%c%c%c%c%c%c%c" + (if cite ?c ? ) + (if (or headers boring) ?h ? ) + (if (or pgp pem) ?p ? ) + (if signature ?s ? ) + (if overstrike ?o ? ) + (if mime ?m ? ) + (if emphasis ?e ? ))))) + + (defun gnus-article-hide-headers-if-wanted () + "Hide unwanted headers if `gnus-have-all-headers' is nil. + Provided for backwards compatibility." + (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) + article-inhibit-hiding + (gnus-article-hide-headers))) + + ;;; Article savers. + + (defun gnus-output-to-rmail (file-name) + "Append the current article to an Rmail file named FILE-NAME." + (require 'rmail) + ;; Most of these codes are borrowed from rmailout.el. + (setq file-name (expand-file-name file-name)) + (setq rmail-default-rmail-file file-name) + (let ((artbuf (current-buffer)) + (tmpbuf (get-buffer-create " *Gnus-output*"))) + (save-excursion + (or (get-file-buffer file-name) + (file-exists-p file-name) + (if (gnus-yes-or-no-p + (concat "\"" file-name "\" does not exist, create it? ")) + (let ((file-buffer (create-file-buffer file-name))) + (save-excursion + (set-buffer file-buffer) + (rmail-insert-rmail-file-header) + (let ((require-final-newline nil)) + (write-region (point-min) (point-max) file-name t 1))) + (kill-buffer file-buffer)) + (error "Output file does not exist"))) + (set-buffer tmpbuf) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring artbuf) + (gnus-convert-article-to-rmail) + ;; Decide whether to append to a file or to an Emacs buffer. + (let ((outbuf (get-file-buffer file-name))) + (if (not outbuf) + (append-to-file (point-min) (point-max) file-name) + ;; File has been visited, in buffer OUTBUF. + (set-buffer outbuf) + (let ((buffer-read-only nil) + (msg (and (boundp 'rmail-current-message) + (symbol-value 'rmail-current-message)))) + ;; If MSG is non-nil, buffer is in RMAIL mode. + (if msg + (progn (widen) + (narrow-to-region (point-max) (point-max)))) + (insert-buffer-substring tmpbuf) + (if msg + (progn + (goto-char (point-min)) + (widen) + (search-backward "\^_") + (narrow-to-region (point) (point-max)) + (goto-char (1+ (point-min))) + (rmail-count-new-messages t) + (rmail-show-message msg))))))) + (kill-buffer tmpbuf))) + + (defun gnus-output-to-file (file-name) + "Append the current article to a file named FILE-NAME." + (let ((artbuf (current-buffer))) + (nnheader-temp-write nil + (insert-buffer-substring artbuf) + ;; Append newline at end of the buffer as separator, and then + ;; save it to file. + (goto-char (point-max)) + (insert "\n") + (append-to-file (point-min) (point-max) file-name)))) + + (defun gnus-convert-article-to-rmail () + "Convert article in current buffer to Rmail message format." + (let ((buffer-read-only nil)) + ;; Convert article directly into Babyl format. + ;; Suggested by Rob Austein + (goto-char (point-min)) + (insert "\^L\n0, unseen,,\n*** EOOH ***\n") + (while (search-forward "\n\^_" nil t) ;single char + (replace-match "\n^_" t t)) ;2 chars: "^" and "_" + (goto-char (point-max)) + (insert "\^_"))) + + (defun gnus-narrow-to-page (&optional arg) + "Narrow the article buffer to a page. + If given a numerical ARG, move forward ARG pages." + (interactive "P") + (setq arg (if arg (prefix-numeric-value arg) 0)) + (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (widen) + (when (gnus-visual-p 'page-marker) + (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) + (re-search-forward page-delimiter nil 'move arg))) + (goto-char (match-end 0))) + (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))) + (save-excursion + (goto-char (point-min)) + (gnus-insert-prev-page-button))) + (when (and (gnus-visual-p 'page-marker) + (not (= (1- (point-max)) (buffer-size)))) + (save-excursion + (goto-char (point-max)) + (gnus-insert-next-page-button))))) + + ;; 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 (gnus-character-to-event ?n)))) + + (defun gnus-article-goto-prev-page () + "Show the next page of the article." + (interactive) + (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?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 + (end-of-line) + (and (pos-visible-in-window-p) ;Not continuation line. + (eobp))) + ;; Nothing in this page. + (if (or (not gnus-break-pages) + (save-excursion + (save-restriction + (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? + t ;Nothing more. + (gnus-narrow-to-page 1) ;Go to next page. + nil) + ;; More in this page. + (condition-case () + (scroll-up lines) + (end-of-buffer + ;; Long lines may cause an end-of-buffer error. + (goto-char (point-max)))) + (move-to-window-line 0) + nil)) + + (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) + (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? + (progn + (gnus-narrow-to-page -1) ;Go to previous page. + (goto-char (point-max)) + (recenter -1)) + (prog1 + (condition-case () + (scroll-down lines) + (error nil)) + (move-to-window-line 0)))) + + (defun gnus-article-refer-article () + "Read article specified by message-id around point." + (interactive) + (let ((point (point))) + (search-forward ">" nil t) ;Move point to end of "<....>". + (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) + (let ((message-id (match-string 1))) + (goto-char point) + (set-buffer gnus-summary-buffer) + (gnus-summary-refer-article message-id)) + (goto-char (point)) + (error "No references around point")))) + + (defun gnus-article-show-summary () + "Reconfigure windows to show summary buffer." + (interactive) + (gnus-configure-windows 'article) + (gnus-summary-goto-subject gnus-current-article)) + + (defun gnus-article-describe-briefly () + "Describe article mode commands briefly." + (interactive) + (gnus-message 6 + (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-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." + (interactive) + (let ((obuf (current-buffer)) + (owin (current-window-configuration)) + func) + (switch-to-buffer gnus-summary-buffer 'norecord) + (setq func (lookup-key (current-local-map) (this-command-keys))) + (call-interactively func) + (set-buffer obuf) + (set-window-configuration owin) + (set-window-point (get-buffer-window (current-buffer)) (point)))) + + (defun gnus-article-summary-command-nosave () + "Execute the last keystroke in the summary buffer." + (interactive) + (let (func) + (pop-to-buffer gnus-summary-buffer 'norecord) + (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-^" "|")) + (nosave-but-article + '("A\r")) + 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 (or (member keys nosaves) + (member keys nosave-but-article)) + (let (func) + (save-window-excursion + (pop-to-buffer gnus-summary-buffer 'norecord) + (setq func (lookup-key (current-local-map) keys))) + (if (not func) + (ding) + (set-buffer gnus-summary-buffer) + (call-interactively func)) + (when (member keys nosave-but-article) + (pop-to-buffer gnus-article-buffer 'norecord))) + (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)))))) + + (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-maybe-highlight () + "Do some article highlighting if `article-visual' is non-nil." + (if (gnus-visual-p 'article-highlight 'highlight) + (gnus-article-highlight-some))) + + (defun gnus-request-article-this-buffer (article group) + "Get an article and insert it into this buffer." + (let (do-update-line) + (prog1 + (save-excursion + (erase-buffer) + (gnus-kill-all-overlays) + (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. + (when (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. + (when (and (numberp article) + gnus-summary-buffer + (get-buffer gnus-summary-buffer) + (buffer-name (get-buffer gnus-summary-buffer))) + (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 do-update-line article) + (setq article (mail-header-id header)) + (let ((gnus-override-method gnus-refer-article-method)) + (gnus-read-header article)) + (setq gnus-newsgroup-sparse + (delq article gnus-newsgroup-sparse))) + ((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 + ;; Refuse to select canceled articles. + ((and (numberp article) + gnus-summary-buffer + (get-buffer gnus-summary-buffer) + (buffer-name (get-buffer gnus-summary-buffer)) + (eq (cdr (save-excursion + (set-buffer gnus-summary-buffer) + (assq article gnus-newsgroup-reads))) + gnus-canceled-mark)) + nil) + ;; We first check `gnus-original-article-buffer'. + ((and (get-buffer gnus-original-article-buffer) + (numberp article) + (save-excursion + (set-buffer gnus-original-article-buffer) + (and (equal (car gnus-original-article) group) + (eq (cdr gnus-original-article) article)))) + (insert-buffer-substring gnus-original-article-buffer) + 'article) + ;; Check the backlog. + ((and gnus-keep-backlog + (gnus-backlog-request-article group article (current-buffer))) + 'article) + ;; Check asynchronous pre-fetch. + ((gnus-async-request-fetched-article group article (current-buffer)) + (gnus-async-prefetch-next group article gnus-summary-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) + (when (gnus-request-article article group (current-buffer)) + (when (numberp article) + (gnus-async-prefetch-next group article gnus-summary-buffer) + (when gnus-keep-backlog + (gnus-backlog-enter-article + group article (current-buffer)))) + 'article))) + ;; It was a pseudo. + (t article))) + + ;; Take the article from the original article buffer + ;; and place it in the buffer it's supposed to be in. + (when (and (get-buffer gnus-article-buffer) + ;;(numberp article) + (equal (buffer-name (current-buffer)) + (buffer-name (get-buffer gnus-article-buffer)))) + (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)) + (let (buffer-read-only) + (erase-buffer) + (insert-buffer-substring gnus-article-buffer)) + (setq gnus-original-article (cons group article)))) + + ;; Update sparse articles. + (when (and do-update-line + (or (numberp article) + (stringp article))) + (let ((buf (current-buffer))) + (set-buffer gnus-summary-buffer) + (gnus-summary-update-article do-update-line) + (gnus-summary-goto-subject do-update-line nil t) + (set-window-point (get-buffer-window (current-buffer) t) + (point)) + (set-buffer buf)))))) + + (defun gnus-article-date-ut (&optional type highlight) + "Convert DATE date to universal time in the current article. + 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 ((headers (or gnus-current-headers (gnus-summary-article-header)))) + (save-excursion + (set-buffer gnus-article-buffer) + (article-date-ut type highlight headers)))) + + (provide 'gnus-art) + + ;;; gnus-art.el ends here *** pub/rgnus/lisp/gnus-async.el Tue Jul 30 22:59:14 1996 --- rgnus/lisp/gnus-async.el Tue Jul 30 22:11:05 1996 *************** *** 0 **** --- 1,163 ---- + ;;; gnus-async.el --- asynchronous support for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-sum) + (require 'nntp) + + (defvar gnus-use-article-prefetch 5 + "*If non-nil, prefetch articles in groups that allow this. + If a number, prefetch only that many articles forward; + if t, prefetch as many articles as possible.") + + (defvar gnus-prefetched-article-deletion-strategy '(read exit) + "List of symbols that say when to remove articles from the prefetch buffer. + Possible values in this list are `read', which means that + articles are removed as they are read, and `exit', which means + that all articles belonging to a group are removed on exit + from that group.") + + ;;; Internal variables. + + (defvar gnus-async-article-alist nil) + + (defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") + + ;;; Utility functions. + + (defun gnus-group-asynchronous-p (group) + "Say whether GROUP is fetched from a server that supports asynchronocity." + (gnus-asynchronous-p (gnus-find-method-for-group group))) + + ;;; Article prefetch + + (gnus-add-shutdown 'gnus-async-close 'gnus) + (defun gnus-async-close () + (gnus-kill-buffer gnus-async-prefetch-article-buffer) + (setq gnus-async-article-alist nil)) + + (defun gnus-async-set-prefetch-buffer () + (if (get-buffer gnus-async-prefetch-article-buffer) + (set-buffer gnus-async-prefetch-article-buffer) + (set-buffer (get-buffer-create gnus-async-prefetch-article-buffer)) + (buffer-disable-undo (current-buffer)) + (gnus-add-current-to-buffer-list))) + + (defun gnus-async-prefetch-next (group article summary) + "Possibly prefetch several articles starting with the article after ARTICLE." + (let ((next (caadr (gnus-data-find-list article)))) + (when next + (gnus-async-prefetch-article group next summary)))) + + (defun gnus-async-prefetch-article (group article summary &optional number) + "Possibly prefetch several articles starting with ARTICLE." + (unless number + (setq number gnus-use-article-prefetch)) + (when (and number + (or (not (numberp number)) + (> number 0)) + (gnus-group-asynchronous-p group) + (gnus-buffer-live-p summary)) + (when (numberp number) + (decf number)) + (while (and article (gnus-async-prefetched-article-entry group article)) + (setq article (caadr (gnus-data-find-list article))) + (when (numberp number) + (decf number))) + (when article + ;; We want to fetch some more articles. + (save-excursion + (set-buffer summary) + (let ((next (caadr (gnus-data-find-list article))) + mark) + (gnus-async-set-prefetch-buffer) + (goto-char (point-max)) + (setq mark (point-marker)) + (let ((nnheader-callback-function + `(lambda (arg) + (save-excursion + (gnus-async-set-prefetch-buffer) + (push (list ',(intern (format "%s-%d" group article)) + ,mark (set-marker (make-marker) (point-max)) + ,group ,article) + gnus-async-article-alist) + (when (gnus-buffer-live-p ,summary) + ,(when next + `(gnus-async-prefetch-article + ,group ,next ,summary ,number)))))) + (nntp-server-buffer (get-buffer + gnus-async-prefetch-article-buffer))) + (gnus-message 7 "Prefetching article %d in group %s" + article group) + (gnus-request-article article group))))))) + + (defun gnus-async-request-fetched-article (group article buffer) + "See whether we have ARTICLE from GROUP and put it in BUFFER." + (let ((entry (gnus-async-prefetched-article-entry group article))) + (when entry + (save-excursion + (gnus-async-set-prefetch-buffer) + (copy-to-buffer buffer (cadr entry) (caddr entry)) + ;; Remove the read article from the prefetch buffer. + (when (memq 'read gnus-prefetched-article-deletion-strategy) + (gnus-asynch-delete-prefected-entry entry)) + ;; Decode the article. Perhaps this shouldn't be done + ;; here? + (set-buffer buffer) + (nntp-decode-text) + (goto-char (point-min)) + (gnus-delete-line) + t)))) + + (defun gnus-asynch-delete-prefected-entry (entry) + "Delete ENTRY from buffer and alist." + (delete-region (cadr entry) (caddr entry)) + (set-marker (cadr entry) nil) + (set-marker (caddr entry) nil) + (setq gnus-async-article-alist + (delq entry gnus-async-article-alist))) + + (defun gnus-async-prefetch-remove-group (group) + "Remove all articles belonging to GROUP from the prefetch buffer." + (when (and (gnus-group-asynchronous-p group) + (memq 'exit gnus-prefetched-article-deletion-strategy)) + (let ((alist gnus-async-article-alist)) + (save-excursion + (gnus-async-set-prefetch-buffer) + (while alist + (when (equal group (nth 3 (car alist))) + (gnus-asynch-delete-prefected-entry (car alist))) + (pop alist)))))) + + (defun gnus-async-prefetched-article-entry (group article) + "Return the entry for ARTICLE in GROUP iff it has been prefetched." + (assq (intern (format "%s-%d" group article)) + gnus-async-article-alist)) + + (provide 'gnus-async) + + ;;; gnus-async.el ends here *** pub/rgnus/lisp/gnus-bcklg.el Tue Jul 30 22:59:14 1996 --- rgnus/lisp/gnus-bcklg.el Sun Jul 28 13:43:27 1996 *************** *** 0 **** --- 1,151 ---- + ;;; gnus-bcklg.el --- backlog functions for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + + ;;; + ;;; Buffering of read articles. + ;;; + + (defvar gnus-backlog-buffer " *Gnus Backlog*") + (defvar gnus-backlog-articles nil) + (defvar gnus-backlog-hashtb nil) + + (defun gnus-backlog-buffer () + "Return the backlog buffer." + (or (get-buffer gnus-backlog-buffer) + (save-excursion + (set-buffer (get-buffer-create gnus-backlog-buffer)) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) + (gnus-add-current-to-buffer-list) + (get-buffer gnus-backlog-buffer)))) + + (defun gnus-backlog-setup () + "Initialize backlog variables." + (unless gnus-backlog-hashtb + (setq gnus-backlog-hashtb (make-vector 1023 0)))) + + (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) + + (defun gnus-backlog-shutdown () + "Clear all backlog variables and buffers." + (when (get-buffer gnus-backlog-buffer) + (kill-buffer gnus-backlog-buffer)) + (setq gnus-backlog-hashtb nil + gnus-backlog-articles nil)) + + (defun gnus-backlog-enter-article (group number buffer) + (gnus-backlog-setup) + (let ((ident (intern (concat group ":" (int-to-string number)) + gnus-backlog-hashtb)) + b) + (if (memq ident gnus-backlog-articles) + () ; It's already kept. + ;; Remove the oldest article, if necessary. + (and (numberp gnus-keep-backlog) + (>= (length gnus-backlog-articles) gnus-keep-backlog) + (gnus-backlog-remove-oldest-article)) + (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) + ;; Insert the new article. + (save-excursion + (set-buffer (gnus-backlog-buffer)) + (let (buffer-read-only) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (setq b (point)) + (insert-buffer-substring buffer) + ;; Tag the beginning of the article with the ident. + (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) + + (defun gnus-backlog-remove-oldest-article () + (save-excursion + (set-buffer (gnus-backlog-buffer)) + (goto-char (point-min)) + (if (zerop (buffer-size)) + () ; The buffer is empty. + (let ((ident (get-text-property (point) 'gnus-backlog)) + buffer-read-only) + ;; Remove the ident from the list of articles. + (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))))))) + + (defun gnus-backlog-remove-article (group number) + "Remove article NUMBER in GROUP from the backlog." + (when (numberp number) + (gnus-backlog-setup) + (let ((ident (intern (concat group ":" (int-to-string number)) + gnus-backlog-hashtb)) + beg end) + (when (memq ident gnus-backlog-articles) + ;; It was in the backlog. + (save-excursion + (set-buffer (gnus-backlog-buffer)) + (let (buffer-read-only) + (when (setq beg (text-property-any + (point-min) (point-max) 'gnus-backlog + ident)) + ;; 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))) + (delete-region beg end) + ;; Return success. + t))))))) + + (defun gnus-backlog-request-article (group number buffer) + (when (numberp number) + (gnus-backlog-setup) + (let ((ident (intern (concat group ":" (int-to-string number)) + gnus-backlog-hashtb)) + beg end) + (when (memq ident gnus-backlog-articles) + ;; 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. + (ignore + (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) + ;; 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) + (insert-buffer-substring gnus-backlog-buffer beg end) + t))))) + + (provide 'gnus-bcklg) + + ;;; gnus-bcklg.el ends here *** pub/rgnus/lisp/gnus-cache.el Tue Jul 30 19:53:59 1996 --- rgnus/lisp/gnus-cache.el Sun Jul 28 23:11:50 1996 *************** *** 25,32 **** ;;; Code: (require 'gnus) - (eval-when-compile (require 'cl)) (defvar gnus-cache-directory (nnheader-concat gnus-directory "cache/") --- 25,34 ---- ;;; Code: + (require 'gnus-load) + (require 'gnus-int) + (require 'gnus-range) (require 'gnus) (defvar gnus-cache-directory (nnheader-concat gnus-directory "cache/") *************** *** 52,57 **** --- 54,60 ---- ;;; Internal variables. + (defvar gnus-cache-removable-articles nil) (defvar gnus-cache-buffer nil) (defvar gnus-cache-active-hashtb nil) (defvar gnus-cache-active-altered nil) *************** *** 97,103 **** (if (> (buffer-size) 0) ;; non-empty overview, write it out (progn ! (gnus-make-directory (file-name-directory overview-file)) (write-region (point-min) (point-max) overview-file nil 'quietly)) ;; empty overview file, remove it --- 100,106 ---- (if (> (buffer-size) 0) ;; non-empty overview, write it out (progn ! (make-directory (file-name-directory overview-file) t) (write-region (point-min) (point-max) overview-file nil 'quietly)) ;; empty overview file, remove it *************** *** 139,145 **** group number))))) ;; Possibly create the cache directory. (or (file-exists-p (setq dir (file-name-directory file))) ! (gnus-make-directory dir)) ;; Save the article in the cache. (if (file-exists-p file) t ; The article already is saved. --- 142,148 ---- group number))))) ;; Possibly create the cache directory. (or (file-exists-p (setq dir (file-name-directory file))) ! (make-directory dir t)) ;; Save the article in the cache. (if (file-exists-p file) t ; The article already is saved. *************** *** 548,554 **** (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. --- 551,557 ---- (symbol-name sym) (cdr (symbol-value sym)) (car (symbol-value sym)))))) gnus-cache-active-hashtb) ! (make-directory (file-name-directory gnus-cache-active-file) t) (write-region (point-min) (point-max) gnus-cache-active-file nil 'silent)) ;; Mark the active hashtb as unaltered. *** pub/rgnus/lisp/gnus-cite.el Sat Jun 22 14:00:36 1996 --- rgnus/lisp/gnus-cite.el Sun Jul 28 21:01:26 1996 *************** *** 25,34 **** ;;; Code: (require 'gnus) ! (require 'gnus-msg) ! (require 'gnus-ems) ! (eval-when-compile (require 'cl)) (eval-and-compile (autoload 'gnus-article-add-button "gnus-vis")) --- 25,34 ---- ;;; Code: + (require 'gnus-load) (require 'gnus) ! (require 'gnus-art) ! (require 'gnus-range) (eval-and-compile (autoload 'gnus-article-add-button "gnus-vis")) *************** *** 245,251 **** (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)) --- 245,251 ---- (search-forward "\n\n" nil t) (push (cons (point-marker) "") marks) (goto-char (point-max)) ! (re-search-backward article-signature-separator nil t) (push (cons (point-marker) "") marks) (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) (let* ((omarks marks)) *************** *** 273,279 **** (setq m (cdr m)))) marks)))) - (defun gnus-article-fill-cited-article (&optional force) "Do word wrapping in the current article." (interactive (list t)) --- 273,278 ---- *************** *** 301,318 **** See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, always hide." ! (interactive (append (gnus-hidden-arg) (list 'force))) (setq gnus-cited-text-button-line-format-spec (gnus-parse-format gnus-cited-text-button-line-format gnus-cited-text-button-line-format-alist t)) ! (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (marks (gnus-dissect-cited-text)) (inhibit-point-motion-hooks t) (props (nconc (list 'gnus-type 'cite) ! gnus-hidden-properties)) beg end) (while marks (setq beg nil --- 300,317 ---- See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, always hide." ! (interactive (append (article-hidden-arg) (list 'force))) (setq gnus-cited-text-button-line-format-spec (gnus-parse-format gnus-cited-text-button-line-format gnus-cited-text-button-line-format-alist t)) ! (unless (article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (marks (gnus-dissect-cited-text)) (inhibit-point-motion-hooks t) (props (nconc (list 'gnus-type 'cite) ! article-hidden-properties)) beg end) (while marks (setq beg nil *************** *** 349,357 **** (funcall (if (text-property-any (car region) (1- (cdr region)) ! (car gnus-hidden-properties) (cadr gnus-hidden-properties)) 'remove-text-properties 'gnus-add-text-properties) ! (car region) (cdr region) gnus-hidden-properties))) (defun gnus-article-hide-citation-maybe (&optional arg force) "Toggle hiding of cited text that has an attribution line. --- 348,356 ---- (funcall (if (text-property-any (car region) (1- (cdr region)) ! (car article-hidden-properties) (cadr article-hidden-properties)) 'remove-text-properties 'gnus-add-text-properties) ! (car region) (cdr region) article-hidden-properties))) (defun gnus-article-hide-citation-maybe (&optional arg force) "Toggle hiding of cited text that has an attribution line. *************** *** 362,369 **** cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." ! (interactive (append (gnus-hidden-arg) (list 'force))) ! (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) --- 361,368 ---- cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." ! (interactive (append (article-hidden-arg) (list 'force))) ! (unless (article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) *************** *** 376,382 **** (hiden 0) total) (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) (setq total (count-lines start (point))) (while atts (setq hiden (+ hiden (length (cdr (assoc (cdar atts) --- 375,381 ---- (hiden 0) total) (goto-char (point-max)) ! (re-search-backward article-signature-separator nil t) (setq total (count-lines start (point))) (while atts (setq hiden (+ hiden (length (cdr (assoc (cdar atts) *************** *** 398,404 **** (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'gnus-type 'cite) ! gnus-hidden-properties))))))))))) (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." --- 397,403 ---- (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'gnus-type 'cite) ! article-hidden-properties))))))))))) (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." *************** *** 442,448 **** (case-fold-search t) (max (save-excursion (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) (point))) alist entry start begin end numbers prefix) ;; Get all potential prefixes in `alist'. --- 441,447 ---- (case-fold-search t) (max (save-excursion (goto-char (point-max)) ! (re-search-backward article-signature-separator nil t) (point))) alist entry start begin end numbers prefix) ;; Get all potential prefixes in `alist'. *************** *** 700,712 **** (goto-line number) (cond ((get-text-property (point) 'invisible) (remove-text-properties (point) (progn (forward-line 1) (point)) ! gnus-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'gnus-type 'cite) ! gnus-hidden-properties)))))))) (defun gnus-cite-find-prefix (line) ;; Return citation prefix for LINE. --- 699,711 ---- (goto-line number) (cond ((get-text-property (point) 'invisible) (remove-text-properties (point) (progn (forward-line 1) (point)) ! article-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'gnus-type 'cite) ! article-hidden-properties)))))))) (defun gnus-cite-find-prefix (line) ;; Return citation prefix for LINE. *** pub/rgnus/lisp/gnus-cus.el Sun Jul 14 15:30:00 1996 --- rgnus/lisp/gnus-cus.el Sun Jul 28 13:49:19 1996 *************** *** 26,35 **** ;;; Code: (require 'custom) (require 'gnus-ems) (require 'browse-url) - (eval-when-compile (require 'cl)) ;; The following is just helper functions and data, not meant to be set ;; by the user. --- 26,35 ---- ;;; Code: + (require 'gnus-load) (require 'custom) (require 'gnus-ems) (require 'browse-url) ;; The following is just helper functions and data, not meant to be set ;; by the user. *** pub/rgnus/lisp/gnus-demon.el Fri Jun 14 01:04:45 1996 --- rgnus/lisp/gnus-demon.el Sun Jul 28 15:11:10 1996 *************** *** 25,33 **** ;;; Code: (require 'gnus) - - (eval-when-compile (require 'cl)) (defvar gnus-demon-handlers nil "Alist of daemonic handlers to be run at intervals. --- 25,33 ---- ;;; Code: + (require 'gnus-load) + (require 'gnus-int) (require 'gnus) (defvar gnus-demon-handlers nil "Alist of daemonic handlers to be run at intervals. *** pub/rgnus/lisp/gnus-edit.el Sun Jul 14 15:30:01 1996 --- rgnus/lisp/gnus-edit.el Sun Jul 28 14:34:59 1996 *************** *** 13,19 **** (require 'custom) (require 'gnus-score) ! (eval-when-compile (require 'cl)) (defconst gnus-score-custom-data '((tag . "Score") --- 13,20 ---- (require 'custom) (require 'gnus-score) ! (require 'gnus-load) ! (require 'gnus-sum) (defconst gnus-score-custom-data '((tag . "Score") *************** *** 620,626 **** (buffer-disable-undo (current-buffer)) (erase-buffer) (pp score (current-buffer)) ! (gnus-make-directory (file-name-directory file)) (write-region (point-min) (point-max) file nil 'silent) (kill-buffer (current-buffer)))) (gnus-message 4 "Saved")) --- 621,627 ---- (buffer-disable-undo (current-buffer)) (erase-buffer) (pp score (current-buffer)) ! (make-directory (file-name-directory file) t) (write-region (point-min) (point-max) file nil 'silent) (kill-buffer (current-buffer)))) (gnus-message 4 "Saved")) *** pub/rgnus/lisp/gnus-ems.el Tue Jun 25 23:11:23 1996 --- rgnus/lisp/gnus-ems.el Sun Jul 28 14:35:06 1996 *************** *** 29,53 **** (defvar gnus-mouse-2 [mouse-2]) - (defalias 'gnus-make-overlay 'make-overlay) - (defalias 'gnus-overlay-put 'overlay-put) - (defalias 'gnus-move-overlay 'move-overlay) - (defalias 'gnus-overlay-end 'overlay-end) - (defalias 'gnus-extent-detached-p 'ignore) - (defalias 'gnus-extent-start-open 'ignore) - (defalias 'gnus-set-text-properties 'set-text-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore) - (defalias 'gnus-topic-remove-excess-properties 'ignore) - (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) - (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) - (defalias 'gnus-make-local-hook 'make-local-hook) - (defalias 'gnus-add-hook 'add-hook) - (defalias 'gnus-character-to-event 'identity) - (defalias 'gnus-add-text-properties 'add-text-properties) - (defalias 'gnus-put-text-property 'put-text-property) - (defalias 'gnus-mode-line-buffer-identification 'identity) - - (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") --- 29,34 ---- *** pub/rgnus/lisp/gnus-gl.el Sun Jul 14 15:29:58 1996 --- rgnus/lisp/gnus-gl.el Sun Jul 28 13:49:15 1996 *************** *** 121,126 **** --- 121,127 ---- (require 'gnus-score) (require 'cl) + (require 'gnus-load) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; User variables *** pub/rgnus/lisp/gnus-group.el Tue Jul 30 22:59:16 1996 --- rgnus/lisp/gnus-group.el Tue Jul 30 12:47:35 1996 *************** *** 0 **** --- 1,2613 ---- + ;;; gnus-group.el --- group mode commands for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-start) + (require 'nnmail) + (require 'gnus-spec) + (require 'gnus-int) + (require 'gnus-range) + (require 'gnus-win) + + (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 + "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" + "*The address of the most recent (ding) articles.") + + ;; Suggested by Andrew Eskilsson . + (defvar gnus-no-groups-message "No news is horrible news" + "*Message displayed by Gnus when no groups are available.") + + (defvar gnus-keep-same-level nil + "*Non-nil means that the next newsgroup after the current will be on the same level. + 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 + than the current level. + If this variable is `best', Gnus will make the next newsgroup the one + with the best level.") + + (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-permanently-visible-groups nil + "*Regexp to match groups that should always be listed in the group buffer. + This means that they will still be listed when there are no unread + articles in the groups.") + + (defvar gnus-list-groups-with-ticked-articles t + "*If non-nil, list groups that have only ticked articles. + If nil, only list groups that have unread articles.") + + (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 + "*If non-nil, once you set a level, Gnus will use this level.") + + (defvar gnus-group-list-inactive-groups t + "*If non-nil, inactive groups will be listed.") + + (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet + "*Function used for sorting the group buffer. + This function will be called with group info entries as the arguments + 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', + `gnus-group-sort-by-method', 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.") + + (defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" + "*Format of group lines. + It works along the same lines as a normal formatting string, + with some simple extensions. + + %M Only marked articles (character, \"*\" or \" \") + %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") + %L Level of subscribedness (integer) + %N Number of unread articles (integer) + %I Number of dormant articles (integer) + %i Number of ticked and dormant (integer) + %T Number of ticked articles (integer) + %R Number of read articles (integer) + %t Total number of articles (integer) + %y Number of unread, unticked articles (integer) + %G Group name (string) + %g Qualified group name (string) + %D Group description (string) + %s Select method (string) + %o Moderated group (char, \"m\") + %p Process mark (char) + %O Moderated group (string, \"(m)\" or \"\") + %P Topic indentation (string) + %l Whether there are GroupLens predictions for this group (string) + %n Select from where (string) + %z A string that look like `<%s:%n>' if a foreign select method is used + %u User defined specifier. The next character in the format string should + be a letter. Gnus will call the function gnus-user-format-function-X, + where X is the letter following %u. The function will be passed the + current header as argument. The function should return a string, which + will be inserted into the buffer just like information from any other + group specifier. + + Text between %( and %) will be highlighted with `gnus-mouse-face' when + the mouse point move inside the area. There can only be one such area. + + 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. + + If you use %o or %O, reading the active file will be slower and quite + 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-group-mode-line-format "Gnus: %%b {%M\%:%S}" + "*The format specification for the group mode line. + It works along the same lines as a normal formatting string, + with some simple extensions: + + %S The native news server. + %M The native select method. + %: \":\" if %S isn't \"\".") + + (defvar gnus-group-mode-hook nil + "*A hook for Gnus group mode.") + + (defvar gnus-group-catchup-group-hook nil + "*A hook run when catching up a group from the group buffer.") + + (defvar gnus-group-update-group-hook nil + "*A hook called when updating group lines.") + + (defvar gnus-group-prepare-function 'gnus-group-prepare-flat + "*A function that is called to generate the group buffer. + The function is called with three arguments: The first is a number; + all group with a level less or equal to that number should be listed, + if the second is non-nil, empty groups should also be displayed. If + the third is non-nil, it is a number. No groups with a level lower + than this number should be displayed. + + The only current function implemented is `gnus-group-prepare-flat'.") + + (defvar gnus-group-prepare-hook nil + "*A hook called after the group buffer has been generated. + If you want to modify the group buffer, you can use this hook.") + + (defvar gnus-suspend-gnus-hook nil + "*A hook called when suspending (not exiting) Gnus.") + + (defvar gnus-exit-gnus-hook nil + "*A hook called when exiting Gnus.") + + (defvar gnus-after-exiting-gnus-hook nil + "*A hook called after exiting Gnus.") + + (defvar gnus-group-update-hook '(gnus-group-highlight-line) + "*A hook called when a group line is changed. + The hook will not be called if `gnus-visual' is nil. + + The default function `gnus-group-highlight-line' will + highlight the line according to the `gnus-group-highlight' + variable.") + + ;;; Internal variables + + (defvar gnus-group-indentation-function nil) + (defvar gnus-goto-missing-group-function nil) + (defvar gnus-group-goto-next-group-function nil + "Function to override finding the next group after listing groups.") + + (defvar gnus-group-edit-buffer nil) + + (defvar gnus-group-line-format-alist + `((?M gnus-tmp-marked-mark ?c) + (?S gnus-tmp-subscribed ?c) + (?L gnus-tmp-level ?d) + (?N (cond ((eq number t) "*" ) + ((numberp number) + (int-to-string + (+ number + (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) + (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) + (t number)) ?s) + (?R gnus-tmp-number-of-read ?s) + (?t gnus-tmp-number-total ?d) + (?y gnus-tmp-number-of-unread ?s) + (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) + (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) + (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) + (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) + (?g gnus-tmp-group ?s) + (?G gnus-tmp-qualified-group ?s) + (?c (gnus-short-group-name gnus-tmp-group) ?s) + (?D gnus-tmp-newsgroup-description ?s) + (?o gnus-tmp-moderated ?c) + (?O gnus-tmp-moderated-string ?s) + (?p gnus-tmp-process-marked ?c) + (?s gnus-tmp-news-server ?s) + (?n gnus-tmp-news-method ?s) + (?P gnus-group-indentation ?s) + (?l gnus-tmp-grouplens ?s) + (?z gnus-tmp-news-method-string ?s) + (?u gnus-tmp-user-defined ?s))) + + (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) + (?: gnus-tmp-colon ?s))) + + (defvar gnus-topic-topology nil + "The complete topic hierarchy.") + + (defvar gnus-topic-alist nil + "The complete topic-group alist.") + + (defvar gnus-group-marked nil) + + (defvar gnus-group-list-mode nil) + + ;;; + ;;; Gnus group mode + ;;; + + (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 + "\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 + [delete] 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 + "m" gnus-group-mark-buffer + "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 + [delete] 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: + + \\{gnus-group-mode-map}" + (interactive) + (when (and menu-bar-mode + (gnus-visual-p 'group-menu 'menu)) + (gnus-group-make-menu-bar)) + (kill-all-local-variables) + (gnus-simplify-mode-line) + (setq major-mode 'gnus-group-mode) + (setq mode-name "Group") + (gnus-group-set-mode-line) + (setq mode-line-process nil) + (use-local-map gnus-group-mode-map) + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t) + (setq buffer-read-only t) + (gnus-update-format-specifications nil 'group 'group-mode) + (gnus-update-group-mark-positions) + (gnus-make-local-hook 'post-command-hook) + (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) + (run-hooks 'gnus-group-mode-hook)) + + (defun gnus-update-group-mark-positions () + (save-excursion + (let ((gnus-process-mark 128) + (gnus-group-marked '("dummy.group")) + (gnus-active-hashtb (make-vector 10 0))) + (gnus-set-active "dummy.group" '(0 . 0)) + (gnus-set-work-buffer) + (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) + (goto-char (point-min)) + (setq gnus-group-mark-positions + (list (cons 'process (and (search-forward "\200" nil t) + (- (point) 2)))))))) + + (defun gnus-clear-inboxes-moved () + (setq nnmail-moved-inboxes nil)) + + (defun gnus-mouse-pick-group (e) + "Enter the group under the mouse pointer." + (interactive "e") + (mouse-set-point e) + (gnus-group-read-group nil)) + + ;; Look at LEVEL and find out what the level is really supposed to be. + ;; 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 + (or (setq gnus-group-use-permanent-levels + (or level (if (numberp gnus-group-use-permanent-levels) + gnus-group-use-permanent-levels + (or gnus-group-default-list-level + gnus-level-subscribed)))) + gnus-group-default-list-level gnus-level-subscribed)) + (number-or-nil + level) + (t + (or level gnus-group-default-list-level gnus-level-subscribed)))) + + (defun gnus-group-setup-buffer () + (switch-to-buffer gnus-group-buffer) + (unless (eq major-mode 'gnus-group-mode) + (gnus-add-current-to-buffer-list) + (gnus-group-mode) + (when gnus-carpal + (gnus-carpal-setup-buffer 'group)))) + + (defun gnus-group-list-groups (&optional level unread lowest) + "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 + (gnus-group-default-level nil t) + gnus-group-default-list-level + gnus-level-subscribed)))) + (or level + (setq level (car gnus-group-list-mode) + unread (cdr gnus-group-list-mode))) + (setq level (gnus-group-default-level level)) + (gnus-group-setup-buffer) ;May call from out of group buffer + (gnus-update-format-specifications) + (let ((case-fold-search nil) + (props (text-properties-at (gnus-point-at-bol))) + (group (gnus-group-group-name))) + (set-buffer gnus-group-buffer) + (funcall gnus-group-prepare-function level unread lowest) + (if (zerop (buffer-size)) + (gnus-message 5 gnus-no-groups-message) + (goto-char (point-max)) + (when (or (not gnus-group-goto-next-group-function) + (not (funcall gnus-group-goto-next-group-function + group props))) + (if (not group) + ;; Go to the first group with unread articles. + (gnus-group-search-forward t) + ;; Find the right group to put point on. If the current group + ;; has disappeared 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 (cdddr (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 + (caar newsrc) gnus-active-hashtb))))) + (setq newsrc (cdr newsrc))) + (or newsrc (progn (goto-char (point-max)) + (forward-line -1))))))) + ;; Adjust cursor point. + (gnus-group-position-point)))) + + (defun gnus-group-list-level (level &optional all) + "List groups on LEVEL. + If ALL (the prefix), also list groups that have no unread articles." + (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. + If REGEXP, only list groups matching REGEXP." + (set-buffer gnus-group-buffer) + (let ((buffer-read-only nil) + (newsrc (cdr gnus-newsrc-alist)) + (lowest (or lowest 1)) + info clevel unread group params) + (erase-buffer) + (if (< lowest gnus-level-zombie) + ;; List living groups. + (while newsrc + (setq info (car newsrc) + group (gnus-info-group info) + params (gnus-info-params info) + newsrc (cdr newsrc) + unread (car (gnus-gethash group gnus-newsrc-hashtb))) + (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? + (if (eq unread t) ; Unactivated? + gnus-group-list-inactive-groups ; We list unactivated + (> unread 0)) ; We list groups with unread articles + (and gnus-list-groups-with-ticked-articles + (cdr (assq 'tick (gnus-info-marks info)))) + ; And groups with tickeds + ;; Check for permanent visibility. + (and gnus-permanently-visible-groups + (string-match gnus-permanently-visible-groups + 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) + (setq gnus-group-list-mode (cons level all)) + (run-hooks 'gnus-group-prepare-hook))) + + (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) + ;; List zombies and killed lists somewhat faster, which was + ;; suggested by Jack Vinson . It does + ;; this by ignoring the group format specification altogether. + (let (group) + (if regexp + ;; This loop is used when listing groups that match some + ;; regexp. + (while groups + (setq group (pop groups)) + (when (string-match regexp group) + (gnus-add-text-properties + (point) (prog1 (1+ (point)) + (insert " " mark " *: " group "\n")) + (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) + 'gnus-unread t + 'gnus-level level)))) + ;; This loop is used when listing all groups. + (while groups + (gnus-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 + 'gnus-level level)))))) + + (defun gnus-group-update-group-line () + "Update the current line in the group buffer." + (let* ((buffer-read-only nil) + (group (gnus-group-group-name)) + (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) + gnus-group-indentation) + (when group + (and entry + (not (gnus-ephemeral-group-p group)) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (prin1-to-string (nth 2 entry)) ")"))) + (setq gnus-group-indentation (gnus-group-group-indentation)) + (gnus-delete-line) + (gnus-group-insert-group-line-info group) + (forward-line -1) + (gnus-group-position-point)))) + + (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)))) + + (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 + (if (numberp number) + (int-to-string (max 0 (- gnus-tmp-number-total number))) + "*")) + (gnus-tmp-subscribed + (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) + ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) + ((= 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 (cadr 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) + (cadr gnus-tmp-method)) "")) + (gnus-tmp-marked-mark + (if (and (numberp number) + (zerop number) + (cdr (assq 'tick gnus-tmp-marked))) + ?* ? )) + (gnus-tmp-process-marked + (if (member gnus-tmp-group gnus-group-marked) + gnus-process-mark ? )) + (gnus-tmp-grouplens + (or (and gnus-use-grouplens + (bbb-grouplens-group-p gnus-tmp-group)) + "")) + (buffer-read-only nil) + header gnus-tmp-header) ; passed as parameter to user-funcs. + (beginning-of-line) + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + ;; Insert the text. + (eval gnus-group-line-format-spec)) + `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) + gnus-unread ,(if (numberp number) + (string-to-int gnus-tmp-number-of-unread) + t) + gnus-marked ,gnus-tmp-marked-mark + gnus-indentation ,gnus-group-indentation + gnus-level ,gnus-tmp-level)) + (when (inline (gnus-visual-p 'group-highlight 'highlight)) + (forward-line -1) + (run-hooks 'gnus-group-update-hook) + (forward-line)) + ;; Allow XEmacs to remove front-sticky text properties. + (gnus-group-remove-excess-properties))) + + (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. + (save-restriction + (widen) + (let ((ident (gnus-intern-safe group gnus-active-hashtb)) + (loc (point-min)) + found buffer-read-only) + ;; 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) + (let ((gnus-group-indentation (gnus-group-group-indentation))) + (gnus-delete-line) + (gnus-group-insert-group-line-info group) + (save-excursion + (forward-line -1) + (run-hooks 'gnus-group-update-group-hook))) + (setq loc (1+ loc))) + (unless (or found visible-only) + ;; No such line in the buffer, find out where it's supposed to + ;; go, and insert it there (or at the end of the buffer). + (if gnus-goto-missing-group-function + (funcall gnus-goto-missing-group-function group) + (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) + (while (and entry (car entry) + (not + (gnus-goto-char + (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe + (caar entry) gnus-active-hashtb))))) + (setq entry (cdr entry))) + (or entry (goto-char (point-max))))) + ;; Finally insert the line. + (let ((gnus-group-indentation (gnus-group-group-indentation))) + (gnus-group-insert-group-line-info group) + (save-excursion + (forward-line -1) + (run-hooks 'gnus-group-update-group-hook)))) + (gnus-group-set-mode-line))))) + + (defun gnus-group-set-mode-line () + "Update the mode line in the group buffer." + (when (memq 'group gnus-updated-mode-lines) + ;; Yes, we want to keep this mode line updated. + (save-excursion + (set-buffer gnus-group-buffer) + (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 (cadr gnus-select-method)) + (gnus-tmp-news-method (car gnus-select-method)) + (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) + (max-len 60) + gnus-tmp-header ;Dummy binding for user-defined formats + ;; Get the resulting string. + (modified + (and gnus-dribble-buffer + (buffer-name gnus-dribble-buffer) + (buffer-modified-p gnus-dribble-buffer) + (save-excursion + (set-buffer gnus-dribble-buffer) + (not (zerop (buffer-size)))))) + (mode-string (eval gformat))) + ;; Say whether the dribble buffer has been modified. + (setq mode-line-modified + (if modified "---*- " "----- ")) + ;; 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 + (gnus-mode-line-buffer-identification + (list mode-string))) + (set-buffer-modified-p modified)))))) + + (defun gnus-group-group-name () + "Get the name of the newsgroup on the current line." + (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) + (and group (symbol-name group)))) + + (defun gnus-group-group-level () + "Get the level of the newsgroup on the current line." + (get-text-property (gnus-point-at-bol) 'gnus-level)) + + (defun gnus-group-group-indentation () + "Get the indentation of the newsgroup on the current line." + (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) + (and gnus-group-indentation-function + (funcall gnus-group-indentation-function)) + "")) + + (defun gnus-group-group-unread () + "Get the number of unread articles of the newsgroup on the current line." + (get-text-property (gnus-point-at-bol) 'gnus-unread)) + + (defun gnus-group-search-forward (&optional backward all level first-too) + "Find the next newsgroup with unread articles. + If BACKWARD is non-nil, find the previous newsgroup instead. + If ALL is non-nil, just find any newsgroup. + If LEVEL is non-nil, find group with level LEVEL, or higher if no such + group exists. + If FIRST-TOO, the current line is also eligible as a target." + (let ((way (if backward -1 1)) + (low gnus-level-killed) + (beg (point)) + pos found lev) + (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) + 'gnus-level)) + (<= lev gnus-level-subscribed))) + (or (not level) + (and (setq lev (get-text-property (point) + 'gnus-level)) + (or (= lev level) + (and (< lev low) + (< level lev) + (progn + (setq low lev) + (setq pos (point)) + nil)))))))) + (zerop (forward-line way))))) + (if found + (progn (gnus-group-position-point) t) + (goto-char (or pos beg)) + (and pos t)))) + + ;;; Gnus group mode commands + + ;; Group marking. + + (defun gnus-group-mark-group (n &optional unmark no-advance) + "Mark the current group." + (interactive "p") + (let ((buffer-read-only nil) + group) + (while (and (> n 0) + (not (eobp))) + (when (setq group (gnus-group-group-name)) + ;; Update the mark. + (beginning-of-line) + (forward-char + (or (cdr (assq 'process gnus-group-mark-positions)) 2)) + (delete-char 1) + (if unmark + (progn + (insert " ") + (setq gnus-group-marked (delete group gnus-group-marked))) + (insert "#") + (setq gnus-group-marked + (cons group (delete group gnus-group-marked))))) + (or no-advance (gnus-group-next-group 1)) + (decf n)) + (gnus-summary-position-point) + n)) + + (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." + (interactive) + (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. + If UNMARK, remove the mark instead." + (interactive "P\nr") + (let ((num (count-lines beg end))) + (save-excursion + (goto-char beg) + (- num (gnus-group-mark-group num unmark))))) + + (defun gnus-group-mark-buffer (&optional unmark) + "Mark all groups in the buffer. + If UNMARK, remove the mark instead." + (interactive "P") + (gnus-group-mark-region unmark (point-min) (point-max))) + + (defun gnus-group-mark-regexp (regexp) + "Mark all groups that match some regexp." + (interactive "sMark (regexp): ") + (let ((alist (cdr gnus-newsrc-alist)) + 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) + "Remove the process mark from GROUP and move point there. + Return nil if the group isn't displayed." + (if (gnus-group-goto-group group) + (save-excursion + (gnus-group-mark-group 1 'unmark t) + t) + (setq gnus-group-marked + (delete group gnus-group-marked)) + nil)) + + (defun gnus-group-set-mark (group) + "Set the process mark on GROUP." + (if (gnus-group-goto-group group) + (save-excursion + (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) + (gnus-error 1 "Undefined key") + (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) + (save-excursion + (while (and (> n 0) + (setq group (gnus-group-group-name))) + (setq groups (cons group groups)) + (setq n (1- n)) + (gnus-group-next-group way))) + (nreverse groups))) + ((and (boundp 'transient-mark-mode) + transient-mark-mode + (boundp 'mark-active) + mark-active) + ;; Work on the region between point and mark. + (let ((max (max (point) (mark))) + groups) + (save-excursion + (goto-char (min (point) (mark))) + (while + (and + (push (gnus-group-group-name) groups) + (zerop (gnus-group-next-group 1)) + (< (point) max))) + (nreverse groups)))) + (gnus-group-marked + ;; No prefix, but a list of marked articles. + (reverse gnus-group-marked)) + (t + ;; Neither marked articles or a prefix, so we return the + ;; current group. + (let ((group (gnus-group-group-name))) + (and group (list group)))))) + + ;; Selecting groups. + + (defun gnus-group-read-group (&optional all no-article group) + "Read news in this newsgroup. + 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))) + number active marked entry) + (or group (error "No group on current line")) + (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash + group gnus-newsrc-hashtb))))) + ;; This group might be a dead group. In that case we have to get + ;; the number of unread articles from `gnus-active-hashtb'. + (setq number + (cond ((numberp all) all) + (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))) + + (defun gnus-group-select-group (&optional all) + "Select this newsgroup. + No article is selected automatically. + If ALL is non-nil, already read articles become readable. + If ALL is a number, fetch this number of articles." + (interactive "P") + (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 + gnus-score-find-score-files-function + gnus-apply-kill-hook + gnus-summary-expunge-below) + (gnus-group-read-group all t))) + + (defun gnus-group-visible-select-group (&optional all) + "Select the current group without hiding any articles." + (interactive "P") + (let ((gnus-inhibit-limiting t)) + (gnus-group-read-group all t))) + + ;;;###autoload + (defun gnus-fetch-group (group) + "Start Gnus if necessary and enter GROUP. + Returns whether the fetching was successful or not." + (interactive "sGroup name: ") + (or (get-buffer gnus-group-buffer) + (gnus)) + (gnus-group-read-group nil nil group)) + + ;; 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 + `(t nil (,group ,gnus-level-default-subscribed nil nil ,method + ((quit-config . ,(if quit-config quit-config + (cons (current-buffer) 'summary)))))) + gnus-newsrc-hashtb) + (set-buffer gnus-group-buffer) + (or (gnus-check-server method) + (error "Unable to contact server: %s" (gnus-status-message method))) + (if activate (or (gnus-request-group group) + (error "Couldn't request group"))) + (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 + (gnus-read-active-file-p) + nil + 'gnus-group-history))) + + (when (equal group "") + (error "Empty group name")) + + (when (string-match "[\000-\032]" group) + (error "Control characters in group: %s" group)) + + (let ((b (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) + (unless (gnus-ephemeral-group-p group) + (if b + ;; Either go to the line in the group buffer... + (goto-char b) + ;; ... or insert the line. + (or + t ;; Don't activate group. + (gnus-active group) + (gnus-activate-group group) + (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. + (gnus-group-position-point))) + + (defun gnus-group-goto-group (group) + "Goto to newsgroup GROUP." + (when group + ;; It's quite likely that we are on the right line, so + ;; we check the current line first. + (beginning-of-line) + (if (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (point) + ;; Search through the entire buffer. + (let ((b (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) + (when b + (goto-char b)))))) + + (defun gnus-group-next-group (n &optional silent) + "Go to next N'th newsgroup. + If N is negative, search backward instead. + Returns the difference between N and the number of skips actually + done." + (interactive "p") + (gnus-group-next-unread-group n t nil silent)) + + (defun gnus-group-next-unread-group (n &optional all level silent) + "Go to next N'th unread newsgroup. + If N is negative, search backward instead. + If ALL is non-nil, choose any newsgroup, unread or not. + If LEVEL is non-nil, choose the next group with level LEVEL, or, if no + such group can be found, the next group with a level higher than + LEVEL. + Returns the difference between N and the number of skips actually + made." + (interactive "p") + (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))) + (when (and (/= 0 n) + (not silent)) + (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") + (if level " on this level or higher" ""))) + n)) + + (defun gnus-group-prev-group (n) + "Go to previous N'th newsgroup. + Returns the difference between N and the number of skips actually + done." + (interactive "p") + (gnus-group-next-unread-group (- n) t)) + + (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))) + + (defun gnus-group-next-unread-group-same-level (n) + "Go to next N'th unread newsgroup on the same level. + If N is negative, search backward instead. + Returns the difference between N and the number of skips actually + done." + (interactive "p") + (gnus-group-next-unread-group n t (gnus-group-group-level)) + (gnus-group-position-point)) + + (defun gnus-group-prev-unread-group-same-level (n) + "Go to next N'th unread newsgroup on the same level. + Returns the difference between N and the number of skips actually + done." + (interactive "p") + (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) + (gnus-group-position-point)) + + (defun gnus-group-best-unread-group (&optional exclude-group) + "Go to the group with the highest level. + If EXCLUDE-GROUP, do not go to that group." + (interactive) + (goto-char (point-min)) + (let ((best 100000) + unread best-point) + (while (not (eobp)) + (setq unread (get-text-property (point) 'gnus-unread)) + (if (and (numberp unread) (> unread 0)) + (progn + (if (and (get-text-property (point) 'gnus-level) + (< (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)) + (if best-point (goto-char best-point)) + (gnus-summary-position-point) + (and best-point (gnus-group-group-name)))) + + (defun gnus-group-first-unread-group () + "Go to the first group with unread articles." + (interactive) + (prog1 + (let ((opoint (point)) + unread) + (goto-char (point-min)) + (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. + (and (numberp unread) ; Not a topic. + (not (zerop unread))) ; Has unread articles. + (zerop (gnus-group-next-unread-group 1))) ; Next unread group. + (point) ; Success. + (goto-char opoint) + nil)) ; Not success. + (gnus-group-position-point))) + + (defun gnus-group-enter-server-mode () + "Jump to the server buffer." + (interactive) + (gnus-enter-server-buffer)) + + (defun gnus-group-make-group (name &optional method address) + "Add a new newsgroup. + 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 nil 'gnus-method-history))) + (cond + ((equal method "") + (setq method gnus-select-method)) + ((assoc method gnus-valid-select-methods) + (list method + (if (memq 'prompt-address + (assoc method gnus-valid-select-methods)) + (read-string "Address: ") + ""))) + ((assoc method gnus-server-alist) + (list method)) + (t + (list method "")))))) + + (let* ((meth (when (and method + (not (gnus-server-equal method gnus-select-method))) + (if address (list (intern method) address) + method))) + (nname (if method (gnus-group-prefixed-name name meth) name)) + backend info) + (when (gnus-gethash nname gnus-newsrc-hashtb) + (error "Group %s already exists" nname)) + ;; Subscribe to the new group. + (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) + ;; Make it active. + (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)) ")"))) + ;; Insert the line. + (gnus-group-insert-group-line-info nname) + (forward-line -1) + (gnus-group-position-point) + + ;; Load the backend and try to make the backend create + ;; the group as well. + (when (assoc (symbol-name (setq backend (car (gnus-server-get-method + nil meth)))) + gnus-valid-select-methods) + (require backend)) + (gnus-check-server meth) + (and (gnus-check-backend-function 'request-create-group nname) + (gnus-request-create-group nname)) + t)) + + (defun gnus-group-delete-group (group &optional force) + "Delete the current group. Only meaningful with mail groups. + 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. The user will be prompted before + doing the deletion." + (interactive + (list (gnus-group-group-name) + current-prefix-arg)) + (or group (error "No group to rename")) + (or (gnus-check-backend-function 'request-delete-group group) + (error "This backend does not support group deletion")) + (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) + (if (not (gnus-request-delete-group group force)) + (gnus-error 3 "Couldn't delete group %s" group) + (gnus-message 6 "Deleting group %s...done" group) + (gnus-group-goto-group group) + (gnus-group-kill-group 1 t) + (gnus-sethash group nil gnus-active-hashtb) + t)) + (gnus-group-position-point))) + + (defun gnus-group-rename-group (group new-name) + (interactive + (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: ")))) + + (or (gnus-check-backend-function 'request-rename-group group) + (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 + (if (equal (gnus-group-real-name new-name) new-name) + ;; Native group. + new-name + ;; Foreign group. + (gnus-group-prefixed-name + (gnus-group-real-name new-name) + (gnus-info-method (gnus-get-info group))))) + + (gnus-message 6 "Renaming group %s to %s..." group new-name) + (prog1 + (if (not (gnus-request-rename-group group new-name)) + (gnus-error 3 "Couldn't rename group %s to %s" group new-name) + ;; We rename the group internally by killing it... + (gnus-group-goto-group group) + (gnus-group-kill-group) + ;; ... changing its name ... + (setcar (cdar 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) + (gnus-group-position-point))) + + (defun gnus-group-edit-group (group &optional part) + "Edit the group on the current line." + (interactive (list (gnus-group-group-name))) + (let* ((part (or part 'info)) + (done-func `(lambda () + "Exit editing mode and update the information." + (interactive) + (gnus-group-edit-group-done ',part ,group))) + (winconf (current-window-configuration)) + info) + (or group (error "No group on current line")) + (or (setq info (gnus-get-info group)) + (error "Killed group; can't be edited")) + (set-buffer (setq gnus-group-edit-buffer + (get-buffer-create + (format "*Gnus edit %s*" group)))) + (gnus-configure-windows 'edit-group) + (gnus-add-current-to-buffer-list) + (emacs-lisp-mode) + ;; Suggested by Hallvard B Furuseth . + (use-local-map (copy-keymap emacs-lisp-mode-map)) + (local-set-key "\C-c\C-c" done-func) + (make-local-variable 'gnus-prev-winconf) + (setq gnus-prev-winconf winconf) + (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")) + ((eq part 'params) + (gnus-info-params info)) + (t info))) + "\n"))) + + (defun gnus-group-edit-group-method (group) + "Edit the select method of GROUP." + (interactive (list (gnus-group-group-name))) + (gnus-group-edit-group group 'method)) + + (defun gnus-group-edit-group-parameters (group) + "Edit the group parameters of GROUP." + (interactive (list (gnus-group-group-name))) + (gnus-group-edit-group group 'params)) + + (defun gnus-group-edit-group-done (part group) + "Get info from buffer, update variables and jump to the group buffer." + (when (and gnus-group-edit-buffer + (buffer-name gnus-group-edit-buffer)) + (set-buffer gnus-group-edit-buffer) + (goto-char (point-min)) + (let* ((form (read (current-buffer))) + (winconf gnus-prev-winconf) + (method (cond ((eq part 'info) (nth 4 form)) + ((eq part 'method) form) + (t nil))) + (info (cond ((eq part 'info) form) + ((eq part 'method) (gnus-get-info group)) + (t nil))) + (new-group (if info + (if (or (not method) + (gnus-server-equal + gnus-select-method method)) + (gnus-group-real-name (car info)) + (gnus-group-prefixed-name + (gnus-group-real-name (car info)) method)) + nil))) + (when (and new-group + (not (equal new-group group))) + (when (gnus-group-goto-group group) + (gnus-group-kill-group 1)) + (gnus-activate-group new-group)) + ;; Set the info. + (if (and info new-group) + (progn + (setq info (gnus-copy-sequence info)) + (setcar info new-group) + (unless (gnus-server-equal method "native") + (unless (nthcdr 3 info) + (nconc info (list nil nil))) + (unless (nthcdr 4 info) + (nconc info (list nil))) + (gnus-info-set-method info method)) + (gnus-group-set-info info)) + (gnus-group-set-info form (or new-group group) part)) + (kill-buffer (current-buffer)) + (and winconf (set-window-configuration winconf)) + (set-buffer gnus-group-buffer) + (gnus-group-update-group (or new-group group)) + (gnus-group-position-point)))) + + (defun gnus-group-make-help-group () + "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) + (gnus-message 1 "Couldn't find doc group") + (gnus-group-make-group + (gnus-group-real-name name) + (list 'nndoc "gnus-help" + (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) + ((= char ?b) 'babyl) + ((= char ?d) 'digest) + ((= char ?f) 'forward) + ((= char ?a) 'mmfd) + (t (setq err (format "%c unknown. " char)) + nil)))) + (setq type found))) + (let* ((file (expand-file-name file)) + (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 (file-name-nondirectory file) + (list 'nndoc-address file) + (list 'nndoc-article-type (or type 'guess)))))) + + (defun gnus-group-make-archive-group (&optional all) + "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 "")))) + (when (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)))) + (gnus-group-add-parameter group (cons 'to-address "ding@ifi.uio.no")))) + + (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: "))) + (or (file-exists-p dir) (error "No such directory")) + (or (file-directory-p dir) (error "Not a directory")) + (let ((ext "") + (i 0) + 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 (gnus-group-real-name group) (list 'nndir-directory dir))))) + + (defun gnus-group-make-kiboze-group (group address scores) + "Create an nnkiboze group. + The user will be prompted for a name, a regexp to match groups, and + score file entries for articles to include in the group." + (interactive + (list + (read-string "nnkiboze group name: ") + (read-string "Source groups (regexp): ") + (let ((headers (mapcar (lambda (group) (list group)) + '("subject" "from" "number" "date" "message-id" + "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))) + (setq scores (cons (cons header regexps) scores))) + scores))) + (gnus-group-make-group group "nnkiboze" address) + (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) + (let (emacs-lisp-mode-hook) + (pp scores (current-buffer))))) + + (defun gnus-group-add-to-virtual (n vgroup) + "Add the current group to a virtual group." + (interactive + (list current-prefix-arg + (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t + "nnvirtual:"))) + (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) + (error "%s is not an nnvirtual group" vgroup)) + (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 "\\|")))) + (gnus-group-position-point)) + + (defun gnus-group-make-empty-virtual (group) + "Create a new, fresh, empty virtual group." + (interactive "sCreate new, empty virtual group: ") + (let* ((method (list 'nnvirtual "^$")) + (pgroup (gnus-group-prefixed-name group method))) + ;; Check whether it exists already. + (and (gnus-gethash pgroup gnus-newsrc-hashtb) + (error "Group %s already exists." pgroup)) + ;; Subscribe the new group after the group on the current line. + (gnus-subscribe-group pgroup (gnus-group-group-name) method) + (gnus-group-update-group pgroup) + (forward-line -1) + (gnus-group-position-point))) + + (defun gnus-group-enter-directory (dir) + "Enter an ephemeral nneething group." + (interactive "DDirectory to read: ") + (let* ((method (list 'nneething dir)) + (leaf (gnus-group-prefixed-name + (file-name-nondirectory (directory-file-name dir)) + 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))) + (error "Couldn't enter %s" dir))))) + + ;; Group sorting commands + ;; Suggested by Joe Hildebrand . + + (defun gnus-group-sort-groups (func &optional reverse) + "Sort the group buffer according to FUNC. + If REVERSE, reverse the sorting order." + (interactive (list gnus-group-sort-function + current-prefix-arg)) + (let ((func (cond + ((not (listp func)) func) + ((null 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 func + (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. + If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) + + (defun gnus-group-sort-groups-by-unread (&optional reverse) + "Sort the group buffer by number of unread articles. + If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) + + (defun gnus-group-sort-groups-by-level (&optional reverse) + "Sort the group buffer by group level. + If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) + + (defun gnus-group-sort-groups-by-score (&optional reverse) + "Sort the group buffer by group score. + If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) + + (defun gnus-group-sort-groups-by-rank (&optional reverse) + "Sort the group buffer by group rank. + If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) + + (defun gnus-group-sort-groups-by-method (&optional reverse) + "Sort the group buffer alphabetically by backend name. + If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) + + (defun gnus-group-sort-by-alphabet (info1 info2) + "Sort alphabetically." + (string< (gnus-info-group info1) (gnus-info-group info2))) + + (defun gnus-group-sort-by-unread (info1 info2) + "Sort by number of unread articles." + (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) + (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) + (< (or (and (numberp n1) n1) 0) + (or (and (numberp n2) n2) 0)))) + + (defun gnus-group-sort-by-level (info1 info2) + "Sort by level." + (< (gnus-info-level info1) (gnus-info-level info2))) + + (defun gnus-group-sort-by-method (info1 info2) + "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) + "Sort by group score." + (< (gnus-info-score info1) (gnus-info-score info2))) + + (defun gnus-group-sort-by-rank (info1 info2) + "Sort by level and score." + (let ((level1 (gnus-info-level info1)) + (level2 (gnus-info-level info2))) + (or (< level1 level2) + (and (= level1 level2) + (> (gnus-info-score info1) (gnus-info-score info2)))))) + + ;; Group catching up. + + (defun gnus-group-clear-data (n) + "Clear all marks and read ranges from the current group." + (interactive "P") + (let ((groups (gnus-group-process-prefix n)) + group info) + (while (setq group (pop groups)) + (setq info (gnus-get-info group)) + (gnus-info-set-read info nil) + (when (gnus-info-marks info) + (gnus-info-set-marks info nil)) + (gnus-get-unread-articles-in-group info (gnus-active group) t) + (when (gnus-group-goto-group group) + (gnus-group-remove-mark group) + (gnus-group-update-group-line))))) + + (defun gnus-group-catchup-current (&optional n all) + "Mark all articles not marked as unread in current newsgroup as read. + If prefix argument N is numeric, the ARG next newsgroups will be + caught up. If ALL is non-nil, marked articles will also be marked as + read. Cross references (Xref: header) of articles are ignored. + The difference between N and actual number of newsgroups that were + caught up is returned." + (interactive "P") + (unless (gnus-group-group-name) + (error "No group on the current line")) + (if (not (or (not gnus-interactive-catchup) ;Without confirmation? + gnus-expert-user + (gnus-y-or-n-p + (if all + "Do you really want to mark all articles as read? " + "Mark all unread articles as read? ")))) + n + (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 + (gnus-group-real-name (car groups)) (nth 1 method) all))) + (gnus-group-remove-mark (car groups)) + (if (>= (gnus-group-group-level) gnus-level-zombie) + (gnus-message 2 "Dead groups can't be caught up") + (if (prog1 + (gnus-group-goto-group (car groups)) + (gnus-group-catchup (car groups) all)) + (gnus-group-update-group-line) + (setq ret (1+ ret)))) + (setq groups (cdr groups))) + (gnus-group-next-unread-group 1) + ret))) + + (defun gnus-group-catchup-current-all (&optional n) + "Mark all articles in current newsgroup as read. + Cross references (Xref: header) of articles are ignored." + (interactive "P") + (gnus-group-catchup-current n 'all)) + + (defun gnus-group-catchup (group &optional all) + "Mark all articles in GROUP as read. + If ALL is non-nil, all articles are marked as read. + The return value is the number of articles that were marked as read, + or nil if no action could be taken." + (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (num (car entry))) + ;; Do the updating only if the newsgroup isn't killed. + (if (not (numberp (car entry))) + (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)) + (run-hooks 'gnus-group-catchup-group-hook) + num)))) + + (defun gnus-group-expire-articles (&optional n) + "Expire all expirable articles in the current newsgroup." + (interactive "P") + (let ((groups (gnus-group-process-prefix n)) + 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) + (let* ((info (gnus-get-info group)) + (expirable (if (gnus-group-total-expirable-p group) + (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 + ;; We set the expiry variables to the groupp + ;; parameter. + (let ((nnmail-expiry-wait-function nil) + (nnmail-expiry-wait expiry-wait)) + (gnus-request-expire-articles + (gnus-uncompress-sequence (cdr expirable)) group)) + ;; Just expire using the normal expiry values. + (gnus-request-expire-articles + (gnus-uncompress-sequence (cdr expirable)) group)))) + (gnus-close-group group)) + (gnus-message 6 "Expiring articles in %s...done" group))) + (gnus-group-position-point)))) + + (defun gnus-group-expire-all-groups () + "Expire all expirable articles in all newsgroups." + (interactive) + (save-excursion + (gnus-message 5 "Expiring...") + (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) + (cdr gnus-newsrc-alist)))) + (gnus-group-expire-articles nil))) + (gnus-group-position-point) + (gnus-message 5 "Expiring...done")) + + (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): " + (or (gnus-group-group-level) + gnus-level-default-subscribed))))) + (if (string-match "^\\s-*$" s) + (int-to-string (or (gnus-group-group-level) + gnus-level-default-subscribed)) + s))))) + (or (and (>= level 1) (<= level gnus-level-killed)) + (error "Illegal level: %d" level)) + (let ((groups (gnus-group-process-prefix n)) + group) + (while (setq group (pop 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)) + + (defun gnus-group-unsubscribe-current-group (&optional n) + "Toggle subscription of the current group. + If given numerical prefix, toggle the N next groups." + (interactive "P") + (let ((groups (gnus-group-process-prefix n)) + group) + (while groups + (setq group (car groups) + groups (cdr groups)) + (gnus-group-remove-mark group) + (gnus-group-unsubscribe-group + group (if (<= (gnus-group-group-level) gnus-level-subscribed) + gnus-level-default-unsubscribed + gnus-level-default-subscribed) t) + (gnus-group-update-group-line)) + (gnus-group-next-group 1))) + + (defun gnus-group-unsubscribe-group (group &optional level silent) + "Toggle subscription to GROUP. + Killed newsgroups are subscribed. If SILENT, don't try to update the + group line." + (interactive + (list (completing-read + "Group: " gnus-active-hashtb nil + (gnus-read-active-file-p) + nil + 'gnus-group-history))) + (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) + (cond + ((string-match "^[ \t]$" group) + (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 + (gnus-group-update-group group))) + ((and (stringp group) + (or (not (gnus-read-active-file-p)) + (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))) + (unless silent + (gnus-group-update-group group))) + (t (error "No such newsgroup: %s" group))) + (gnus-group-position-point))) + + (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")) + (gnus-group-kill-group 1) + (prog1 + (forward-line (- n)) + (gnus-group-yank-group) + (gnus-group-position-point))) + + (defun gnus-group-kill-all-zombies () + "Kill all zombie newsgroups." + (interactive) + (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) + (setq gnus-zombie-list nil) + (gnus-group-list-groups)) + + (defun gnus-group-kill-region (begin end) + "Kill newsgroups in current region (excluding current point). + The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." + (interactive "r") + (let ((lines + ;; Count lines. + (save-excursion + (count-lines + (progn + (goto-char begin) + (beginning-of-line) + (point)) + (progn + (goto-char end) + (beginning-of-line) + (point)))))) + (goto-char begin) + (beginning-of-line) ;Important when LINES < 1 + (gnus-group-kill-group lines))) + + (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." + (interactive "P") + (let ((buffer-read-only nil) + (groups (gnus-group-process-prefix n)) + group entry level out) + (if (< (length groups) 10) + ;; This is faster when there are few groups. + (while groups + (push (setq group (pop groups)) out) + (gnus-group-remove-mark group) + (setq level (gnus-group-group-level)) + (gnus-delete-line) + (when (and (not discard) + (setq entry (gnus-gethash group gnus-newsrc-hashtb))) + (push (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. + (let (entry) + (setq groups (nreverse groups)) + (while groups + (gnus-group-remove-mark (setq group (pop groups))) + (gnus-delete-line) + (push group gnus-killed-list) + (setq gnus-newsrc-alist + (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist)) + (when gnus-group-change-level-function + (funcall gnus-group-change-level-function group 9 3)) + (cond + ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (push (cons (car entry) (nth 2 entry)) + gnus-list-of-killed-groups) + (setcdr (cdr entry) (cdddr entry))) + ((member group gnus-zombie-list) + (setq gnus-zombie-list (delete group gnus-zombie-list))))) + (gnus-make-hashtable-from-newsrc-alist))) + + (gnus-group-position-point) + (if (< (length out) 2) (car out) (nreverse out)))) + + (defun gnus-group-yank-group (&optional arg) + "Yank the last newsgroups killed with \\[gnus-group-kill-group], + inserting it before the current newsgroup. The numeric ARG specifies + how many newsgroups are to be yanked. The name of the newsgroup yanked + is returned, or (if several groups are yanked) a list of yanked groups + is returned." + (interactive "p") + (setq arg (or arg 1)) + (let (info group prev out) + (while (>= (decf arg) 0) + (if (not (setq info (pop gnus-list-of-killed-groups))) + (error "No more newsgroups to yank")) + (push (setq group (nth 1 info)) out) + ;; Find which newsgroup to insert this one before - search + ;; backward until something suitable is found. If there are no + ;; other newsgroups in this buffer, just make this newsgroup the + ;; first newsgroup. + (setq prev (gnus-group-group-name)) + (gnus-group-change-level + info (gnus-info-level (cdr info)) gnus-level-killed + (and prev (gnus-gethash prev gnus-newsrc-hashtb)) + t) + (gnus-group-insert-group-line-info group)) + (forward-line -1) + (gnus-group-position-point) + (if (< (length out) 2) (car out) (nreverse out)))) + + (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)) + (setq gnus-zombie-list nil)) + ((and (< level gnus-level-zombie) + (> 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) + (alist (cdr prev))) + (while alist + (if (= (gnus-info-level (car alist)) level) + (progn + (push (gnus-info-group (car alist)) gnus-killed-list) + (setcdr prev (cdr alist))) + (setq prev alist)) + (setq alist (cdr alist))) + (gnus-make-hashtable-from-newsrc-alist) + (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 + unsubscribed groups." + (interactive "P") + (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) + + ;; Redefine this to list ALL killed groups if prefix arg used. + ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). + (defun gnus-group-list-killed (&optional arg) + "List all killed newsgroups in the group buffer. + If ARG is non-nil, list ALL killed groups known to Gnus. This may + entail asking the server for the groups." + (interactive "P") + ;; Find all possible killed newsgroups if arg. + (when arg + (gnus-get-killed-groups)) + (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)) + + (defun gnus-group-list-zombies () + "List all zombie newsgroups in the group buffer." + (interactive) + (if (not gnus-zombie-list) + (gnus-message 6 "No zombie groups") + (let (gnus-group-list-mode) + (funcall gnus-group-prepare-function + gnus-level-zombie t gnus-level-zombie)) + (goto-char (point-min))) + (gnus-group-position-point)) + + (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-read-active-file-p) + (let ((gnus-read-active-file t)) + (gnus-read-active-file))) + ;; Find all groups and sort them. + (let ((groups + (sort + (let (list) + (mapatoms + (lambda (sym) + (and (boundp sym) + (symbol-value sym) + (setq list (cons (symbol-name sym) list)))) + gnus-active-hashtb) + list) + 'string<)) + (buffer-read-only nil)) + (erase-buffer) + (while groups + (gnus-group-insert-group-line-info (pop groups))) + (goto-char (point-min)))) + + (defun gnus-activate-all-groups (level) + "Activate absolutely all groups." + (interactive (list 7)) + (let ((gnus-activate-level level) + (gnus-activate-foreign-newsgroups level)) + (gnus-group-get-new-news))) + + (defun gnus-group-get-new-news (&optional arg) + "Get newly arrived articles. + If ARG is a number, it specifies which levels you are interested in + re-scanning. If ARG is non-nil and not a number, this will force + \"hard\" re-reading of the active files from all servers." + (interactive "P") + (run-hooks 'gnus-get-new-news-hook) + ;; We might read in new NoCeM messages here. + (when (and gnus-use-nocem + (null arg)) + (gnus-nocem-scan-groups)) + ;; If ARG is not a number, then we read the active file. + (when (and arg (not (numberp arg))) + (let ((gnus-read-active-file t)) + (gnus-read-active-file)) + (setq arg nil)) + + (setq arg (gnus-group-default-level arg t)) + (if (and gnus-read-active-file (not arg)) + (progn + (gnus-read-active-file) + (gnus-get-unread-articles arg)) + (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) + (gnus-get-unread-articles arg))) + (run-hooks 'gnus-after-getting-new-news-hook) + (gnus-group-list-groups)) + + (defun gnus-group-get-new-news-this-group (&optional n) + "Check for newly arrived news in the current group (and the N-1 next groups). + The difference between N and the number of newsgroup checked is returned. + If N is negative, this group and the N-1 previous groups will be checked." + (interactive "P") + (let* ((groups (gnus-group-process-prefix n)) + (ret (if (numberp n) (- n (length groups)) 0)) + (beg (unless n (point))) + group) + (while (setq group (pop groups)) + (gnus-group-remove-mark group) + (if (gnus-activate-group group 'scan) + (progn + (gnus-get-unread-articles-in-group + (gnus-get-info group) (gnus-active group) t) + (unless (gnus-virtual-group-p group) + (gnus-close-group group)) + (gnus-group-update-group group)) + (if (eq (gnus-server-status (gnus-find-method-for-group group)) + 'denied) + (gnus-error "Server denied access") + (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) + (when beg (goto-char beg)) + (when gnus-goto-next-group-when-activating + (gnus-group-next-unread-group 1 t)) + (gnus-summary-position-point) + ret)) + + (defun gnus-group-fetch-faq (group &optional faq-dir) + "Fetch the FAQ for the current group." + (interactive + (list + (and (gnus-group-group-name) + (gnus-group-real-name (gnus-group-group-name))) + (cond (current-prefix-arg + (completing-read + "Faq dir: " (and (listp gnus-group-faq-directory) + (mapcar (lambda (file) (list file)) + 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))) + (let* ((method (gnus-find-method-for-group group)) + (mname (gnus-group-prefixed-name "" method)) + desc) + (when (and force + gnus-description-hashtb) + (gnus-sethash mname nil gnus-description-hashtb)) + (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 mname gnus-description-hashtb)) + (setq desc (gnus-group-get-description group)) + (gnus-read-descriptions-file method)) + (gnus-message 1 + (or desc (gnus-gethash group gnus-description-hashtb) + "No description available"))))) + + ;; Suggested by Per Abrahamsen . + (defun gnus-group-describe-all-groups (&optional force) + "Pop up a buffer with descriptions of all newsgroups." + (interactive "P") + (and force (setq gnus-description-hashtb nil)) + (if (not (or gnus-description-hashtb + (gnus-read-all-descriptions-files))) + (error "Couldn't request descriptions file")) + (let ((buffer-read-only nil) + b) + (erase-buffer) + (mapatoms + (lambda (group) + (setq b (point)) + (insert (format " *: %-20s %s\n" (symbol-name group) + (symbol-value group))) + (gnus-add-text-properties + b (1+ b) (list 'gnus-group group + 'gnus-unread t 'gnus-marked nil + 'gnus-level (1+ gnus-level-subscribed)))) + gnus-description-hashtb) + (goto-char (point-min)) + (gnus-group-position-point))) + + ;; Suggested by Daniel Quinlan . + (defun gnus-group-apropos (regexp &optional search-description) + "List all newsgroups that have names that match a regexp." + (interactive "sGnus apropos (regexp): ") + (let ((prev "") + (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) + ;; Also go through all descriptions that are known to Gnus. + (when search-description + (mapatoms + (lambda (group) + (and (string-match regexp (symbol-value group)) + (gnus-active (symbol-name group)) + (setq groups (cons (symbol-name group) groups)))) + gnus-description-hashtb)) + (if (not groups) + (gnus-message 3 "No groups matched \"%s\"." regexp) + ;; Print out all the groups. + (save-excursion + (pop-to-buffer "*Gnus Help*") + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (setq groups (sort groups 'string<)) + (while groups + ;; Groups may be entered twice into the list of groups. + (if (not (string= (car groups) prev)) + (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))) + (goto-char (point-min)))) + (pop-to-buffer obuf))) + + (defun gnus-group-description-apropos (regexp) + "List all newsgroups that have names or descriptions that match a regexp." + (interactive "sGnus description apropos (regexp): ") + (if (not (or gnus-description-hashtb + (gnus-read-all-descriptions-files))) + (error "Couldn't request descriptions file")) + (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. + + This command may read the active file." + (interactive "P\nsList newsgroups matching: ") + ;; First make sure active file has been read. + (when (and level + (> (prefix-numeric-value level) gnus-level-killed)) + (gnus-get-killed-groups)) + (gnus-group-prepare-flat (or level gnus-level-subscribed) + all (or lowest 1) regexp) + (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)) + + ;; Suggested by Jack Vinson . + (defun gnus-group-save-newsrc (&optional force) + "Save the Gnus startup files. + If FORCE, force saving whether it is necessary or not." + (interactive "P") + (gnus-save-newsrc-file force)) + + (defun gnus-group-restart (&optional arg) + "Force Gnus to read the .newsrc file." + (interactive "P") + (when (gnus-yes-or-no-p + (format "Are you sure you want to read %s? " + gnus-current-startup-file)) + (gnus-save-newsrc-file) + (gnus-setup-news 'force) + (gnus-group-list-groups arg))) + + (defun gnus-group-read-init-file () + "Read the Gnus elisp init file." + (interactive) + (gnus-read-init-file)) + + (defun gnus-group-check-bogus-groups (&optional silent) + "Check bogus newsgroups. + If given a prefix, don't ask for confirmation before removing a bogus + group." + (interactive "P") + (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) + (gnus-group-list-groups)) + + (defun gnus-group-edit-global-kill (&optional article group) + "Edit the global kill file. + If GROUP, edit that local kill file instead." + (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)" + (if group "local" "global"))))) + + (defun gnus-group-edit-local-kill (article group) + "Edit a local kill file." + (interactive (list nil (gnus-group-group-name))) + (gnus-group-edit-global-kill article group)) + + (defun gnus-group-force-update () + "Update `.newsrc' file." + (interactive) + (gnus-save-newsrc-file)) + + (defun gnus-group-suspend () + "Suspend the current Gnus session. + In fact, cleanup buffers except for group mode buffer. + The hook gnus-suspend-gnus-hook is called before actually suspending." + (interactive) + (run-hooks 'gnus-suspend-gnus-hook) + ;; Kill Gnus buffers except for group mode buffer. + (let* ((group-buf (get-buffer gnus-group-buffer)) + ;; Do this on a separate list in case the user does a ^G before we finish + (gnus-buffer-list + (delete group-buf (delete gnus-dribble-buffer + (append gnus-buffer-list nil))))) + (while gnus-buffer-list + (gnus-kill-buffer (pop gnus-buffer-list))) + (gnus-kill-gnus-frames) + (when group-buf + (setq gnus-buffer-list (list group-buf)) + (bury-buffer group-buf) + (delete-windows-on group-buf t)))) + + (defun gnus-group-clear-dribble () + "Clear all information from the dribble buffer." + (interactive) + (gnus-dribble-clear) + (gnus-message 7 "Cleared dribble buffer")) + + (defun gnus-group-exit () + "Quit reading news after updating .newsrc.eld and .newsrc. + The hook `gnus-exit-gnus-hook' is called before actually exiting." + (interactive) + (when + (or noninteractive ;For gnus-batch-kill + (not gnus-interactive-exit) ;Without confirmation + gnus-expert-user + (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) + (run-hooks 'gnus-exit-gnus-hook) + ;; Offer to save data from non-quitted summary buffers. + (gnus-offer-save-summaries) + ;; Save the newsrc file(s). + (gnus-save-newsrc-file) + ;; Kill-em-all. + (gnus-close-backends) + ;; Reset everything. + (gnus-clear-system) + ;; Allow the user to do things after cleaning up. + (run-hooks 'gnus-after-exiting-gnus-hook))) + + (defun gnus-group-quit () + "Quit reading news without updating .newsrc.eld or .newsrc. + The hook `gnus-exit-gnus-hook' is called before actually exiting." + (interactive) + (when (or noninteractive ;For gnus-batch-kill + (zerop (buffer-size)) + (not (gnus-server-opened gnus-select-method)) + gnus-expert-user + (not gnus-current-startup-file) + (gnus-yes-or-no-p + (format "Quit reading news without saving %s? " + (file-name-nondirectory gnus-current-startup-file)))) + (run-hooks 'gnus-exit-gnus-hook) + (gnus-configure-windows 'group t) + (gnus-dribble-save) + (gnus-close-backends) + (gnus-clear-system) + ;; Allow the user to do things after cleaning up. + (run-hooks 'gnus-after-exiting-gnus-hook))) + + (defun gnus-group-describe-briefly () + "Give a one line description of the group mode commands." + (interactive) + (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) + + (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) 'gnus-method-history))) + ;; 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. + (gnus-server-to-method how))))) + (gnus-browse-foreign-server method)) + + (defun gnus-group-set-info (info &optional method-only-group part) + (let* ((entry (gnus-gethash + (or method-only-group (gnus-info-group info)) + gnus-newsrc-hashtb)) + (part-info info) + (info (if method-only-group (nth 2 entry) info)) + method) + (when method-only-group + (unless entry + (error "Trying to change non-existent group %s" method-only-group)) + ;; We have received 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))) + (when (< len total) + (setcdr (nthcdr (1- len) info) + (make-list (- total len) nil))) + ;; Then we enter the new info. + (setcar (nthcdr (1- total) info) part-info))) + (unless entry + ;; This is a new group, so we just create it. + (save-excursion + (set-buffer gnus-group-buffer) + (setq method (gnus-info-method info)) + (when (gnus-server-equal method "native") + (setq method nil)) + (save-excursion + (set-buffer gnus-group-buffer) + (if method + ;; It's a foreign group... + (gnus-group-make-group + (gnus-group-real-name (gnus-info-group info)) + (if (stringp method) method + (prin1-to-string (car method))) + (and (consp method) + (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)))) + ;; Whether it was a new group or not, we now have the entry, so we + ;; can do the update. + (if entry + (progn + (setcar (nthcdr 2 entry) info) + (when (and (not (eq (car entry) t)) + (gnus-active (gnus-info-group info))) + (setcar entry (length (gnus-list-of-unread-articles (car info)))))) + (error "No such group: %s" (gnus-info-group info))))) + + (defun gnus-group-set-method-info (group select-method) + (gnus-group-set-info select-method group 'method)) + + (defun gnus-group-set-params-info (group params) + (gnus-group-set-info params group 'params)) + + (provide 'gnus-group) + + ;;; gnus-group.el ends here *** pub/rgnus/lisp/gnus-int.el Tue Jul 30 22:59:17 1996 --- rgnus/lisp/gnus-int.el Tue Jul 30 22:08:06 1996 *************** *** 0 **** --- 1,405 ---- + ;;; gnus-int.el --- backend inteface functions for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus) + + (defvar gnus-open-server-hook nil + "*A hook called just before opening connection to the news server.") + + ;;; + ;;; Server Communication + ;;; + + (defun gnus-start-news-server (&optional confirm) + "Open a method for getting news. + If CONFIRM is non-nil, the user will be asked for an NNTP server." + (let (how) + (if gnus-current-select-method + ;; Stream is already opened. + nil + ;; Open NNTP server. + (if (null gnus-nntp-service) (setq gnus-nntp-server nil)) + (if confirm + (progn + ;; Read server name with completion. + (setq gnus-nntp-server + (completing-read "NNTP server: " + (mapcar (lambda (server) (list server)) + (cons (list gnus-nntp-server) + 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 + (cond ((or (string= gnus-nntp-server "") + (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 + gnus-nntp-server 1))))) + (list 'nnmh-get-new-mail nil))) + (t + (list 'nntp gnus-nntp-server))))) + + (setq how (car gnus-select-method)) + (cond ((eq how 'nnspool) + (require 'nnspool) + (gnus-message 5 "Looking up local news spool...")) + ((eq how 'nnmh) + (require 'nnmh) + (gnus-message 5 "Looking up mh spool...")) + (t + (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 (%s) open error: '%s'. Continue? " + (car gnus-select-method) (cadr gnus-select-method) + (gnus-status-message gnus-select-method))) + (gnus-error 1 "Couldn't open server on %s" + (nth 1 gnus-select-method)))))) + + (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 silent) + "Check whether the connection to METHOD is down. + If METHOD is nil, use `gnus-select-method'. + If it is down, start it up (again)." + (let ((method (or method gnus-select-method))) + ;; Transform virtual server names into select methods. + (when (stringp method) + (setq method (gnus-server-to-method method))) + (if (gnus-server-opened method) + ;; The stream is already opened. + t + ;; Open the server. + (unless silent + (gnus-message 5 "Opening %s server%s..." (car method) + (if (equal (nth 1 method) "") "" + (format " on %s" (nth 1 method))))) + (run-hooks 'gnus-open-server-hook) + (prog1 + (gnus-open-server method) + (unless silent + (message "")))))) + + (defun gnus-get-function (method function &optional noerror) + "Return a function symbol based on METHOD and FUNCTION." + ;; Translate server names into methods. + (unless method + (error "Attempted use of a nil select method")) + (when (stringp method) + (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)) + (when (and (not (fboundp func)) + (not noerror)) + ;; This backend doesn't implement this function. + (error "No such function: %s" func))) + func)) + + + ;;; + ;;; Interface functions to the backends. + ;;; + + (defun gnus-open-server (method) + "Open a connection to METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (let ((elem (assoc method gnus-opened-servers))) + ;; If this method was previously denied, we just return nil. + (if (eq (nth 1 elem) 'denied) + (progn + (gnus-message 1 "Denied server") + nil) + ;; Open the server. + (let ((result + (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. + (setcar (cdr elem) (if result 'ok 'denied)) + ;; Return the result from the "open" call. + result)))) + + (defun gnus-close-server (method) + "Close the connection to METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'close-server) (nth 1 method))) + + (defun gnus-request-list (method) + "Request the active file from METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'request-list) (nth 1 method))) + + (defun gnus-request-list-newsgroups (method) + "Request the newsgroups file from METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) + + (defun gnus-request-newgroups (date method) + "Request all new groups since DATE from METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'request-newgroups) + date (nth 1 method))) + + (defun gnus-server-opened (method) + "Check whether a connection to METHOD has been opened." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'server-opened) (nth 1 method))) + + (defun gnus-status-message (method) + "Return the status message from METHOD. + If METHOD is a string, it is interpreted as a group name. The method + this group uses will be queried." + (let ((method (if (stringp method) (gnus-find-method-for-group method) + 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)))) + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'request-group) + (gnus-group-real-name group) (nth 1 method) dont-check))) + + (defun gnus-list-active-group (group) + "Request active information on GROUP." + (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) + "Request a description of GROUP." + (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) + "Request headers for ARTICLES in GROUP. + If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." + (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)))) + + (defun gnus-retrieve-groups (groups method) + "Request active information on GROUPS from METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) + + (defun gnus-request-type (group &optional article) + "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-type (car method))) + 'unknown + (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 mark)))) + + (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)) + (head (gnus-get-function method 'request-head t))) + (if (fboundp head) + (funcall head article (gnus-group-real-name group) (nth 1 method)) + (let ((res (gnus-request-article article group))) + (when res + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (delete-region (1- (point)) (point-max))) + (nnheader-fold-continuation-lines))) + res)))) + + (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) + "Post the current buffer using METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) + (funcall (gnus-get-function method 'request-post) (nth 1 method))) + + (defun gnus-request-scan (group method) + "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 (stringp method) + (setq method (gnus-server-to-method method))) + (when (gnus-check-backend-function 'request-update-info (car method)) + (funcall (gnus-get-function method 'request-update-info) + (gnus-group-real-name (gnus-info-group info)) + 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 method &optional last) + ;; Make sure there's a newline at the end of the article. + (when (stringp method) + (setq method (gnus-server-to-method method))) + (when (and (not method) + (stringp group)) + (setq method (gnus-group-name-to-method group))) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (let ((func (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) + (cadr method) + last))) + + (defun gnus-request-replace-article (article group buffer) + (let ((func (car (gnus-find-method-for-group group)))) + (funcall (intern (format "%s-request-replace-article" func)) + article (gnus-group-real-name group) buffer))) + + (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) + (when (stringp method) + (setq method (gnus-server-to-method method))) + (let ((method (or method (gnus-find-method-for-group group)))) + (funcall (gnus-get-function method 'request-create-group) + (gnus-group-real-name group) (nth 1 method)))) + + (defun gnus-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-close-backends () + ;; Send a close request to all backends that support such a request. + (let ((methods gnus-valid-select-methods) + func) + (while methods + (if (fboundp (setq func (intern (concat (caar methods) + "-request-close")))) + (funcall func)) + (setq methods (cdr methods))))) + + (defun gnus-asynchronous-p (method) + (let ((func (gnus-get-function method 'asynchronous-p t))) + (when (fboundp func) + (funcall func)))) + + (provide 'gnus-int) + + ;;; gnus-int.el ends here *** pub/rgnus/lisp/gnus-kill.el Tue May 21 19:40:13 1996 --- rgnus/lisp/gnus-kill.el Sun Jul 28 20:31:00 1996 *************** *** 26,33 **** ;;; Code: ! (require 'gnus) ! (eval-when-compile (require 'cl)) (defvar gnus-kill-file-mode-hook nil "*A hook for Gnus kill file mode.") --- 26,34 ---- ;;; Code: ! (require 'gnus-load) ! (require 'gnus-art) ! (require 'gnus-range) (defvar gnus-kill-file-mode-hook nil "*A hook for Gnus kill file mode.") *************** *** 40,45 **** --- 41,52 ---- (defvar gnus-winconf-kill-file nil) + (defvar gnus-kill-killed t + "*If non-nil, Gnus will apply kill files to already killed articles. + If it is nil, Gnus will never apply kill files to articles that have + already been through the scoring process, which might very well save lots + of time.") + (defmacro gnus-raise (field expression level) *************** *** 145,151 **** If NEWSGROUP is nil, the global kill file is selected." (interactive "sNewsgroup: ") (let ((file (gnus-newsgroup-kill-file newsgroup))) ! (gnus-make-directory (file-name-directory file)) ;; Save current window configuration if this is first invocation. (or (and (get-file-buffer file) (get-buffer-window (get-file-buffer file))) --- 152,158 ---- If NEWSGROUP is nil, the global kill file is selected." (interactive "sNewsgroup: ") (let ((file (gnus-newsgroup-kill-file newsgroup))) ! (make-directory (file-name-directory file) t) ;; Save current window configuration if this is first invocation. (or (and (get-file-buffer file) (get-buffer-window (get-file-buffer file))) *************** *** 649,654 **** --- 656,708 ---- (setq killed-no (1+ killed-no)))) ;; Return the number of killed articles. killed-no))) + + ;;;###autoload + (defalias 'gnus-batch-kill 'gnus-batch-score) + ;;;###autoload + (defun gnus-batch-score () + "Run batched scoring. + Usage: emacs -batch -l gnus -f gnus-batch-score ... + Newsgroups is a list of strings in Bnews format. If you want to score + the comp hierarchy, you'd say \"comp.all\". If you would not like to + score the alt hierarchy, you'd say \"!alt.all\"." + (interactive) + (let* ((yes-and-no + (gnus-newsrc-parse-options + (apply (function concat) + (mapcar (lambda (g) (concat g " ")) + command-line-args-left)))) + (gnus-expert-user t) + (nnmail-spool-file nil) + (gnus-use-dribble-file nil) + (yes (car yes-and-no)) + (no (cdr yes-and-no)) + group newsrc entry + ;; Disable verbose message. + gnus-novice-user gnus-large-newsgroup) + ;; Eat all arguments. + (setq command-line-args-left nil) + ;; Start Gnus. + (gnus) + ;; Apply kills to specified newsgroups in command line arguments. + (setq newsrc (cdr gnus-newsrc-alist)) + (while newsrc + (setq group (caar newsrc)) + (setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) + (and (car entry) + (or (eq (car entry) t) + (not (zerop (car entry))))) + (if yes (string-match yes group) t) + (or (null no) (not (string-match no group)))) + (progn + (gnus-summary-read-group group nil t nil t) + (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) + (gnus-summary-exit)))) + (setq newsrc (cdr newsrc))) + ;; Exit Emacs. + (switch-to-buffer gnus-group-buffer) + (gnus-group-save-newsrc))) (provide 'gnus-kill) *** pub/rgnus/lisp/gnus-load.el Tue Jul 30 22:59:17 1996 --- rgnus/lisp/gnus-load.el Tue Jul 30 22:08:06 1996 *************** *** 0 **** --- 1,695 ---- + ;;; gnus-load.el --- various Gnus variables + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-util) + (require 'nnheader) + + (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/") + "*Directory variable from which all other Gnus file variables are derived.") + + ;; Site dependent variables. These variables should be defined in + ;; paths.el. + + ;; Don't touch this variable. + (defvar gnus-nntp-service "nntp" + "*NNTP service name (\"nntp\" or 119). + This is an obsolete variable, which is scarcely used. If you use an + nntp server for your newsgroup and want to change the port number + used to 899, you would say something along these lines: + + (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") + + (defvar gnus-nntpserver-file "/etc/nntpserver" + "*A file with only the name of the nntp server in it.") + + ;; This function is used to check both the environment variable + ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find + ;; an nntp server name default. + (defun gnus-getenv-nntpserver () + (or (getenv "NNTPSERVER") + (and (file-readable-p gnus-nntpserver-file) + (save-excursion + (set-buffer (get-buffer-create " *gnus nntp*")) + (buffer-disable-undo (current-buffer)) + (insert-file-contents gnus-nntpserver-file) + (let ((name (buffer-string))) + (prog1 + (if (string-match "^[ \t\n]*$" name) + nil + name) + (kill-buffer (current-buffer)))))))) + + (defvar gnus-select-method + (nconc + (list 'nntp (or (condition-case () + (gnus-getenv-nntpserver) + (error nil)) + (if (and gnus-default-nntp-server + (not (string= gnus-default-nntp-server ""))) + gnus-default-nntp-server) + (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: + + (setq gnus-select-method '(nntp \"flab.flab.edu\")) + + If you want to use your local spool, say: + + (setq gnus-select-method (list 'nnspool (system-name))) + + If you use this variable, you must set `gnus-nntp-server' to nil. + + 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 ,(nnheader-concat message-directory "archive")) + (nnfolder-active-file + ,(nnheader-concat message-directory "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. + + It's probably not a very effective to change this variable once you've + run Gnus once. After doing that, you must edit this server from the + server buffer.") + + (defvar gnus-message-archive-group nil + "*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. + + If you want to save your mail in one group and the news articles you + write in another group, you could say something like: + + \(setq gnus-message-archive-group + '((if (message-news-p) + \"misc-news\" + \"misc-mail\"))) + + Normally the group names returned by this variable should be + unprefixed -- which implictly means \"store on the archive server\". + However, you may wish to store the message on some other server. In + that case, just return a fully prefixed name of the group -- + \"nnml+private:mail.misc\", for instance.") + + (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: + + (setq gnus-secondary-select-methods '((nnml \"\")))") + + (defvar gnus-default-nntp-server nil + "Specify a default NNTP server. + This variable should be defined in paths.el, and should never be set + by the user. + 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.") + + (defvar gnus-local-domain nil + "Local domain name without a host name. + The DOMAINNAME environment variable is used instead if it is defined. + If the `system-name' function returns the full Internet name, there is + no need to set this variable.") + + (defvar gnus-local-organization nil + "String with a description of what organization (if any) the user belongs to. + The ORGANIZATION environment variable is used instead if it is defined. + If this variable contains a function, this function will be called + with the current newsgroup name as the argument. The function should + return a string. + + In any case, if the string (either in the variable, in the environment + variable, or returned by the function) is a file name, the contents of + this file will be used as the organization.") + + ;; Customization variables + + (defvar gnus-refer-article-method nil + "*Preferred method for fetching an article by Message-ID. + If you are reading news from the local spool (with nnspool), fetching + articles by Message-ID is painfully slow. By setting this method to an + nntp method, you might get acceptable results. + + The value of this variable must be a valid select method as discussed + in the documentation of `gnus-select-method'.") + + (defvar gnus-group-faq-directory + '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" + "/ftp@sunsite.auc.dk:/pub/usenet/" + "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" + "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" + "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" + "/ftp@rtfm.mit.edu:/pub/usenet/" + "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" + "/ftp@ftp.sunet.se:/pub/usenet/" + "/ftp@nctuccca.edu.tw:/USENET/FAQ/" + "/ftp@hwarang.postech.ac.kr:/pub/usenet/" + "/ftp@ftp.hk.super.net:/mirror/faqs/") + "*Directory where the group FAQs are stored. + This will most commonly be on a remote machine, and the file will be + fetched by ange-ftp. + + This variable can also be a list of directories. In that case, the + first element in the list will be used by default. The others can + be used when being prompted for a site. + + Note that Gnus uses an aol machine as the default directory. If this + feels fundamentally unclean, just think of it as a way to finally get + something of value back from them. + + 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 + Europe: ftp.uni-paderborn.de /pub/FAQ + src.doc.ic.ac.uk /usenet/news-FAQS + ftp.sunet.se /pub/usenet + sunsite.auc.dk /pub/usenet + Asia: nctuccca.edu.tw /USENET/FAQ + hwarang.postech.ac.kr /pub/usenet + ftp.hk.super.net /mirror/faqs") + + (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-process-mark ?# + "*Process mark.") + + (defvar gnus-asynchronous nil + "*If non-nil, Gnus will supply backends with data needed for async article fetching.") + + (defvar gnus-large-newsgroup 200 + "*The number of articles which indicates a large newsgroup. + If the number of articles in a newsgroup is greater than this value, + confirmation is required for selecting the newsgroup.") + + (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) + "*Non-nil means that the default name of a file to save articles in is the group name. + If it's nil, the directory form of the group name is used instead. + + If this variable is a list, and the list contains the element + `not-score', long file names will not be used for score files; if it + contains the element `not-save', long file names will not be used for + saving; and if it contains the element `not-kill', long file names + will not be used for kill files. + + Note that the default for this variable varies according to what system + type you're using. On `usg-unix-v' and `xenix' this variable defaults + to nil while on all other systems it defaults to t.") + + (defvar gnus-kill-files-directory gnus-directory + "*Name of the directory where kill files will be stored (default \"~/News\").") + + (defvar gnus-save-score nil + "*If non-nil, save group scoring info.") + + (defvar gnus-use-adaptive-scoring nil + "*If non-nil, use some adaptive scoring scheme.") + + (defvar gnus-use-cache 'passive + "*If nil, Gnus will ignore the article cache. + If `passive', it will allow entering (and reading) articles + 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-use-grouplens nil + "*If non-nil, use GroupLens ratings.") + + (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 + read. If it is neither nil nor a number, Gnus will keep all read + articles. This is not a good idea.") + + (defvar gnus-use-nocem nil + "*If non-nil, Gnus will read NoCeM cancel messages.") + + (defvar gnus-use-demon nil + "If non-nil, Gnus might use some demons.") + + (defvar gnus-use-scoring t + "*If non-nil, enable scoring.") + + (defvar gnus-use-picons nil + "*If non-nil, display picons.") + + (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-novice-user t + "*Non-nil means that you are a usenet novice. + If non-nil, verbose messages may be displayed and confirmations may be + required.") + + (defvar gnus-expert-user nil + "*Non-nil means that you will never be asked for confirmation about anything. + And that means *anything*.") + + (defvar gnus-interactive-catchup t + "*If non-nil, require your confirmation when catching up a group.") + + (defvar gnus-interactive-exit t + "*If non-nil, require your confirmation when exiting Gnus.") + + (defvar gnus-extract-address-components 'gnus-extract-address-components + "*Function for extracting address components from a From header. + Two pre-defined function exist: `gnus-extract-address-components', + which is the default, quite fast, and too simplistic solution, and + `mail-extract-address-components', which works much better, but is + slower.") + + (defvar gnus-carpal nil + "*If non-nil, display clickable icons.") + + (defvar gnus-shell-command-separator ";" + "String used to separate to shell commands.") + + (defvar gnus-valid-select-methods + '(("nntp" post address prompt-address) + ("nnspool" post address) + ("nnvirtual" post-mail virtual prompt-address) + ("nnmbox" mail respool address) + ("nnml" mail respool address) + ("nnmh" mail respool address) + ("nndir" post-mail prompt-address address) + ("nneething" none address prompt-address) + ("nndoc" none address prompt-address) + ("nnbabyl" mail address respool) + ("nnkiboze" post virtual) + ("nnsoup" post-mail address) + ("nndraft" post-mail) + ("nnfolder" mail respool address)) + "An alist of valid select methods. + The first element of each list lists should be a string with the name + of the select method. The other elements may be the category of + 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 . + (defvar gnus-mode-non-string-length nil + "*Max length of mode-line non-string contents. + If this is nil, Gnus will take space as is needed, leaving the rest + of the modeline intact.") + + (defvar gnus-auto-expirable-newsgroups nil + "*Groups in which to automatically mark read articles as expirable. + If non-nil, this should be a regexp that should match all groups in + which to perform auto-expiry. This only makes sense for mail groups.") + + (defvar gnus-total-expirable-newsgroups nil + "*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-group-uncollapsed-levels 1 + "Number of group name elements to leave alone when making a short group name.") + + ;; Hooks. + + (defvar gnus-load-hook nil + "*A hook run while Gnus is loaded.") + + (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) + "*A hook called to apply kill files to a group. + This hook is intended to apply a kill file to the selected newsgroup. + The function `gnus-apply-kill-file' is called by default. + + Since a general kill file is too heavy to use only for a few + newsgroups, I recommend you to use a lighter hook function. For + example, if you'd like to apply a kill file to articles which contains + a string `rmgroup' in subject in newsgroup `control', you can use the + following hook: + + (setq gnus-apply-kill-hook + (list + (lambda () + (cond ((string-match \"control\" gnus-newsgroup-name) + (gnus-kill \"Subject\" \"rmgroup\") + (gnus-expunge \"X\"))))))") + + (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.") + + + ;;; Internal variables + + (defvar gnus-newsgroup-name nil) + + (defvar gnus-current-select-method nil + "The current method for selecting a newsgroup.") + + (defvar gnus-tree-buffer "*Tree*" + "Buffer where Gnus thread trees are displayed.") + + ;; Dummy variable. + (defvar gnus-use-generic-from nil) + + ;; Variable holding the user answers to all method prompts. + (defvar gnus-method-history nil) + + ;; Variable holding the user answers to all group prompts. + (defvar gnus-group-history nil) + + (defvar gnus-server-alist nil + "List of available servers.") + + (defvar gnus-topic-indentation "") ;; Obsolete variable. + + (defconst gnus-article-mark-lists + '((marked . tick) (replied . reply) + (expirable . expire) (killed . killed) + (bookmarks . bookmark) (dormant . dormant) + (scored . score) (saved . save) + (cached . cache))) + + (defvar gnus-headers-retrieved-by nil) + (defvar gnus-article-reply nil) + (defvar gnus-override-method nil) + (defvar gnus-article-check-size nil) + (defvar gnus-opened-servers nil) + + (defvar gnus-current-kill-article nil) + + (defvar gnus-have-read-active-file nil) + + (defconst gnus-maintainer + "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" + "The mail address of the Gnus maintainers.") + + (defvar gnus-info-nodes + '((gnus-group-mode "(gnus)The Group Buffer") + (gnus-summary-mode "(gnus)The Summary Buffer") + (gnus-article-mode "(gnus)The Article Buffer") + (gnus-server-mode "(gnus)The Server Buffer") + (gnus-browse-mode "(gnus)Browse Foreign Server") + (gnus-tree-mode "(gnus)Tree Display")) + "Alist of major modes and related Info nodes.") + + (defvar gnus-group-buffer "*Group*") + (defvar gnus-summary-buffer "*Summary*") + (defvar gnus-article-buffer "*Article*") + (defvar gnus-server-buffer "*Server*") + + (defvar gnus-buffer-list nil + "Gnus buffers that should be killed on exit.") + + (defvar gnus-slave nil + "Whether this Gnus is a slave or not.") + + (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 + gnus-format-specs) + "Gnus variables saved in the quick startup file.") + + (defvar gnus-newsrc-alist nil + "Assoc list of read articles. + gnus-newsrc-hashtb should be kept so that both hold the same information.") + + (defvar gnus-newsrc-hashtb nil + "Hashtable of gnus-newsrc-alist.") + + (defvar gnus-killed-list nil + "List of killed newsgroups.") + + (defvar gnus-killed-hashtb nil + "Hash table equivalent of gnus-killed-list.") + + (defvar gnus-zombie-list nil + "List of almost dead newsgroups.") + + (defvar gnus-description-hashtb nil + "Descriptions of newsgroups.") + + (defvar gnus-list-of-killed-groups nil + "List of newsgroups that have recently been killed by the user.") + + (defvar gnus-active-hashtb nil + "Hashtable of active articles.") + + (defvar gnus-moderated-list nil + "List of moderated newsgroups.") + + ;; Save window configuration. + (defvar gnus-prev-winconf nil) + + (defvar gnus-reffed-article-number nil) + + ;;; Let the byte-compiler know that we know about this variable. + (defvar rmail-default-rmail-file) + + (defvar gnus-dead-summary nil) + + ;;; End of variables. + + ;; Define some autoload functions Gnus might use. + (eval-and-compile + + ;; 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) + (setq keymap (car (memq 'keymap function))) + (setq function (car function))) + (autoload function (car package) nil interactive keymap))) + (if (eq (nth 1 package) ':interactive) + (cdddr package) + (cdr package))))) + '(("metamail" metamail-buffer) + ("info" Info-goto-node) + ("hexl" hexl-hex-string-to-integer) + ("pp" pp pp-to-string pp-eval-expression) + ("mail-extr" mail-extract-address-components) + ("nnmail" nnmail-split-fancy nnmail-article-group) + ("nnvirtual" nnvirtual-catchup-group) + ("timezone" timezone-make-date-arpa-standard timezone-fix-time + timezone-make-sortable-date timezone-make-time-string) + ("rmailout" rmail-output) + ("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) + ("score-mode" :interactive t gnus-score-mode) + ("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 + gnus-server-make-menu-bar gnus-article-make-menu-bar + gnus-browse-make-menu-bar gnus-highlight-selected-summary + gnus-summary-highlight-line gnus-carpal-setup-buffer + gnus-group-highlight-line + 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-nocem-unwanted-article-p) + ("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-article-hide-citation-in-followups) + ("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 + gnus-cache-retrieve-headers gnus-cache-possibly-alter-active + gnus-cache-enter-remove-article gnus-cached-article-p + gnus-cache-open gnus-cache-close gnus-cache-update-article) + ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article + 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-summary-raise-score + gnus-summary-set-score gnus-summary-current-score) + ("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-binary-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-buffer + 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-article-mail gnus-new-mail gnus-mail-reply + gnus-copy-article-buffer gnus-extended-version) + ("gnus-msg" :interactive t + gnus-group-post-news gnus-group-mail gnus-summary-post-news + gnus-summary-followup gnus-summary-followup-with-original + gnus-summary-cancel-article gnus-summary-supersede-article + gnus-post-news gnus-inews-news + gnus-summary-reply gnus-summary-reply-with-original + gnus-summary-mail-forward gnus-summary-mail-other-window + gnus-bug) + ("gnus-picon" :interactive t gnus-article-display-picons + gnus-group-display-picons gnus-picons-article-display-x-face + gnus-picons-display-x-face) + ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p + gnus-grouplens-mode) + ("smiley" :interactive t gnus-smiley-display) + ("gnus" gnus-add-current-to-buffer-list gnus-add-shutdown) + ("gnus-win" gnus-configure-windows) + ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group + gnus-list-of-unread-articles gnus-list-of-read-articles + gnus-offer-save-summaries gnus-make-thread-indent-array + gnus-summary-exit) + ("gnus-group" gnus-group-insert-group-line gnus-group-quit + gnus-group-list-groups gnus-group-first-unread-group + gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc + gnus-group-setup-buffer gnus-group-get-new-news) + ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article + gnus-backlog-remove-article) + ("gnus-art" gnus-article-read-summary-keys gnus-article-save + gnus-article-prepare gnus-article-set-window-start + gnus-article-show-all-headers gnus-article-next-page + gnus-article-prev-page gnus-request-article-this-buffer + gnus-article-mode gnus-article-setup-buffer gnus-narrow-to-page) + ("gnus-art" :interactive t + gnus-article-hide-headers gnus-article-hide-boring-headers + gnus-article-treat-overstrike gnus-article-word-wrap + gnus-article-remove-cr gnus-article-remove-trailing-blank-lines + gnus-article-display-x-face gnus-article-de-quoted-unreadable + gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp + gnus-article-hide-pem gnus-article-hide-signature + gnus-article-strip-leading-blank-lines gnus-article-date-local + gnus-article-date-original gnus-article-date-lapsed + gnus-decode-rfc1522 gnus-article-show-all-headers) + ("gnus-start" gnus-newsrc-parse-options gnus-1) + ("gnus-range" gnus-copy-sequence) + ("gnus-vm" gnus-vm-mail-setup) + ("gnus-logic" gnus-score-advanced) + ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next + gnus-async-prefetch-article) + ("gnus-vm" :interactive t gnus-summary-save-in-vm + gnus-summary-save-article-vm)))) + + (defalias 'gnus-make-overlay 'make-overlay) + (defalias 'gnus-overlay-put 'overlay-put) + (defalias 'gnus-move-overlay 'move-overlay) + (defalias 'gnus-overlay-end 'overlay-end) + (defalias 'gnus-extent-detached-p 'ignore) + (defalias 'gnus-extent-start-open 'ignore) + (defalias 'gnus-set-text-properties 'set-text-properties) + (defalias 'gnus-group-remove-excess-properties 'ignore) + (defalias 'gnus-topic-remove-excess-properties 'ignore) + (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) + (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) + (defalias 'gnus-make-local-hook 'make-local-hook) + (defalias 'gnus-add-hook 'add-hook) + (defalias 'gnus-character-to-event 'identity) + (defalias 'gnus-add-text-properties 'add-text-properties) + (defalias 'gnus-put-text-property 'put-text-property) + (defalias 'gnus-mode-line-buffer-identification 'identity) + + (provide 'gnus-load) + + ;;; gnus-load.el ends here *** pub/rgnus/lisp/gnus-logic.el Tue Jul 30 22:59:17 1996 --- rgnus/lisp/gnus-logic.el Tue Jul 30 21:50:09 1996 *************** *** 0 **** --- 1,224 ---- + ;;; gnus-logic.el --- advanced scoring code for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-score) + ;(require 'parse-time) + (require 'gnus-util) + + ;;; Internal variables. + + (defvar gnus-advanced-headers nil) + + ;; To avoid having 8-bit charaters in the source file. + (defvar gnus-advanced-not (intern (format "%c" 172))) + + (defconst gnus-advanced-index + ;; Name to index alist. + '(("number" 0 gnus-advanced-integer) + ("subject" 1 gnus-advanced-string) + ("from" 2 gnus-advanced-string) + ("date" 3 gnus-advanced-date) + ("message-id" 4 gnus-advanced-string) + ("references" 5 gnus-advanced-string) + ("chars" 6 gnus-advanced-integer) + ("lines" 7 gnus-advanced-integer) + ("xref" 8 gnus-advanced-string) + ("head" nil gnus-advanced-body) + ("body" nil gnus-advanced-body) + ("all" nil gnus-advanced-body))) + + (defun gnus-score-advanced (rule &optional trace) + "Apply advanced scoring RULE to all the articles in the current group." + (let ((headers gnus-newsgroup-headers) + gnus-advanced-headers score) + (while (setq gnus-advanced-headers (pop headers)) + (when (gnus-advanced-score-rule (car rule)) + ;; This rule was successful, so we add the score to + ;; this article. + (if (setq score (assq (mail-header-number gnus-advanced-headers) + gnus-newsgroup-scored)) + (setcdr score + (+ (cdr score) + (or (nth 1 rule) + gnus-score-interactive-default-score))) + (push (cons (mail-header-number gnus-advanced-headers) + (or (nth 1 rule) + gnus-score-interactive-default-score)) + gnus-newsgroup-scored) + (when trace + (push (cons "A file" rule) + gnus-score-trace))))))) + + (defun gnus-advanced-score-rule (rule) + "Apply RULE to `gnus-advanced-headers'." + (let ((type (car rule))) + (cond + ;; "And" rule. + ((or (eq type '&) (eq type 'and)) + (pop rule) + (if (not rule) + t ; Empty rule is true. + (while (and rule + (gnus-advanced-score-rule (pop rule)))) + ;; If all the rules were true, then `rule' should be nil. + (not rule))) + ;; "Or" rule. + ((or (eq type '|) (eq type 'or)) + (pop rule) + (if (not rule) + nil + (while (and rule + (not (gnus-advanced-score-rule (car rule)))) + (pop rule)) + ;; If one of the rules returned true, then `rule' should be non-nil. + rule)) + ;; "Not" rule. + ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not)) + (not (gnus-advanced-score-rule (nth 1 rule)))) + ;; This is a `1-'-type redirection rule. + ((and (symbolp type) + (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) + (let ((gnus-advanced-headers + (gnus-parent-headers + gnus-advanced-headers + (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) + ;; 1- type redirection. + (string-to-number + (substring (symbol-name type) + (match-beginning 0) (match-end 0))) + ;; ^^^ type redirection. + (length (symbol-name type)))))) + (when gnus-advanced-headers + (gnus-advanced-score-rule (nth 1 rule))))) + ;; Plain scoring rule. + ((stringp type) + (gnus-advanced-score-article rule)) + ;; Bug-out time! + (t + (error "Unknown advanced score type: %s" rule))))) + + (defun gnus-advanced-score-article (rule) + ;; `rule' is a semi-normal score rule, so we find out + ;; what function that's supposed to do the actual + ;; processing. + (let* ((header (car rule)) + (func (assoc (downcase header) gnus-advanced-index))) + (if (not func) + (error "No such header: %s" rule) + ;; Call the score function. + (funcall (caddr func) (or (cadr func) header) + (cadr rule) (caddr rule))))) + + (defun gnus-advanced-string (index match type) + "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX." + (let* ((type (or type 's)) + (case-fold-search (not (eq (downcase (symbol-name type)) + (symbol-name type)))) + (header (aref gnus-advanced-headers index))) + (cond + ((memq type '(r R regexp Regexp)) + (string-match match header)) + ((memq type '(s S string String)) + (string-match (regexp-quote match) header)) + ((memq type '(e E exact Exact)) + (string= match header)) + ((memq type '(f F fuzzy Fuzzy)) + (string-match (regexp-quote (gnus-simplify-subject-fuzzy match)) + header)) + (t + (error "No such string match type: %s" type))))) + + (defun gnus-advanced-integer (index match type) + (if (not (memq type '(< > <= >= =))) + (error "No such integer score type: %s" type) + (funcall type match (or (aref gnus-advanced-headers index) 0)))) + + (defun gnus-advanced-date (index match type) + (let ((date (encode-time (parse-time-string + (aref gnus-advanced-headers index)))) + (match (encode-time (parse-time-string match)))) + (cond + ((eq type 'at) + (equal date match)) + ((eq type 'before) + (gnus-time-less match date)) + ((eq type 'after) + (gnus-time-less date match)) + (t + (error "No such date score type: %s" type))))) + + (defun gnus-advanced-body (header match type) + (when (string= header "all") + (setq header "article")) + (save-excursion + (set-buffer nntp-server-buffer) + (let* ((request-func (cond ((string= "head" header) + 'gnus-request-head) + ((string= "body" header) + 'gnus-request-body) + (t 'gnus-request-article))) + ofunc article) + ;; Not all backends support partial fetching. In that case, + ;; we just fetch the entire article. + (unless (gnus-check-backend-function + (intern (concat "request-" header)) + gnus-newsgroup-name) + (setq ofunc request-func) + (setq request-func 'gnus-request-article)) + (setq article (mail-header-number gnus-advanced-headers)) + (gnus-message 7 "Scoring article %s..." article) + (when (funcall request-func article gnus-newsgroup-name) + (goto-char (point-min)) + ;; If just parts of the article is to be searched and the + ;; backend didn't support partial fetching, we just narrow + ;; to the relevant parts. + (if ofunc + (if (eq ofunc 'gnus-request-head) + (narrow-to-region + (point) + (or (search-forward "\n\n" nil t) (point-max))) + (narrow-to-region + (or (search-forward "\n\n" nil t) (point)) + (point-max)))) + (let* ((case-fold-search (not (eq (downcase (symbol-name type)) + (symbol-name type)))) + (search-func + (cond ((memq type '(r R regexp Regexp)) + 're-search-forward) + ((memq type '(s S string String)) + 'search-forward) + (t + (error "Illegal match type: %s" type))))) + (goto-char (point-min)) + (prog1 + (funcall search-func match nil t) + (widen))))))) + + (provide 'gnus-logic) + + ;;; gnus-logic.el ends here. *** pub/rgnus/lisp/gnus-mh.el Mon Jun 10 23:24:14 1996 --- rgnus/lisp/gnus-mh.el Sun Jul 28 14:34:51 1996 *************** *** 33,43 **** ;;; Code: (require 'mh-e) (require 'mh-comp) (require 'gnus) (require 'gnus-msg) ! (eval-when-compile (require 'cl)) (defun gnus-summary-save-article-folder (&optional arg) "Append the current article to an mh folder. --- 33,44 ---- ;;; Code: + (require 'gnus-load) (require 'mh-e) (require 'mh-comp) (require 'gnus) (require 'gnus-msg) ! (require 'gnus-sum) (defun gnus-summary-save-article-folder (&optional arg) "Append the current article to an mh folder. *** pub/rgnus/lisp/gnus-msg.el Fri Jun 28 23:22:39 1996 --- rgnus/lisp/gnus-msg.el Sun Jul 28 14:34:44 1996 *************** *** 26,35 **** ;;; Code: ! (require 'gnus) (require 'gnus-ems) (require 'message) ! (eval-when-compile (require 'cl)) ;; Added by Sudish Joseph . (defvar gnus-post-method nil --- 26,36 ---- ;;; Code: ! (require 'gnus-load) (require 'gnus-ems) (require 'message) ! (require 'gnus-art) ! (require 'gnus) ;; Added by Sudish Joseph . (defvar gnus-post-method nil *************** *** 73,78 **** --- 74,99 ---- (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) (defvar gnus-last-posting-server nil) + + (defconst gnus-bug-message + "Sending a bug report to the Gnus Towers. + ======================================== + + 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. + + Thank you for your help in stamping out bugs. + ") (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) *** pub/rgnus/lisp/gnus-nocem.el Fri Jun 28 00:50:07 1996 --- rgnus/lisp/gnus-nocem.el Sun Jul 28 19:39:57 1996 *************** *** 25,33 **** ;;; Code: ! (require 'gnus) (require 'nnmail) ! (eval-when-compile (require 'cl)) (defvar gnus-nocem-groups '("alt.nocem.misc" "news.admin.net-abuse.announce") --- 25,34 ---- ;;; Code: ! (require 'gnus-load) (require 'nnmail) ! (require 'gnus-art) ! (require 'gnus-range) (defvar gnus-nocem-groups '("alt.nocem.misc" "news.admin.net-abuse.announce") *** pub/rgnus/lisp/gnus-picon.el Sun Jul 14 16:44:07 1996 --- rgnus/lisp/gnus-picon.el Sun Jul 28 13:49:04 1996 *************** *** 74,82 **** ;;; Code: (require 'xpm) (require 'annotations) - (eval-when-compile (require 'cl)) (defvar gnus-picons-buffer "*Icon Buffer*" "Buffer name to display the icons in if gnus-picons-display-where is 'picons.") --- 74,82 ---- ;;; Code: + (require 'gnus-load) (require 'xpm) (require 'annotations) (defvar gnus-picons-buffer "*Icon Buffer*" "Buffer name to display the icons in if gnus-picons-display-where is 'picons.") *** pub/rgnus/lisp/gnus-range.el Tue Jul 30 22:59:18 1996 --- rgnus/lisp/gnus-range.el Sun Jul 28 10:13:28 1996 *************** *** 0 **** --- 1,270 ---- + ;;; gnus-range.el --- range and sequence functions for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + ;;; List and range functions + + (defun gnus-last-element (list) + "Return last element of LIST." + (while (cdr list) + (setq list (cdr list))) + (car list)) + + (defun gnus-copy-sequence (list) + "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))) + elem)) + list))) + + (defun gnus-set-difference (list1 list2) + "Return a list of elements of LIST1 that do not appear in LIST2." + (let ((list1 (copy-sequence list1))) + (while list2 + (setq list1 (delq (car list2) list1)) + (setq list2 (cdr list2))) + list1)) + + (defun gnus-sorted-complement (list1 list2) + "Return a list of elements of LIST1 that do not appear in LIST2. + Both lists have to be sorted over <." + (let (out) + (if (or (null list1) (null list2)) + (or list1 list2) + (while (and list1 list2) + (cond ((= (car list1) (car list2)) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< (car list1) (car list2)) + (setq out (cons (car list1) out)) + (setq list1 (cdr list1))) + (t + (setq out (cons (car list2) out)) + (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) + (setq result (cons (car list2) result))) + (setq list2 (cdr list2))) + result)) + + (defun gnus-sorted-intersection (list1 list2) + ;; LIST1 and LIST2 have to be sorted over <. + (let (out) + (while (and list1 list2) + (cond ((= (car list1) (car list2)) + (setq out (cons (car list1) out) + list1 (cdr list1) + list2 (cdr list2))) + ((< (car list1) (car list2)) + (setq list1 (cdr list1))) + (t + (setq list2 (cdr list2))))) + (nreverse out))) + + (defun gnus-set-sorted-intersection (list1 list2) + ;; LIST1 and LIST2 have to be sorted over <. + ;; This function modifies LIST1. + (let* ((top (cons nil list1)) + (prev top)) + (while (and list1 list2) + (cond ((= (car list1) (car list2)) + (setq prev list1 + list1 (cdr list1) + list2 (cdr list2))) + ((< (car list1) (car list2)) + (setcdr prev (cdr list1)) + (setq list1 (cdr list1))) + (t + (setq list2 (cdr list2))))) + (setcdr prev nil) + (cdr top))) + + (defun gnus-compress-sequence (numbers &optional always-list) + "Convert list of numbers to a list of ranges or a single range. + If ALWAYS-LIST is non-nil, this function will always release a list of + ranges." + (let* ((first (car numbers)) + (last (car numbers)) + result) + (if (null numbers) + nil + (if (not (listp (cdr numbers))) + numbers + (while numbers + (cond ((= last (car numbers)) nil) ;Omit duplicated number + ((= (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)) + (setq last (car numbers)))) + (setq numbers (cdr numbers))) + (if (and (not always-list) (null result)) + (if (= first last) (list first) (cons first last)) + (nreverse (cons (if (= first last) first (cons first last)) + result))))))) + + (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) + (defun gnus-uncompress-range (ranges) + "Expand a list of ranges into a list of numbers. + 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))) + (setq first (car ranges)) + (setq last (cdr ranges)) + (while (<= first last) + (setq result (cons first result)) + (setq first (1+ first))) + (nreverse result)) + (t + (while ranges + (if (atom (car ranges)) + (if (numberp (car ranges)) + (setq result (cons (car ranges) result))) + (setq first (caar ranges)) + (setq last (cdar ranges)) + (while (<= first last) + (setq result (cons first result)) + (setq first (1+ first)))) + (setq ranges (cdr ranges))) + (nreverse result))))) + + (defun gnus-add-to-range (ranges list) + "Return a list of ranges that has all articles from both RANGES and LIST. + Note: LIST has to be sorted over `<'." + (if (not ranges) + (gnus-compress-sequence list t) + (setq list (copy-sequence list)) + (or (listp (cdr ranges)) + (setq ranges (list ranges))) + (let ((out ranges) + ilist lowest highest temp) + (while (and ranges list) + (setq ilist list) + (setq lowest (or (and (atom (car ranges)) (car ranges)) + (caar ranges))) + (while (and list (cdr list) (< (cadr list) lowest)) + (setq list (cdr list))) + (if (< (car ilist) lowest) + (progn + (setq temp list) + (setq list (cdr list)) + (setcdr temp nil) + (setq out (nconc (gnus-compress-sequence ilist t) out)))) + (setq highest (or (and (atom (car ranges)) (car ranges)) + (cdar ranges))) + (while (and list (<= (car list) highest)) + (setq list (cdr list))) + (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) + (while ranges + (if (atom (car ranges)) + (if (cdr ranges) + (if (atom (cadr ranges)) + (if (= (1+ (car ranges)) (cadr ranges)) + (progn + (setcar ranges (cons (car ranges) + (cadr ranges))) + (setcdr ranges (cddr ranges)))) + (if (= (1+ (car ranges)) (caadr ranges)) + (progn + (setcar (cadr ranges) (car ranges)) + (setcar ranges (cadr ranges)) + (setcdr ranges (cddr ranges)))))) + (if (cdr ranges) + (if (atom (cadr ranges)) + (if (= (1+ (cdar ranges)) (cadr ranges)) + (progn + (setcdr (car ranges) (cadr ranges)) + (setcdr ranges (cddr ranges)))) + (if (= (1+ (cdar ranges)) (caadr ranges)) + (progn + (setcdr (car ranges) (cdadr ranges)) + (setcdr ranges (cddr ranges))))))) + (setq ranges (cdr ranges))) + out))) + + (defun gnus-remove-from-range (ranges list) + "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 (caar ranges))) + not-stop) + (if (if (numberp (car ranges)) + (= number (car ranges)) + (and (>= number (caar ranges)) + (<= number (cdar ranges)))) + (setq not-stop nil)) + (setq ranges (cdr ranges))) + (not not-stop)))) + + (defun gnus-range-length (range) + "Return the length RANGE would have if uncompressed." + (length (gnus-uncompress-range range))) + + (defun gnus-sublist-p (list sublist) + "Test whether all elements in SUBLIST are members of LIST." + (let ((sublistp t)) + (while sublist + (unless (memq (pop sublist) list) + (setq sublistp nil + sublist nil))) + sublistp)) + + (provide 'gnus-range) + + ;;; gnus-range.el ends here *** pub/rgnus/lisp/gnus-salt.el Thu Jun 20 15:27:27 1996 --- rgnus/lisp/gnus-salt.el Sun Jul 28 14:34:43 1996 *************** *** 24,31 **** ;;; Code: ! (require 'gnus) ! (eval-when-compile (require 'cl)) ;;; ;;; gnus-pick-mode --- 24,31 ---- ;;; Code: ! (require 'gnus-load) ! (require 'gnus-sum) ;;; ;;; gnus-pick-mode *** pub/rgnus/lisp/gnus-score.el Wed Jul 17 23:56:52 1996 --- rgnus/lisp/gnus-score.el Mon Jul 29 12:43:29 1996 *************** *** 26,33 **** ;;; Code: ! (require 'gnus) ! (eval-when-compile (require 'cl)) (defvar gnus-global-score-files nil "*List of global score files and directories. --- 26,34 ---- ;;; Code: ! (require 'gnus-load) ! (require 'gnus-sum) ! (require 'gnus-range) (defvar gnus-global-score-files nil "*List of global score files and directories. *************** *** 190,195 **** --- 191,197 ---- ;; Internal variables. + (defvar gnus-scores-exclude-files nil) (defvar gnus-internal-global-score-files nil) (defvar gnus-score-file-list nil) *************** *** 243,262 **** ;;; Summary mode score maps. ! (gnus-define-keys ! (gnus-summary-score-map "V" gnus-summary-mode-map) ! "s" gnus-summary-set-score ! "a" gnus-summary-score-entry ! "S" gnus-summary-current-score ! "c" gnus-score-change-score-file ! "m" gnus-score-set-mark-below ! "x" gnus-score-set-expunge-below ! "R" gnus-summary-rescore ! "e" gnus-score-edit-current-scores ! "f" gnus-score-edit-file ! "F" gnus-score-flush-cache ! "t" gnus-score-find-trace ! "C" gnus-score-customize) ;; Summary score file commands --- 245,263 ---- ;;; Summary mode score maps. ! (gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map) ! "s" gnus-summary-set-score ! "a" gnus-summary-score-entry ! "S" gnus-summary-current-score ! "c" gnus-score-change-score-file ! "m" gnus-score-set-mark-below ! "x" gnus-score-set-expunge-below ! "R" gnus-summary-rescore ! "e" gnus-score-edit-current-scores ! "f" gnus-score-edit-file ! "F" gnus-score-flush-cache ! "t" gnus-score-find-trace ! "C" gnus-score-customize) ;; Summary score file commands *************** *** 810,816 **** (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) --- 811,817 ---- (interactive (list gnus-current-score-file)) (let ((winconf (current-window-configuration))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) ! (make-directory (file-name-directory file) t) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) *************** *** 825,831 **** "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)) --- 826,832 ---- "Edit a score file." (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) ! (make-directory (file-name-directory file) t) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) (let ((winconf (current-window-configuration))) (setq gnus-score-edit-buffer (find-file-noselect file)) *************** *** 1090,1096 **** ;; This is a normal score file, so we print it very ;; prettily. (pp score (current-buffer)))) ! (if (not (gnus-make-directory (file-name-directory file))) () ;; If the score file is empty, we delete it. (if (zerop (buffer-size)) --- 1091,1097 ---- ;; This is a normal score file, so we print it very ;; prettily. (pp score (current-buffer)))) ! (if (not (make-directory (file-name-directory file) t)) () ;; If the score file is empty, we delete it. (if (zerop (buffer-size)) *************** *** 1125,1131 **** ;; Prune the score files that are to be excluded, if any. (when gnus-scores-exclude-files (let ((s scores) ! c) (while s (and (setq c (rassq (car s) gnus-score-cache)) (member (car c) gnus-scores-exclude-files) --- 1126,1132 ---- ;; Prune the score files that are to be excluded, if any. (when gnus-scores-exclude-files (let ((s scores) ! c type) (while s (and (setq c (rassq (car s) gnus-score-cache)) (member (car c) gnus-scores-exclude-files) *************** *** 1193,1198 **** --- 1194,1206 ---- gnus-newsgroup-scored))) (setq gnus-scores-articles (cdr gnus-scores-articles))) + (let (score) + (while (setq score (pop scores)) + (while score + (when (listp (caar score)) + (gnus-score-advanced (car score) trace)) + (pop score)))) + (gnus-message 5 "Scoring...done")))))) *************** *** 1294,1311 **** ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles ! (and (funcall match-func (or (aref (caar articles) gnus-score-index) 0) match) ! (progn ! (and trace (setq gnus-score-trace ! (cons ! (cons ! (car-safe (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace))) ! (setq found t) ! (setcdr (car articles) (+ score (cdar articles))))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. --- 1302,1315 ---- ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles ! (when (funcall match-func (or (aref (caar articles) gnus-score-index) 0) match) ! (when trace ! (push (cons (car-safe (rassq alist gnus-score-cache)) kill) ! gnus-score-trace)) ! (setq found t) ! (setcdr (car articles) (+ score (cdar articles)))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. *** pub/rgnus/lisp/gnus-setup.el Tue May 21 20:27:56 1996 --- rgnus/lisp/gnus-setup.el Sun Jul 28 16:52:00 1996 *************** *** 31,36 **** --- 31,38 ---- ;;; Code: + (require 'message) + (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) (defvar gnus-emacs-lisp-directory (if running-xemacs *** pub/rgnus/lisp/gnus-soup.el Tue Jun 18 11:24:42 1996 --- rgnus/lisp/gnus-soup.el Sun Jul 28 19:39:56 1996 *************** *** 26,34 **** ;;; Code: ! (require 'gnus-msg) (require 'gnus) ! (eval-when-compile (require 'cl)) ;;; User Variables: --- 26,37 ---- ;;; Code: ! (require 'gnus-load) ! (require 'gnus-art) ! (require 'message) ! (require 'gnus-start) (require 'gnus) ! (require 'gnus-range) ;;; User Variables: *************** *** 206,212 **** (defun gnus-soup-store (directory prefix headers format index) ;; Create the directory, if needed. (or (file-directory-p directory) ! (gnus-make-directory directory)) (let* ((msg-buf (find-file-noselect (concat directory prefix ".MSG"))) (idx-buf (if (= index ?n) --- 209,215 ---- (defun gnus-soup-store (directory prefix headers format index) ;; Create the directory, if needed. (or (file-directory-p directory) ! (make-directory directory) t) (let* ((msg-buf (find-file-noselect (concat directory prefix ".MSG"))) (idx-buf (if (= index ?n) *************** *** 323,329 **** (while prefix (gnus-set-work-buffer) (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix))) ! (gnus-make-directory (caar prefix)) (write-region (point-min) (point-max) (concat (caar prefix) gnus-soup-prefix-file) nil 'nomesg) --- 326,332 ---- (while prefix (gnus-set-work-buffer) (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix))) ! (make-directory (caar prefix) t) (write-region (point-min) (point-max) (concat (caar prefix) gnus-soup-prefix-file) nil 'nomesg) *************** *** 343,349 **** files))) (dir (expand-file-name dir))) (or (file-directory-p dir) ! (gnus-make-directory dir)) (setq gnus-soup-areas nil) (gnus-message 4 "Packing %s..." packer) (if (zerop (call-process shell-file-name --- 346,352 ---- files))) (dir (expand-file-name dir))) (or (file-directory-p dir) ! (make-directory dir t)) (setq gnus-soup-areas nil) (gnus-message 4 "Packing %s..." packer) (if (zerop (call-process shell-file-name *************** *** 485,491 **** (defun gnus-soup-unpack-packet (dir unpacker packet) "Unpack PACKET into DIR using UNPACKER. Return whether the unpacking was successful." ! (gnus-make-directory dir) (gnus-message 4 "Unpacking: %s" (format unpacker packet)) (prog1 (zerop (call-process --- 488,494 ---- (defun gnus-soup-unpack-packet (dir unpacker packet) "Unpack PACKET into DIR using UNPACKER. Return whether the unpacking was successful." ! (make-directory dir t) (gnus-message 4 "Unpacking: %s" (format unpacker packet)) (prog1 (zerop (call-process *** pub/rgnus/lisp/gnus-spec.el Tue Jul 30 22:59:19 1996 --- rgnus/lisp/gnus-spec.el Sun Jul 28 23:24:06 1996 *************** *** 0 **** --- 1,441 ---- + ;;; gnus-spec.el --- format spec functions for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus) + + ;;; Internal variables. + + (defvar gnus-summary-mark-positions nil) + (defvar gnus-group-mark-positions nil) + (defvar gnus-group-indentation "") + + ;; Format specs. The chunks below are the machine-generated forms + ;; 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. + + (defvar gnus-tmp-unread) + (defvar gnus-tmp-replied) + (defvar gnus-tmp-score-char) + (defvar gnus-tmp-indentation) + (defvar gnus-tmp-opening-bracket) + (defvar gnus-tmp-lines) + (defvar gnus-tmp-name) + (defvar gnus-tmp-closing-bracket) + (defvar gnus-tmp-subject-or-nil) + (defvar gnus-tmp-subject) + (defvar gnus-tmp-marked) + (defvar gnus-tmp-marked-mark) + (defvar gnus-tmp-subscribed) + (defvar gnus-tmp-process-marked) + (defvar gnus-tmp-number-of-unread) + (defvar gnus-tmp-group-name) + (defvar gnus-tmp-group) + (defvar gnus-tmp-article-number) + (defvar gnus-tmp-unread-and-unselected) + (defvar gnus-tmp-news-method) + (defvar gnus-tmp-news-server) + (defvar gnus-tmp-article-number) + (defvar gnus-mouse-face) + (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) + (gnus-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 () + (insert "* ") + (gnus-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-group-indentation + (format "%5s: " gnus-tmp-number-of-unread)) + (gnus-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 "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) + (summary-dummy "* %(: :%) %S\n" + ,gnus-summary-dummy-line-format-spec) + (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + ,gnus-summary-line-format-spec)) + "Alist of format specs.") + + (defvar gnus-article-mode-line-format-spec nil) + (defvar gnus-summary-mode-line-format-spec nil) + (defvar gnus-group-mode-line-format-spec nil) + + ;;; Phew. All that gruft is over, fortunately. + + ;;;###autoload + (defun gnus-update-format (var) + "Update the format specification near point." + (interactive + (list + (save-excursion + (eval-defun nil) + ;; Find the end of the current word. + (re-search-forward "[ \t\n]" nil t) + ;; Search backward. + (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) + (match-string 1))))) + (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) + (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)) + (gnus-parse-format (setq value (symbol-value (intern var))) + (symbol-value (intern (format "%s-alist" var))) + (not (string-match "mode" var)))) + (setq spec (symbol-value (intern (format "%s-spec" var)))) + (push (list type value spec) gnus-format-specs) + + (pop-to-buffer "*Gnus Format*") + (erase-buffer) + (lisp-interaction-mode) + (insert (pp-to-string spec)))) + + (defun gnus-update-format-specifications (&optional force &rest types) + "Update all (necessary) format specifications." + ;; Make the indentation array. + + ;; See whether all the stored info needs to be flushed. + (when (or force + (not (equal emacs-version + (cdr (assq 'version gnus-format-specs))))) + (setq gnus-format-specs nil)) + + ;; Go through all the formats and see whether they need updating. + (let (new-format entry type val) + (while (setq type (pop types)) + ;; Jump to the proper buffer to find out the value of + ;; the variable, if possible. (It may be buffer-local.) + (save-excursion + (let ((buffer (intern (format "gnus-%s-buffer" type))) + val) + (when (and (boundp buffer) + (setq val (symbol-value buffer)) + (get-buffer val) + (buffer-name (get-buffer val))) + (set-buffer (get-buffer val))) + (setq new-format (symbol-value + (intern (format "gnus-%s-line-format" type)))))) + (setq entry (cdr (assq type gnus-format-specs))) + (if (and entry + (equal (car entry) new-format)) + ;; Use the old format. + (set (intern (format "gnus-%s-line-format-spec" type)) + (cadr entry)) + ;; This is a new format. + (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)))))) + ;; Enter the new format spec into the list. + (if entry + (progn + (setcar (cdr entry) val) + (setcar entry new-format)) + (push (list type new-format val) gnus-format-specs)) + (set (intern (format "gnus-%s-line-format-spec" type)) val)))) + + (unless (assq 'version gnus-format-specs) + (push (cons 'version emacs-version) gnus-format-specs))) + + (defvar gnus-mouse-face-0 'highlight) + (defvar gnus-mouse-face-1 'highlight) + (defvar gnus-mouse-face-2 'highlight) + (defvar gnus-mouse-face-3 'highlight) + (defvar gnus-mouse-face-4 'highlight) + + (defun gnus-mouse-face-function (form type) + `(gnus-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))))))) + + (defvar gnus-face-0 'bold) + (defvar gnus-face-1 'italic) + (defvar gnus-face-2 'bold-italic) + (defvar gnus-face-3 'bold) + (defvar gnus-face-4 'bold) + + (defun gnus-face-face-function (form type) + `(gnus-put-text-property + (point) (progn ,@form (point)) + 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) + + (defun gnus-max-width-function (el max-width) + (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) + (if (symbolp el) + `(if (> (length ,el) ,max-width) + (substring ,el 0 ,max-width) + ,el) + `(let ((val (eval ,el))) + (if (numberp val) + (setq val (int-to-string val))) + (if (> (length val) ,max-width) + (substring val 0 ,max-width) + val)))) + + (defun gnus-parse-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 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) + ;; This is a simple format. + (gnus-parse-simple-format format spec-alist insert))) + + (defun gnus-parse-complex-format (format spec-alist) + (save-excursion + (gnus-set-work-buffer) + (insert format) + (goto-char (point-min)) + (while (re-search-forward "\"" nil t) + (replace-match "\\\"" nil t)) + (goto-char (point-min)) + (insert "(\"") + (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) + (let ((number (if (match-beginning 1) + (match-string 1) "0")) + (delim (aref (match-string 2) 0))) + (if (or (= delim ?\() (= delim ?\{)) + (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") + " " number " \"")) + (replace-match "\")\"")))) + (goto-char (point-max)) + (insert "\")") + (goto-char (point-min)) + (let ((form (read (current-buffer)))) + (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) + + (defun gnus-complex-form-to-spec (form spec-alist) + (delq nil + (mapcar + (lambda (sform) + (if (stringp sform) + (gnus-parse-simple-format sform spec-alist t) + (funcall (intern (format "gnus-%s-face-function" (car sform))) + (gnus-complex-form-to-spec (cddr 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 + (gnus-set-work-buffer) + (insert format) + (goto-char (point-min)) + (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" + nil t) + (if (= (setq spec (string-to-char (match-string 2))) ?%) + (setq newspec "%" + beg (1+ (match-beginning 0))) + ;; First check if there are any specs that look anything like + ;; "%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))) + ;; Find the specification from `spec-alist'. + (unless (setq elem (cdr (assq spec spec-alist))) + (setq elem '("*" ?s))) + ;; 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 ((= (cadr elem) ?c) + (setq el (list 'char-to-string el))) + ((= (cadr 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 (cadr elem))))) + ;; Remove the old specification (and possibly a ",12" string). + (delete-region beg (match-end 2)) + ;; Insert the new specification. + (goto-char beg) + (insert newspec)) + (setq fstring (buffer-substring 1 (point-max)))) + ;; Do some postprocessing to increase efficiency. + (setq + result + (cond + ;; Emptyness. + ((string= fstring "") + nil) + ;; Not a format string. + ((not (string-match "%" fstring)) + (list fstring)) + ;; A format string with just a single string spec. + ((string= fstring "%s") + (list (car flist))) + ;; A single character. + ((string= fstring "%c") + (list (car flist))) + ;; A single number. + ((string= fstring "%d") + (setq dontinsert) + (if insert + (list `(princ ,(car flist))) + (list `(int-to-string ,(car flist))))) + ;; Just lots of chars and strings. + ((string-match "\\`\\(%[cs]\\)+\\'" fstring) + (nreverse flist)) + ;; A single string spec at the beginning of the spec. + ((string-match "\\`%[sc][^%]+\\'" fstring) + (list (car flist) (substring fstring 2))) + ;; A single string spec in the middle of the spec. + ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) + (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) + ;; A single string spec in the end of the spec. + ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) + (list (match-string 1 fstring) (car flist))) + ;; A more complex spec. + (t + (list (cons 'format (cons fstring (nreverse flist))))))) + + (if insert + (when result + (if dontinsert + result + (cons 'insert result))) + (cond ((stringp result) + result) + ((consp result) + (cons 'concat result)) + (t ""))))) + + (defun gnus-eval-format (format &optional alist props) + "Eval the format variable FORMAT, using ALIST. + If PROPS, insert the result." + (let ((form (gnus-parse-format format alist props))) + (if props + (gnus-add-text-properties (point) (progn (eval form) (point)) props) + (eval form)))) + + (defun gnus-compile () + "Byte-compile the user-defined format specs." + (interactive) + (let ((entries gnus-format-specs) + entry gnus-tmp-func) + (save-excursion + (gnus-message 7 "Compiling format specs...") + + (while entries + (setq entry (pop entries)) + (if (eq (car entry) 'version) + (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))))) + + (push (cons 'version emacs-version) gnus-format-specs) + ;; Mark the .newsrc.eld file as "dirty". + (gnus-dribble-enter " ") + (gnus-message 7 "Compiling user specs...done")))) + + (provide 'gnus-spec) + + ;;; gnus-spec.el ends here *** pub/rgnus/lisp/gnus-srvr.el Wed Jun 19 15:49:01 1996 --- rgnus/lisp/gnus-srvr.el Sun Jul 28 19:39:44 1996 *************** *** 25,32 **** ;;; Code: (require 'gnus) ! (eval-when-compile (require 'cl)) (defvar gnus-server-mode-hook nil "Hook run in `gnus-server-mode' buffers.") --- 25,36 ---- ;;; Code: + (require 'gnus-load) + (require 'gnus-spec) (require 'gnus) ! (require 'gnus-group) ! (require 'gnus-int) ! (require 'gnus-range) (defvar gnus-server-mode-hook nil "Hook run in `gnus-server-mode' buffers.") *** pub/rgnus/lisp/gnus-start.el Tue Jul 30 22:59:20 1996 --- rgnus/lisp/gnus-start.el Tue Jul 30 21:51:58 1996 *************** *** 0 **** --- 1,2328 ---- + ;;; gnus-start.el --- startup functions for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus) + (require 'gnus-win) + (require 'gnus-int) + (require 'gnus-spec) + (require 'gnus-range) + (require 'message) + + (defvar gnus-secondary-servers nil + "*List of NNTP servers that the user can choose between interactively. + To make Gnus query you for a server, you have to give `gnus' a + non-numeric prefix - `C-u M-x gnus', in short.") + + (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" + "*Your `.newsrc' file. + `.newsrc-SERVER' will be used instead if that exists.") + + (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-default-subscribed-newsgroups nil + "*This variable lists what newsgroups should be subscribed the first time Gnus is used. + It should be a list of strings. + If it is `t', Gnus will not do anything special the first time it is + started; it'll just use the normal newsgroups subscription methods.") + + (defvar gnus-use-dribble-file t + "*Non-nil means that Gnus will use a dribble file to store user updates. + If Emacs should crash without saving the .newsrc files, complete + information can be restored from the dribble file.") + + (defvar gnus-dribble-directory nil + "*The directory where dribble files will be saved. + If this variable is nil, the directory where the .newsrc files are + saved will be used.") + + (defvar gnus-check-new-newsgroups t + "*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup. + This normally finds new newsgroups by comparing the active groups the + servers have already reported with those Gnus already knows, either alive + or killed. + + When any of the following are true, gnus-find-new-newsgroups will instead + ask the servers (primary, secondary, and archive servers) to list new + groups since the last time it checked: + 1. This variable is `ask-server'. + 2. This variable is a list of select methods (see below). + 3. `gnus-read-active-file' is nil or `some'. + 4. A prefix argument is given to gnus-find-new-newsgroups interactively. + + Thus, if this variable is `ask-server' or a list of select methods or + `gnus-read-active-file' is nil or `some', then the killed list is no + longer necessary, so you could safely set `gnus-save-killed-list' to nil. + + This variable can be a list of select methods which Gnus will query with + the `ask-server' method in addition to the primary, secondary, and archive + 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].") + + (defvar gnus-check-bogus-newsgroups nil + "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. + If this variable is nil, then you have to tell Gnus explicitly to + check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups].") + + (defvar gnus-read-active-file t + "*Non-nil means that Gnus will read the entire active file at startup. + If this variable is nil, Gnus will only know about the groups in your + `.newsrc' file. + + If this variable is `some', Gnus will try to only read the relevant + parts of the active file from the server. Not all servers support + this, and it might be quite slow with other servers, but this should + generally be faster than both the t and nil value. + + If you set this variable to nil or `some', you probably still want to + be told about new newsgroups that arrive. To do that, set + `gnus-check-new-newsgroups' to `ask-server'. This may not work + properly with all servers.") + + (defvar gnus-level-subscribed 5 + "*Groups with levels less than or equal to this variable are subscribed.") + + (defvar gnus-level-unsubscribed 7 + "*Groups with levels less than or equal to this variable are unsubscribed. + Groups with levels less than `gnus-level-subscribed', which should be + less than this variable, are subscribed.") + + (defvar gnus-level-zombie 8 + "*Groups with this level are zombie groups.") + + (defvar gnus-level-killed 9 + "*Groups with this level are killed.") + + (defvar gnus-level-default-subscribed 3 + "*New subscribed groups will be subscribed at this level.") + + (defvar gnus-level-default-unsubscribed 6 + "*New unsubscribed groups will be unsubscribed at this level.") + + (defvar gnus-activate-level (1+ gnus-level-subscribed) + "*Groups higher than this level won't be activated on startup. + Setting this variable to something log might save lots of time when + you have many groups that you aren't interested in.") + + (defvar gnus-activate-foreign-newsgroups 4 + "*If nil, Gnus will not check foreign newsgroups at startup. + 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 + might take a while. By setting this variable to nil, you'll save time, + but you won't be told how many unread articles there are in the + groups.") + + (defvar gnus-save-newsrc-file t + "*Non-nil means that Gnus will save the `.newsrc' file. + Gnus always saves its own startup file, which is called + \".newsrc.eld\". The file called \".newsrc\" is in a format that can + be readily understood by other newsreaders. If you don't plan on + using other newsreaders, set this variable to nil to save some time on + exit.") + + (defvar gnus-save-killed-list t + "*If non-nil, save the list of killed groups to the startup file. + If you set this variable to nil, you'll save both time (when starting + and quitting) and space (both memory and disk), but it will also mean + that Gnus has no record of which groups are new and which are old, so + the automatic new newsgroups subscription methods become meaningless. + + You should always set `gnus-check-new-newsgroups' to `ask-server' or + nil if you set this variable to nil.") + + (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, + thus making them effectively non-existent.") + + (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies + "*Function called with a group name when new group is detected. + A few pre-made functions are supplied: `gnus-subscribe-randomly' + inserts new groups at the beginning of the list of groups; + `gnus-subscribe-alphabetically' inserts new groups in strict + alphabetic order; `gnus-subscribe-hierarchically' inserts new groups + in hierarchical newsgroup order; `gnus-subscribe-interactively' asks + for your decision; `gnus-subscribe-killed' kills all new groups; + `gnus-subscribe-zombies' will make all new groups into zombies.") + + ;; 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. + If, for instance, you want to subscribe to all newsgroups in the + \"no\" and \"alt\" hierarchies, you'd put the following in your + .newsrc file: + + options -n no.all alt.all + + Gnus will the subscribe all new newsgroups in these hierarchies with + the subscription method in this variable.") + + (defvar gnus-subscribe-hierarchical-interactive nil + "*If non-nil, Gnus will offer to subscribe hierarchically. + When a new hierarchy appears, Gnus will ask the user: + + 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): + + If the user pressed `d', Gnus will descend the hierarchy, `y' will + subscribe to all newsgroups in the hierarchy and `s' will skip this + hierarchy in its entirety.") + + (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 + whatsoever on old groups. + + New groups that match this regexp will not be handled by + `gnus-subscribe-newsgroup-method'. Instead, they will + be subscribed using `gnus-subscribe-options-newsgroup-method'.") + + (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. + + New groups that match this regexp will not be handled by + `gnus-subscribe-newsgroup-method'. Instead, they will + be subscribed using `gnus-subscribe-options-newsgroup-method'.") + + (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-modtime-botch nil + "*Non-nil means .newsrc should be deleted prior to save. + Its use is due to the bogus appearance that .newsrc was modified on + disc.") + + (defvar gnus-check-bogus-groups-hook nil + "A hook run after removing bogus groups.") + + (defvar gnus-startup-hook nil + "*A hook called at startup. + This hook is called after Gnus is connected to the NNTP server.") + + (defvar gnus-get-new-news-hook nil + "*A hook run just before Gnus checks for new news.") + + (defvar gnus-after-getting-new-news-hook nil + "*A hook run after Gnus checks for new news.") + + (defvar gnus-save-newsrc-hook nil + "*A hook called before saving any of the newsrc files.") + + (defvar gnus-save-quick-newsrc-hook nil + "*A hook called just before saving the quick newsrc file. + Can be used to turn version control on or off.") + + (defvar gnus-save-standard-newsrc-hook nil + "*A hook called just before saving the standard newsrc file. + Can be used to turn version control on or off.") + + ;;; Internal variables + + (defvar gnus-newsrc-file-version nil) + (defvar gnus-override-subscribe-method nil) + (defvar gnus-dribble-buffer nil) + (defvar gnus-newsrc-options nil + "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.") + + (defvar gnus-current-startup-file nil + "Startup file for the current host.") + + ;; Byte-compiler warning. + (defvar gnus-group-line-format) + + ;; Suggested by Brian Edmonds . + (defvar gnus-init-inhibit nil) + (defun gnus-read-init-file (&optional inhibit-next) + (if gnus-init-inhibit + (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)))))) + + ;; For subscribing new newsgroup + + (defun gnus-subscribe-hierarchical-interactive (groups) + (let ((groups (sort groups 'string<)) + prefixes prefix start ans group starts) + (while groups + (setq prefixes (list "^")) + (while (and groups prefixes) + (while (not (string-match (car prefixes) (car groups))) + (setq prefixes (cdr prefixes))) + (setq prefix (car prefixes)) + (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 (cadr groups))) + (progn + (setq prefixes (cons prefix prefixes)) + (message "Descend hierarchy %s? ([y]nsq): " + (substring prefix 1 (1- (length prefix)))) + (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q))) + (ding) + (message "Descend hierarchy %s? ([y]nsq): " + (substring prefix 1 (1- (length prefix))))) + (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)) + (setq groups (cdr groups))) + (setq starts (cdr starts))) + ((= ans ?q) + (while groups + (setq group (car groups)) + (setq gnus-killed-list (cons group gnus-killed-list)) + (gnus-sethash group group gnus-killed-hashtb) + (setq groups (cdr groups)))) + (t nil))) + (message "Subscribe %s? ([n]yq)" (car groups)) + (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n))) + (ding) + (message "Subscribe %s? ([n]yq)" (car groups))) + (setq group (car groups)) + (cond ((= ans ?y) + (gnus-subscribe-alphabetically (car groups)) + (gnus-sethash group group gnus-killed-hashtb)) + ((= ans ?q) + (while groups + (setq group (car groups)) + (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))))))) + + (defun gnus-subscribe-randomly (newsgroup) + "Subscribe new NEWSGROUP by making it the first newsgroup." + (gnus-subscribe-newsgroup newsgroup)) + + (defun gnus-subscribe-alphabetically (newgroup) + "Subscribe new NEWSGROUP and insert it in alphabetical order." + (let ((groups (cdr gnus-newsrc-alist)) + before) + (while (and (not before) groups) + (if (string< newgroup (caar groups)) + (setq before (caar groups)) + (setq groups (cdr groups)))) + (gnus-subscribe-newsgroup newgroup before))) + + (defun gnus-subscribe-hierarchically (newgroup) + "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." + ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) + (save-excursion + (set-buffer (find-file-noselect gnus-current-startup-file)) + (let ((groupkey newgroup) + before) + (while (and (not before) groupkey) + (goto-char (point-min)) + (let ((groupkey-re + (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) + (while (and (re-search-forward groupkey-re nil t) + (progn + (setq before (match-string 1)) + (string< before newgroup))))) + ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) + (setq groupkey + (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) + (substring groupkey (match-beginning 1) (match-end 1))))) + (gnus-subscribe-newsgroup newgroup before)) + (kill-buffer (current-buffer)))) + + (defun gnus-subscribe-interactively (group) + "Subscribe the new GROUP interactively. + It is inserted in hierarchical newsgroup order if subscribed. If not, + it is killed." + (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) + (gnus-subscribe-hierarchically group) + (push group gnus-killed-list))) + + (defun gnus-subscribe-zombies (group) + "Make the new GROUP into a zombie group." + (push group gnus-zombie-list)) + + (defun gnus-subscribe-killed (group) + "Make the new GROUP a killed group." + (push group gnus-killed-list)) + + (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." + (save-excursion + (goto-char (point-min)) + ;; 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))) + + (defun gnus-read-active-file-p () + "Say whether the active file has been read from `gnus-select-method'." + (memq gnus-select-method gnus-have-read-active-file)) + + ;;; General various misc type functions. + + ;; Silence byte-compiler. + (defvar gnus-current-headers) + (defvar gnus-thread-indent-array) + (defvar gnus-newsgroup-name) + (defvar gnus-newsgroup-headers) + (defvar gnus-group-list-mode) + (defvar gnus-group-mark-positions) + (defvar gnus-newsgroup-data) + (defvar gnus-newsgroup-unreads) + (defvar nnoo-state-alist) + (defvar gnus-current-select-method) + (defun gnus-clear-system () + "Clear all variables and buffers." + ;; Clear Gnus variables. + (let ((variables gnus-variable-list)) + (while variables + (set (car variables) nil) + (setq variables (cdr variables)))) + ;; Clear other internal variables. + (setq gnus-list-of-killed-groups nil + gnus-have-read-active-file nil + gnus-newsrc-alist nil + gnus-newsrc-hashtb nil + gnus-killed-list nil + gnus-zombie-list nil + gnus-killed-hashtb nil + gnus-active-hashtb nil + gnus-moderated-list nil + gnus-description-hashtb nil + gnus-current-headers nil + gnus-thread-indent-array nil + gnus-newsgroup-headers nil + gnus-newsgroup-name nil + gnus-server-alist nil + gnus-group-list-mode nil + gnus-opened-servers nil + gnus-group-mark-positions nil + gnus-newsgroup-data nil + gnus-newsgroup-unreads nil + nnoo-state-alist nil + gnus-current-select-method nil) + (gnus-shutdown 'gnus) + ;; Kill the startup file. + (and gnus-current-startup-file + (get-file-buffer gnus-current-startup-file) + (kill-buffer (get-file-buffer gnus-current-startup-file))) + ;; Clear the dribble buffer. + (gnus-dribble-clear) + ;; Kill global KILL file buffer. + (when (get-file-buffer (gnus-newsgroup-kill-file nil)) + (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) + (gnus-kill-buffer nntp-server-buffer) + ;; Kill Gnus buffers. + (while gnus-buffer-list + (gnus-kill-buffer (pop gnus-buffer-list))) + ;; Remove Gnus frames. + (gnus-kill-gnus-frames)) + + ;;;###autoload + (defun gnus-1 (&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 (and (get-buffer gnus-group-buffer) + (save-excursion + (set-buffer gnus-group-buffer) + (eq major-mode 'gnus-group-mode))) + (progn + (switch-to-buffer gnus-group-buffer) + (gnus-group-get-new-news)) + + (gnus-splash) + (gnus-clear-system) + (nnheader-init-server-buffer) + (gnus-read-init-file) + (setq gnus-slave slave) + + (when (string-match "xemacs" (emacs-version)) + (gnus-splash)) + + (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. + (when (or gnus-slave gnus-use-dribble-file) + (gnus-dribble-read-file)) + + ;; Allow using GroupLens predictions. + (when gnus-use-grouplens + (bbb-login) + (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) + + ;; Do the actual startup. + (gnus-setup-news nil level dont-connect) + ;; Generate the group buffer. + (gnus-group-list-groups level) + (gnus-group-first-unread-group) + (gnus-configure-windows 'group) + (gnus-group-set-mode-line)))))) + + ;;;###autoload + (defun gnus-unload () + "Unload all Gnus features." + (interactive) + (or (boundp 'load-history) + (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) + (let ((history load-history) + feature) + (while history + (and (string-match "^\\(gnus\\|nn\\)" (caar history)) + (setq feature (cdr (assq 'provide (car history)))) + (unload-feature feature 'force)) + (setq history (cdr history))))) + + + ;;; + ;;; Dribble file + ;;; + + (defvar gnus-dribble-ignore nil) + (defvar gnus-dribble-eval-file nil) + + (defun gnus-dribble-file-name () + "Return the dribble file for the current .newsrc." + (concat + (if gnus-dribble-directory + (concat (file-name-as-directory gnus-dribble-directory) + (file-name-nondirectory gnus-current-startup-file)) + gnus-current-startup-file) + "-dribble")) + + (defun gnus-dribble-enter (string) + "Enter STRING into the dribble buffer." + (if (and (not gnus-dribble-ignore) + gnus-dribble-buffer + (buffer-name gnus-dribble-buffer)) + (let ((obuf (current-buffer))) + (set-buffer gnus-dribble-buffer) + (insert string "\n") + (set-window-point (get-buffer-window (current-buffer)) (point-max)) + (bury-buffer gnus-dribble-buffer) + (set-buffer obuf)))) + + (defun gnus-dribble-read-file () + "Read the dribble file from disk." + (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) + (setq buffer-file-name dribble-file) + (auto-save-mode t) + (buffer-disable-undo (current-buffer)) + (bury-buffer (current-buffer)) + (set-buffer-modified-p nil) + (let ((auto (make-auto-save-file-name)) + (gnus-dribble-ignore t) + modes) + (when (or (file-exists-p auto) (file-exists-p dribble-file)) + ;; Load whichever file is newest -- the auto save file + ;; or the "real" file. + (if (file-newer-than-file-p auto dribble-file) + (insert-file-contents auto) + (insert-file-contents dribble-file)) + (unless (zerop (buffer-size)) + (set-buffer-modified-p t)) + ;; Set the file modes to reflect the .newsrc file modes. + (save-buffer) + (when (and (file-exists-p gnus-current-startup-file) + (setq modes (file-modes gnus-current-startup-file))) + (set-file-modes dribble-file modes)) + ;; Possibly eval the file later. + (when (gnus-y-or-n-p + "Auto-save file exists. Do you want to read it? ") + (setq gnus-dribble-eval-file t))))))) + + (defun gnus-dribble-eval-file () + (when gnus-dribble-eval-file + (setq gnus-dribble-eval-file nil) + (save-excursion + (let ((gnus-dribble-ignore t)) + (set-buffer gnus-dribble-buffer) + (eval-buffer (current-buffer)))))) + + (defun gnus-dribble-delete-file () + (when (file-exists-p (gnus-dribble-file-name)) + (delete-file (gnus-dribble-file-name))) + (when gnus-dribble-buffer + (save-excursion + (set-buffer gnus-dribble-buffer) + (let ((auto (make-auto-save-file-name))) + (if (file-exists-p auto) + (delete-file auto)) + (erase-buffer) + (set-buffer-modified-p nil))))) + + (defun gnus-dribble-save () + (when (and gnus-dribble-buffer + (buffer-name gnus-dribble-buffer)) + (save-excursion + (set-buffer gnus-dribble-buffer) + (save-buffer)))) + + (defun gnus-dribble-clear () + (when (gnus-buffer-exists-p gnus-dribble-buffer) + (save-excursion + (set-buffer gnus-dribble-buffer) + (erase-buffer) + (set-buffer-modified-p nil) + (setq buffer-saved-size (buffer-size))))) + + + ;;; + ;;; Active & Newsrc File Handling + ;;; + + (defun gnus-setup-news (&optional rawfile level dont-connect) + "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))))) + + (when init + ;; Clear some variables to re-initialize news information. + (setq gnus-newsrc-alist nil + gnus-active-hashtb nil) + ;; Read the newsrc file and create `gnus-newsrc-hashtb'. + (gnus-read-newsrc-file rawfile)) + + (when (and (not (assoc "archive" gnus-server-alist)) + (gnus-archive-server-wanted-p)) + (push (cons "archive" gnus-message-archive-method) + gnus-server-alist)) + + ;; 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)) + + ;; Read the active file and create `gnus-active-hashtb'. + ;; 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)) + + (or gnus-active-hashtb + (setq gnus-active-hashtb (make-vector 4095 0))) + + ;; Initialize the cache. + (when gnus-use-cache + (gnus-cache-open)) + + ;; Possibly eval the dribble file. + (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) + + ;; Slave Gnusii should then clear the dribble buffer. + (when (and init gnus-slave) + (gnus-dribble-clear)) + + (gnus-update-format-specifications) + + ;; See whether we need to read the description file. + (if (and (string-match "%[-,0-9]*D" gnus-group-line-format) + (not gnus-description-hashtb) + (not dont-connect) + gnus-read-active-file) + (gnus-read-all-descriptions-files)) + + ;; Find new newsgroups and treat them. + (if (and init gnus-check-new-newsgroups (not level) + (gnus-check-server gnus-select-method)) + (gnus-find-new-newsgroups)) + + ;; We might read in new NoCeM messages here. + (when (and gnus-use-nocem + (not level) + (not dont-connect)) + (gnus-nocem-scan-groups)) + + ;; Find the number of unread articles in each non-dead group. + (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) + (gnus-get-unread-articles level)) + + (if (and init gnus-check-bogus-newsgroups + gnus-read-active-file (not level) + (gnus-server-opened gnus-select-method)) + (gnus-check-bogus-newsgroups)))) + + (defun gnus-find-new-newsgroups (&optional arg) + "Search for new newsgroups and add them. + Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' + The `-n' option line from .newsrc is respected. + If ARG (the prefix), use the `ask-server' method to query + the server for new groups." + (interactive "P") + (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) + (null gnus-read-active-file) + (eq gnus-read-active-file 'some)) + 'ask-server gnus-check-new-newsgroups))) + (unless (gnus-check-first-time-used) + (if (or (consp check) + (eq check 'ask-server)) + ;; Ask the server for new groups. + (gnus-ask-server-for-new-groups) + ;; Go through the active hashtb and look for new groups. + (let ((groups 0) + group new-newsgroups) + (gnus-message 5 "Looking for new newsgroups...") + (unless gnus-have-read-active-file + (gnus-read-active-file)) + (setq gnus-newsrc-last-checked-date (current-time-string)) + (unless 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) + (when 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 unconditionally + ;; subscribed, `ignore' if it is to be ignored, and nil if there is + ;; no match for the group. + + ;; First we check the two user variables. + (cond + ((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 + (let ((regs gnus-newsrc-options-n)) + (while (and regs + (not (string-match (caar regs) group))) + (setq regs (cdr regs))) + (and regs (cdar regs)))))) + + (defun gnus-ask-server-for-new-groups () + (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) + (methods (cons gnus-select-method + (nconc + (when (gnus-archive-server-wanted-p) + (list "archive")) + (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 new-newsgroups nil) + (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))) + (not (boundp 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 () + (if (or (> (length gnus-newsrc-alist) 1) + (file-exists-p gnus-startup-file) + (file-exists-p (concat gnus-startup-file ".el")) + (file-exists-p (concat gnus-startup-file ".eld"))) + nil + (gnus-message 6 "First time user; subscribing you to default groups") + (unless (gnus-read-active-file-p) + (gnus-read-active-file)) + (setq gnus-newsrc-last-checked-date (current-time-string)) + (let ((groups gnus-default-subscribed-newsgroups) + group) + (if (eq groups t) + nil + (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) + (mapatoms + (lambda (sym) + (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)) + ((eq do-sub 'ignore) + nil) + (t + (setq gnus-killed-list (cons group gnus-killed-list))))))) + 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) + (and gnus-novice-user + (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 + ;; subscription levels of newsgroups. This might mean just changing + ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back + ;; again, which subscribes/unsubscribes a group, which is equally + ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and + ;; from 8-9 to 1-7 means that you remove the group from the list of + ;; killed (or zombie) groups and add them to the (kinda) subscribed + ;; groups. And last but not least, moving from 8 to 9 and 9 to 8, + ;; which is trivial. + ;; 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) + ;; Glean what info we can from the arguments + (if (consp entry) + (if fromkilled (setq group (nth 1 entry)) + (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) + (consp entry)) + (setq oldlevel (gnus-info-level (nth 2 entry))) + (setq oldlevel (or oldlevel 9))) + (if (stringp previous) + (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) + + (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 + ;; it from the newsrc hash table and assoc. + (cond + ((>= oldlevel gnus-level-zombie) + (if (= oldlevel gnus-level-zombie) + (setq gnus-zombie-list (delete group gnus-zombie-list)) + (setq gnus-killed-list (delete group gnus-killed-list)))) + (t + (if (and (>= level gnus-level-zombie) + entry) + (progn + (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) + (if (nth 3 entry) + (setcdr (gnus-gethash (car (nth 3 entry)) + gnus-newsrc-hashtb) + (cdr entry))) + (setcdr (cdr entry) (cdddr entry)))))) + + ;; Finally we enter (if needed) the list where it is supposed to + ;; go, and change the subscription level. If it is to be killed, + ;; we enter it into the killed or zombie list. + (cond + ((>= level gnus-level-zombie) + ;; 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)) + (setq gnus-killed-list (cons group gnus-killed-list))))) + (t + ;; If the list is to be entered into the newsrc assoc, and + ;; it was killed, we have to create an entry in the newsrc + ;; hashtb format and fix the pointers in the newsrc assoc. + (if (< oldlevel gnus-level-zombie) + ;; 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 (cdaddr entry) level) + (if (listp entry) + (setq info (cdr entry) + 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 group)))) + (if (eq method gnus-select-method) + (setq info (list group level nil)) + (setq info (list group level nil nil method))))) + (unless previous + (setq previous + (let ((p gnus-newsrc-alist)) + (while (cddr p) + (setq p (cdr p))) + p))) + (setq entry (cons info (cddr previous))) + (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) + gnus-newsrc-hashtb)) + (when (cdr entry) + (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))))) + (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." + (gnus-group-change-level + (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) + + (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-read-active-file-p) + (gnus-read-active-file)) + (when (gnus-read-active-file-p) + ;; Find all bogus newsgroup that are subscribed. + (while newsrc + (setq info (pop newsrc) + group (gnus-info-group info)) + (unless (or (gnus-active group) ; Active + (gnus-info-method info) ; Foreign + (and confirm + (not (gnus-y-or-n-p + (format "Remove bogus newsgroup: %s " group))))) + ;; Found a bogus newsgroup. + (push group bogus))) + ;; Remove all bogus subscribed groups by first killing them, and + ;; then removing them from the list of killed groups. + (while bogus + (when (setq entry (gnus-gethash (setq group (pop bogus)) + gnus-newsrc-hashtb)) + (gnus-group-change-level entry gnus-level-killed) + (setq gnus-killed-list (delete group gnus-killed-list)))) + ;; Then we remove all bogus groups from the list of killed and + ;; zombie groups. They are removed without confirmation. + (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) + killed) + (while dead-lists + (setq killed (symbol-value (car dead-lists))) + (while killed + (unless (gnus-active (setq group (pop killed))) + ;; The group is bogus. + ;; !!!Slow as hell. + (set (car dead-lists) + (delete group (symbol-value (car dead-lists)))))) + (setq dead-lists (cdr dead-lists)))) + (run-hooks 'gnus-check-bogus-groups-hook) + (gnus-message 5 "Checking bogus newsgroups...done")))) + + (defun gnus-check-duplicate-killed-groups () + "Remove duplicates from the list of killed groups." + (interactive) + (let ((killed gnus-killed-list)) + (while killed + (gnus-message 9 "%d" (length killed)) + (setcdr killed (delete (car killed) (cdr killed))) + (setq killed (cdr killed))))) + + ;; We want to inline a function from gnus-cache, so we cheat here: + (eval-when-compile + (defvar gnus-cache-active-hashtb) + (defun gnus-cache-possibly-alter-active (group active) + "Alter the ACTIVE info for GROUP to reflect the articles in the cache." + (when gnus-cache-active-hashtb + (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) + (and cache-active + (< (car cache-active) (car active)) + (setcar active (car cache-active))) + (and cache-active + (> (cdr cache-active) (cdr active)) + (setcdr active (cdr cache-active))))))) + + (defun gnus-get-unread-articles-in-group (info active &optional update) + (when active + ;; Allow the backend to update the info in the group. + (when (and update + (gnus-request-update-info + info (gnus-find-method-for-group (gnus-info-group info)))) + (gnus-activate-group (gnus-info-group info) nil t)) + (let* ((range (gnus-info-read info)) + (num 0)) + ;; If a cache is present, we may have to alter the active info. + (when (and gnus-use-cache info) + (inline (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) + (setq num (- (1+ (cdr active)) (car active)))) + ((not (listp (cdr range))) + ;; Fix a single (num . num) range according to the + ;; active hash table. + ;; Fix by Carsten Bormann . + (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) + (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) + ;; Compute number of unread articles. + (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) + (t + ;; 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 (cadr range)) (cadr range)) + (caadr range)))) + (if (numberp (car range)) + (setcar range + (cons (car range) + (or (and (numberp (cadr range)) + (cadr range)) + (cdadr range)))) + (setcdr (car range) + (or (and (numberp (nth 1 range)) (nth 1 range)) + (cdadr range)))) + (setcdr range (cddr range))) + ;; Adjust the first element to be the same as the lower limit. + (if (and (not (atom (car range))) + (< (cdar 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 (cadr srange)) + (cadr srange)) + (caadr srange)) (cdr active))) + (setq srange (cdr srange))) + (if (cdr srange) + ;; Nuke all remaining illegal elements. + (setcdr srange nil)) + + ;; Adjust the final element. + (if (and (not (atom (car srange))) + (> (cdar srange) (cdr active))) + (setcdr (car srange) (cdr active)))) + ;; Compute the number of unread articles. + (while range + (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) + (cdar range))) + (or (and (atom (car range)) (car range)) + (caar range))))) + (setq range (cdr range))) + (setq num (max 0 (- (cdr active) num))))) + ;; Set the number of unread articles. + (when info + (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) + num))) + + ;; 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 method) + (gnus-message 5 "Checking new news...") + + (while newsrc + (setq active (gnus-active (setq group (gnus-info-group + (setq info (pop newsrc)))))) + + ;; Check newsgroups. If the user doesn't want to check them, or + ;; they can't be checked (for instance, if the news server can't + ;; be reached) we just set the number of unread articles in this + ;; newsgroup to t. This means that Gnus thinks that there are + ;; unread articles, but it has no idea how many. + (if (and (setq method (gnus-info-method info)) + (not (gnus-server-equal + gnus-select-method + (setq method (gnus-server-get-method nil method)))) + (not (gnus-secondary-method-p method))) + ;; These groups are foreign. Check the level. + (when (<= (gnus-info-level info) foreign-level) + (setq active (gnus-activate-group group 'scan)) + (unless (inline (gnus-virtual-group-p group)) + (inline (gnus-close-group group))) + (when (fboundp (intern (concat (symbol-name (car method)) + "-request-update-info"))) + (inline (gnus-request-update-info info method)))) + ;; These groups are native or secondary. + (when (and (<= (gnus-info-level info) level) + (not gnus-read-active-file)) + (setq active (gnus-activate-group group 'scan)) + (inline (gnus-close-group group)))) + + ;; Get the number of unread articles in the group. + (if active + (inline (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))) + + (gnus-message 5 "Checking new news...done"))) + + ;; Create a hash table out of the newsrc alist. The `car's of the + ;; alist elements are used as keys. + (defun gnus-make-hashtable-from-newsrc-alist () + (let ((alist gnus-newsrc-alist) + (ohashtb gnus-newsrc-hashtb) + prev) + (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) + (setq alist + (setq prev (setq gnus-newsrc-alist + (if (equal (caar gnus-newsrc-alist) + "dummy.group") + gnus-newsrc-alist + (cons (list "dummy.group" 0 nil) alist))))) + (while alist + (gnus-sethash + (caar alist) + (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) + prev) + gnus-newsrc-hashtb) + (setq prev alist + alist (cdr alist))))) + + (defun gnus-make-hashtable-from-killed () + "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 (setq list (pop lists)) + (setq list (symbol-value list)) + (while list + (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) + + (defun gnus-activate-group (group &optional scan dont-check method) + ;; Check whether a group has been activated or not. + ;; If SCAN, request a scan of that group as well. + (let ((method (or method (gnus-find-method-for-group group))) + active) + (and (gnus-check-server method) + ;; We escape all bugs and quit here to make it possible to + ;; continue if a group is so out-there that it reports bugs + ;; and stuff. + (progn + (and scan + (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan group method)) + t) + (condition-case () + (gnus-request-group group dont-check method) + ; (error nil) + (quit nil)) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + ;; Parse the result we got from `gnus-request-group'. + (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. + active)))))) + + (defun gnus-update-read-articles (group unread) + "Update the list of read and ticked articles in GROUP using the + UNREAD and TICKED lists. + Note: UNSELECTED has to be sorted over `<'. + Returns whether the updating was successful." + (let* ((active (or gnus-newsgroup-active (gnus-active group))) + (entry (gnus-gethash group gnus-newsrc-hashtb)) + (info (nth 2 entry)) + (prev 1) + (unread (sort (copy-sequence unread) '<)) + read) + (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)) + (setq unread (cdr unread))) + ;; Remove any expired article numbers + (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 + (cons prev (1- (car unread)))) read))) + (setq prev (1+ (car unread))) + (setq unread (cdr unread))) + (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)) + t))) + + (defun gnus-make-articles-unread (group articles) + "Mark ARTICLES in GROUP as unread." + (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) + (gnus-gethash (gnus-group-real-name group) + gnus-newsrc-hashtb)))) + (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)))) + + ;; Enter all dead groups into the hashtb. + (defun gnus-update-active-hashtb-from-killed () + (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0))) + (lists (list gnus-killed-list gnus-zombie-list)) + killed) + (while lists + (setq killed (car lists)) + (while killed + (gnus-sethash (car killed) nil hashtb) + (setq killed (cdr killed))) + (setq lists (cdr lists))))) + + (defun gnus-get-killed-groups () + "Go through the active hashtb and mark all unknown groups as killed." + ;; First make sure active file has been read. + (unless (gnus-read-active-file-p) + (let ((gnus-read-active-file t)) + (gnus-read-active-file))) + (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) + ;; Go through all newsgroups that are known to Gnus - enlarge kill list. + (mapatoms + (lambda (sym) + (let ((groups 0) + (group (symbol-name sym))) + (if (or (null group) + (gnus-gethash group gnus-killed-hashtb) + (gnus-gethash group gnus-newsrc-hashtb)) + () + (let ((do-sub (gnus-matches-options-n group))) + (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)) + + ;; Get the active file(s) from the backend(s). + (defun gnus-read-active-file () + (gnus-group-set-mode-line) + (let ((methods + (append + (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) + ;; Also read from the archive server. + (when (gnus-archive-server-wanted-p) + (list "archive")))) + list-type) + (setq gnus-have-read-active-file nil) + (save-excursion + (set-buffer nntp-server-buffer) + (while methods + (let* ((method (if (stringp (car methods)) + (gnus-server-get-method nil (car methods)) + (car methods))) + (where (nth 1 method)) + (mesg (format "Reading active file%s via %s..." + (if (and where (not (zerop (length where)))) + (concat " from " where) "") + (car method)))) + (gnus-message 5 mesg) + (when (gnus-check-server method) + ;; 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 info) + (while (setq info (pop newsrc)) + (when (gnus-server-equal + (gnus-find-method-for-group + (gnus-info-group info) info) + gmethod) + (push (gnus-group-real-name (gnus-info-group info)) + groups))) + (when groups + (gnus-check-server method) + (setq list-type (gnus-retrieve-groups groups method)) + (cond + ((not list-type) + (gnus-error + 1.2 "Cannot read partial active file from %s server." + (car method))) + ((eq list-type 'active) + (gnus-active-to-gnus-format method gnus-active-hashtb)) + (t + (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) + (t + (if (not (gnus-request-list method)) + (unless (equal method gnus-message-archive-method) + (gnus-error 1 "Cannot read active file from %s server." + (car method))) + (gnus-message 5 mesg) + (gnus-active-to-gnus-format method gnus-active-hashtb) + ;; We mark this active file as read. + (push method gnus-have-read-active-file) + (gnus-message 5 "%sdone" mesg)))))) + (setq methods (cdr methods)))))) + + ;; Read an active file and place the results in `gnus-active-hashtb'. + (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) + (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))))))) + ;; 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 + (goto-char (point-min)) + (delete-matching-lines gnus-ignored-newsgroups))) + ;; Make the group names readable as a lisp expression even if they + ;; contain special characters. + ;; Fix by Luc Van Eycken . + (goto-char (point-max)) + (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))) + (let ((prefix (gnus-group-prefixed-name "" method))) + (goto-char (point-min)) + (while (and (not (eobp)) + (progn (insert prefix) + (zerop (forward-line 1))))))) + ;; Store the active file in a hash table. + (goto-char (point-min)) + (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) + (while (not (eobp)) + (condition-case nil + (progn + (narrow-to-region (point) (gnus-point-at-eol)) + (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) ?=) + (= (following-char) ?x) + (= (following-char) ?j))))) + (set group (cons min max)) + (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)))) + (widen) + (forward-line 1))) + ;; And if we do not care about moderation, we use this loop, + ;; which is faster. + (let (group max min) + (while (not (eobp)) + (condition-case () + (progn + (narrow-to-region (point) (gnus-point-at-eol)) + ;; group gets set to a symbol interned in the hash table + ;; (what a hack!!) - jwz + (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) ?=) + (= (following-char) ?x) + (= (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)))))) + + (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))) + (gnus-group-prefixed-name "" method)))) + + (goto-char (point-min)) + ;; We split this into to separate loops, one with the prefix + ;; and one without to speed the reading up somewhat. + (if prefix + (let (min max opoint group) + (while (not (eobp)) + (condition-case () + (progn + (read cur) (read cur) + (setq min (read cur) + max (read cur) + opoint (point)) + (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))) + (let (min max group) + (while (not (eobp)) + (condition-case () + (if (= (following-char) ?2) + (progn + (read cur) (read cur) + (setq min (read cur) + max (read cur)) + (set (setq group (let ((obarray hashtb)) (read cur))) + (cons min max)))) + (error (and group (symbolp group) (set group nil)))) + (forward-line 1)))))) + + (defun gnus-read-newsrc-file (&optional force) + "Read startup file. + If FORCE is non-nil, the .newsrc file is read." + ;; Reset variables that might be defined in the .newsrc.eld file. + (let ((variables gnus-variable-list)) + (while variables + (set (car variables) nil) + (setq variables (cdr variables)))) + (let* ((newsrc-file gnus-current-startup-file) + (quick-file (concat newsrc-file ".el"))) + (save-excursion + ;; We always load the .newsrc.eld file. If always contains + ;; 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 (and (file-exists-p gnus-current-startup-file) + (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 + ;; .newsrc.eld file exists, it has already been read, and + ;; the `gnus-newsrc-hashtb' has been created. While reading + ;; the .newsrc file, Gnus will only use the information it + ;; can find there for changing the data already read - + ;; ie. reading the .newsrc file will not trash the data + ;; already read (except for read articles). + (save-excursion + (gnus-message 5 "Reading %s..." newsrc-file) + (set-buffer (find-file-noselect newsrc-file)) + (buffer-disable-undo (current-buffer)) + (gnus-newsrc-to-gnus-format) + (kill-buffer (current-buffer)) + (gnus-message 5 "Reading %s...done" newsrc-file))) + + ;; Read any slave files. + (unless gnus-slave + (gnus-master-read-slave-newsrc)) + + ;; Convert old to new. + (gnus-convert-old-newsrc)))) + + (defun gnus-convert-old-newsrc () + "Convert old newsrc into the new format, if needed." + (let ((fcv (and gnus-newsrc-file-version + (gnus-continuum-version gnus-newsrc-file-version)))) + (cond + ;; No .newsrc.eld file was loaded. + ((null fcv) nil) + ;; Gnus 5 .newsrc.eld was loaded. + ((< fcv (gnus-continuum-version "September Gnus v0.1")) + (gnus-convert-old-ticks))))) + + (defun gnus-convert-old-ticks () + (let ((newsrc (cdr gnus-newsrc-alist)) + marks info dormant ticked) + (while (setq info (pop newsrc)) + (when (setq marks (gnus-info-marks info)) + (setq dormant (cdr (assq 'dormant marks)) + ticked (cdr (assq 'tick marks))) + (when (or dormant ticked) + (gnus-info-set-read + info + (gnus-add-to-range + (gnus-info-read info) + (nconc (gnus-uncompress-range dormant) + (gnus-uncompress-range ticked))))))))) + + (defun gnus-read-newsrc-el-file (file) + (let ((ding-file (concat file "d"))) + ;; We always, always read the .eld file. + (gnus-message 5 "Reading %s..." ding-file) + (let (gnus-newsrc-assoc) + (condition-case nil + (load ding-file t t t) + (error + (gnus-error 1 "Error in %s" ding-file))) + (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 + (defun gnus-read-old-newsrc-el-file (file) + (let (newsrc killed marked group m info) + (prog1 + (let ((gnus-killed-assoc nil) + gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) + (prog1 + (condition-case nil + (load file t t t) + (error nil)) + (setq newsrc gnus-newsrc-assoc + killed gnus-killed-assoc + marked gnus-marked-assoc))) + (setq gnus-newsrc-alist nil) + (while (setq group (pop newsrc)) + (if (setq info (gnus-get-info (car group))) + (progn + (gnus-info-set-read info (cddr 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))) + (push (setq info + (list (car group) + (if (nth 1 group) gnus-level-default-subscribed + gnus-level-default-unsubscribed) + (cddr group))) + gnus-newsrc-alist)) + ;; Copy marks into info. + (when (setq m (assoc (car group) marked)) + (unless (nthcdr 3 info) + (nconc info (list nil))) + (gnus-info-set-marks + info (list (cons 'tick (gnus-compress-sequence + (sort (cdr m) '<) t)))))) + (setq newsrc killed) + (while newsrc + (setcar newsrc (caar newsrc)) + (setq newsrc (cdr newsrc))) + (setq gnus-killed-list killed)) + ;; The .el file version of this variable does not begin with + ;; "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))) + (and (not (string-match "\n$" gnus-newsrc-options)) + (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) + ;; Finally, if we read some options lines, we parse them. + (or (string= gnus-newsrc-options "") + (gnus-newsrc-parse-options gnus-newsrc-options)))) + + (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)) + (real-file (concat file "-" (nth 1 gnus-select-method)))) + (if (or (file-exists-p real-file) + (file-exists-p (concat real-file ".el")) + (file-exists-p (concat real-file ".eld"))) + real-file file))) + + (defun gnus-newsrc-to-gnus-format () + (setq gnus-newsrc-options "") + (setq gnus-newsrc-options-n nil) + + (or gnus-active-hashtb + (setq gnus-active-hashtb (make-vector 4095 0))) + (let ((buf (current-buffer)) + (already-read (> (length gnus-newsrc-alist) 1)) + group subscribed options-symbol newsrc Options-symbol + symbol reads num1) + (goto-char (point-min)) + ;; We intern the symbol `options' in the active hashtb so that we + ;; 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 + ;; already exist in that hashtb, so this will save some string + ;; space. + (narrow-to-region + (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 + ;; This concating is quite inefficient, but since our + ;; thorough studies show that approx 99.37% of all + ;; .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) + (progn (beginning-of-line) (point))) + (point))))) + (forward-line -1)) + (symbol + ;; Group names can be just numbers. + (when (numberp symbol) + (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) + (or (boundp symbol) (set symbol nil)) + ;; It was a group name. + (setq subscribed (= (following-char) ?:) + group (symbol-name symbol) + reads nil) + (if (eolp) + ;; If the line ends here, this is clearly a buggy line, so + ;; we put point a the beginning of line and let the cond + ;; below do the error handling. + (beginning-of-line) + ;; We skip to the beginning of the ranges. + (skip-chars-forward "!: \t")) + ;; 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 + ;; faster than save-restriction/narrow, and save-restriction + ;; produces a garbage object. + (setq num1 (progn + (narrow-to-region (match-beginning 0) (match-end 0)) + (read buf))) + (widen) + ;; If the next character is a dash, then this is a range. + (if (= (following-char) ?-) + (progn + ;; We read the upper bound of the range. + (forward-char 1) + (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)) + (widen))) + ;; It was just a simple number, so we add it to the + ;; list of ranges. + (setq reads (cons num1 reads))) + ;; If the next char in ?\n, then we have reached the end + ;; of the line and return nil. + (/= (following-char) ?\n)) + ((= (following-char) ?\n) + ;; End of line, so we end. + 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-error 3.1 "Mangled line: %s" + (buffer-substring (gnus-point-at-bol) + (gnus-point-at-eol))))) + nil)) + ;; Skip past ", ". Spaces are illegal in these ranges, but + ;; we allow them, because it's a common mistake to put a + ;; space after the comma. + (skip-chars-forward ", ")) + + ;; 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) + (if info + ;; There is an entry for this file in the alist. + (progn + (gnus-info-set-read info (nreverse reads)) + ;; We update the level very gently. In fact, we + ;; only change it if there's been a status change + ;; from subscribed to unsubscribed, or vice versa. + (setq level (gnus-info-level info)) + (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) + () + ;; We now have two newsrc lists - `newsrc', which is what we + ;; 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) + (while rc + (or (null (nth 4 (car rc))) ; It's a native group. + (assoc (caar rc) newsrc) ; It's already in the alist. + (if (setq entry (assoc (caar prev) newsrc)) + (setcdr (setq mentry (memq entry newsrc)) + (cons (car rc) (cdr mentry))) + (setq newsrc (cons (car rc) newsrc)))) + (setq prev rc + rc (cdr rc))))) + + (setq gnus-newsrc-alist newsrc) + ;; We make the newsrc hashtb. + (gnus-make-hashtable-from-newsrc-alist) + + ;; Finally, if we read some options lines, we parse them. + (or (string= gnus-newsrc-options "") + (gnus-newsrc-parse-options gnus-newsrc-options)))) + + ;; Parse options lines to find "options -n !all rec.all" and stuff. + ;; The return value will be a list on the form + ;; ((regexp1 . ignore) + ;; (regexp2 . subscribe)...) + ;; When handling new newsgroups, groups that match a `ignore' regexp + ;; will be ignored, and groups that match a `subscribe' regexp will be + ;; 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 + (gnus-set-work-buffer) + (insert (regexp-quote options)) + ;; First we treat all continuation lines. + (goto-char (point-min)) + (while (re-search-forward "\n[ \t]+" nil t) + (replace-match " " t t)) + ;; Then we transform all "all"s into ".+"s. + (goto-char (point-min)) + (while (re-search-forward "\\ball\\b" nil t) + (replace-match ".+" t t)) + (goto-char (point-min)) + ;; We remove all other options than the "-n" ones. + (while (re-search-forward "[ \t]-[^n][^-]*" nil t) + (replace-match " ") + (forward-char -1)) + (goto-char (point-min)) + + ;; 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))) + (gnus-point-at-eol))) + ;; Search for all "words"... + (while (re-search-forward "[^ \t,\n]+" eol t) + (if (= (char-after (match-beginning 0)) ?!) + ;; 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) + "Save .newsrc file." + ;; Note: We cannot save .newsrc file if all newsgroups are removed + ;; from the variable gnus-newsrc-alist. + (when (and (or gnus-newsrc-alist gnus-killed-list) + gnus-current-startup-file) + (save-excursion + (if (and (or gnus-use-dribble-file gnus-slave) + (not force) + (or (not gnus-dribble-buffer) + (not (buffer-name gnus-dribble-buffer)) + (zerop (save-excursion + (set-buffer gnus-dribble-buffer) + (buffer-size))))) + (gnus-message 4 "(No changes need to be saved)") + (run-hooks 'gnus-save-newsrc-hook) + (if gnus-slave + (gnus-slave-save-newsrc) + ;; Save .newsrc. + (when gnus-save-newsrc-file + (gnus-message 5 "Saving %s..." gnus-current-startup-file) + (gnus-gnus-to-newsrc-format) + (gnus-message 5 "Saving %s...done" gnus-current-startup-file)) + ;; Save .newsrc.eld. + (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")) + (setq default-directory (file-name-directory buffer-file-name)) + (gnus-add-current-to-buffer-list) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) + (gnus-gnus-to-quick-newsrc-format) + (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) + (gnus-group-set-mode-line))))) + + (defun gnus-gnus-to-quick-newsrc-format () + "Insert Gnus variables such as gnus-newsrc-alist in lisp format." + (insert ";; Gnus startup file.\n") + (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n") + (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. + (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) + ;; Peel off the "dummy" group. + (gnus-newsrc-alist (cdr gnus-newsrc-alist)) + variable) + ;; Insert the variables into the file. + (while variables + (when (and (boundp (setq variable (pop variables))) + (symbol-value variable)) + (insert "(setq " (symbol-name variable) " '") + (prin1 (symbol-value variable) (current-buffer)) + (insert ")\n"))))) + + (defun gnus-gnus-to-newsrc-format () + ;; Generate and save the .newsrc file. + (save-excursion + (set-buffer (create-file-buffer gnus-current-startup-file)) + (let ((newsrc (cdr gnus-newsrc-alist)) + (standard-output (current-buffer)) + info ranges range method) + (setq buffer-file-name gnus-current-startup-file) + (setq default-directory (file-name-directory buffer-file-name)) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + ;; Write options. + (if gnus-newsrc-options (insert gnus-newsrc-options)) + ;; Write subscribed and unsubscribed. + (while (setq info (pop newsrc)) + ;; Don't write foreign groups to .newsrc. + (when (or (null (setq method (gnus-info-method info))) + (equal method "native") + (gnus-server-equal method gnus-select-method)) + (insert (gnus-info-group info) + (if (> (gnus-info-level info) gnus-level-subscribed) + "!" ":")) + (when (setq ranges (gnus-info-read info)) + (insert " ") + (if (not (listp (cdr ranges))) + (if (= (car ranges) (cdr ranges)) + (princ (car ranges)) + (princ (car ranges)) + (insert "-") + (princ (cdr ranges))) + (while (setq range (pop ranges)) + (if (or (atom range) (= (car range) (cdr range))) + (princ (or (and (atom range) range) (car range))) + (princ (car range)) + (insert "-") + (princ (cdr range))) + (if ranges (insert ","))))) + (insert "\n"))) + (make-local-variable 'version-control) + (setq version-control 'never) + ;; 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. + (if gnus-modtime-botch + (delete-file gnus-startup-file) + (clear-visited-file-modtime)) + (run-hooks 'gnus-save-standard-newsrc-hook) + (save-buffer) + (kill-buffer (current-buffer))))) + + + ;;; + ;;; Slave functions. + ;;; + + (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) + "-slave-"))) + t)) + file) + (if (not slave-files) + () ; There are no slave files to read. + (gnus-message 7 "Reading slave newsrcs...") + (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) + (or (< (caar f1) (caar f2)) + (< (nth 1 (car f1)) (nth 1 (car f2))))))) + (while slave-files + (erase-buffer) + (setq file (nth 1 (car slave-files))) + (insert-file-contents file) + (if (condition-case () + (progn + (eval-buffer (current-buffer)) + t) + (error + (gnus-error 3.2 "Possible error in %s" file) + nil)) + (or gnus-slave ; Slaves shouldn't delete these files. + (condition-case () + (delete-file file) + (error nil)))) + (setq slave-files (cdr slave-files)))) + (gnus-message 7 "Reading slave newsrcs...done")))) + + + ;;; + ;;; Group description. + ;;; + + (defun gnus-read-all-descriptions-files () + (let ((methods (cons gnus-select-method + (nconc + (when (gnus-archive-server-wanted-p) + (list "archive")) + gnus-secondary-select-methods)))) + (while methods + (gnus-read-descriptions-file (car methods)) + (setq methods (cdr methods))) + t)) + + (defun gnus-read-descriptions-file (&optional method) + (let ((method (or method gnus-select-method)) + group) + (when (stringp method) + (setq method (gnus-server-to-method method))) + ;; 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) + ((not (gnus-request-list-newsgroups method)) + (gnus-message 1 "Couldn't read newsgroups descriptions") + nil) + (t + (save-excursion + (save-restriction + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (when (or (search-forward "\n.\n" nil t) + (goto-char (point-max))) + (beginning-of-line) + (narrow-to-region (point-min) (point))) + ;; 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))) + (let ((prefix (gnus-group-prefixed-name "" method))) + (goto-char (point-min)) + (while (and (not (eobp)) + (progn (insert prefix) + (zerop (forward-line 1))))))) + (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 + ;; hash table. + (read nntp-server-buffer)) + (error 0))) + (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") + t)))) + + (defun gnus-group-get-description (group) + "Get the description of a group by sending XGTITLE to the server." + (when (gnus-request-group-description group) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") + (match-string 1))))) + + (provide 'gnus-start) + + ;;; gnus-start.el ends here *** pub/rgnus/lisp/gnus-sum.el Tue Jul 30 22:59:20 1996 --- rgnus/lisp/gnus-sum.el Tue Jul 30 22:08:07 1996 *************** *** 0 **** --- 1,7254 ---- + ;;; gnus-sum.el --- summary mode commands for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-group) + (require 'gnus-spec) + (require 'gnus-range) + (require 'gnus-int) + (require 'gnus) + + + (defvar gnus-kill-summary-on-exit t + "*If non-nil, kill the summary buffer when you exit from it. + If nil, the summary will become a \"*Dead Summary*\" buffer, and + it will be killed sometime later.") + + (defvar gnus-fetch-old-headers nil + "*Non-nil means that Gnus will try to build threads by grabbing old headers. + If an unread article in the group refers to an older, already read (or + 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.") + + (defvar gnus-summary-make-false-root 'adopt + "*nil means that Gnus won't gather loose threads. + 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. + + If this variable is non-nil, it should be one of `none', `adopt', + `dummy' or `empty'. + + If this variable is `none', Gnus will not make a false root, but just + present the sub-threads after another. + If this variable is `dummy', Gnus will create a dummy root that will + have all the sub-threads as children. + 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)$" + "*A regexp to match subjects to be excluded from loose thread gathering. + As loose thread gathering is done on subjects only, that means that + there can be many false gatherings performed. By rooting out certain + common subjects, gathering might become saner.") + + (defvar gnus-summary-gather-subject-limit nil + "*Maximum length of subject comparisons when gathering loose threads. + Use nil to compare full subjects. Setting this variable to a low + number will help gather threads that have been corrupted by + newsreaders chopping off subject lines, but it might also mean that + unrelated articles that have subject that happen to begin with the + same few characters will be incorrectly gathered. + + 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 fuzzily.") + + (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 `more', fill in all leaf nodes that Gnus can find. 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. + This variable will only be used if the value of + `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-summary-default-score 0 + "*Default article score level. + If this variable is nil, scoring will be disabled.") + + (defvar gnus-summary-zcore-fuzz 0 + "*Fuzziness factor for the zcore in the summary buffer. + Articles with scores closer than this to `gnus-summary-default-score' + will not be marked.") + + (defvar gnus-simplify-subject-fuzzy-regexp nil + "*Strings to be removed when doing fuzzy matches. + This can either be a regular expression or list of regular expressions + that will be removed from subject strings if fuzzy subject + simplification is selected.") + + (defvar gnus-show-threads t + "*If non-nil, display threads in summary mode.") + + (defvar gnus-thread-hide-subtree nil + "*If non-nil, hide all threads initially. + If threads are hidden, you have to run the command + `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' + to expose hidden threads.") + + (defvar gnus-thread-hide-killed t + "*If non-nil, hide killed threads automatically.") + + (defvar gnus-thread-ignore-subject nil + "*If non-nil, ignore subjects and do all threading based on the Reference header. + If nil, which is the default, articles that have different subjects + from their parents will start separate threads.") + + (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 + variable is `fuzzy', only articles that have subjects that are fuzzily + equal will be included.") + + (defvar gnus-thread-indent-level 4 + "*Number that says how much each sub-thread should be indented.") + + (defvar gnus-auto-extend-newsgroup t + "*If non-nil, extend newsgroup forward and backward when requested.") + + (defvar gnus-auto-select-first t + "*If nil, don't select the first unread article when entering a group. + If this variable is `best', select the highest-scored unread article + in the group. If neither nil nor `best', select the first unread + article. + + 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 + confirmation if you are located on the last article in the group. + Finally, if this variable is `slightly-quietly', the `Z n' command + will go to the next group without confirmation.") + + (defvar gnus-auto-select-same nil + "*If non-nil, select the next article with the same subject.") + + (defvar gnus-summary-check-current nil + "*If non-nil, consider the current article when moving. + The \"unread\" movement commands will stay on the same line if the + current article is unread.") + + (defvar gnus-auto-center-summary t + "*If non-nil, always center the current summary buffer. + In particular, if `vertical' do only vertical recentering. If non-nil + and non-`vertical', do both horizontal and vertical recentering.") + + (defvar gnus-show-all-headers nil + "*If non-nil, don't hide any headers.") + + (defvar gnus-single-article-buffer t + "*If non-nil, display all articles in the same buffer. + If nil, each group will get its own article buffer.") + + (defvar gnus-break-pages t + "*If non-nil, do page breaking on articles. + The page delimiter is specified by the `gnus-page-delimiter' + variable.") + + (defvar gnus-show-mime nil + "*If non-nil, do mime processing of articles. + The articles will simply be fed to the function given by + `gnus-show-mime-method'.") + + (defvar gnus-move-split-methods nil + "*Variable used to suggest where articles are to be moved to. + It uses the same syntax as the `gnus-split-methods' variable.") + + ;; Mark variables suggested by Thomas Michanek + ;; . + (defvar gnus-unread-mark ? + "*Mark used for unread articles.") + (defvar gnus-ticked-mark ?! + "*Mark used for ticked articles.") + (defvar gnus-dormant-mark ?? + "*Mark used for dormant articles.") + (defvar gnus-del-mark ?r + "*Mark used for del'd articles.") + (defvar gnus-read-mark ?R + "*Mark used for read articles.") + (defvar gnus-expirable-mark ?E + "*Mark used for expirable articles.") + (defvar gnus-killed-mark ?K + "*Mark used for killed articles.") + (defvar gnus-souped-mark ?F + "*Mark used for killed articles.") + (defvar gnus-kill-file-mark ?X + "*Mark used for articles killed by kill files.") + (defvar gnus-low-score-mark ?Y + "*Mark used for articles with a low score.") + (defvar gnus-catchup-mark ?C + "*Mark used for articles that are caught up.") + (defvar gnus-replied-mark ?A + "*Mark used for articles that have been replied to.") + (defvar gnus-cached-mark ?* + "*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-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 ?+ + "*Score mark used for articles with high scores.") + (defvar gnus-score-below-mark ?- + "*Score mark used for articles with low scores.") + (defvar gnus-empty-thread-mark ? + "*There is no thread under the article.") + (defvar gnus-not-empty-thread-mark ?= + "*There is a thread under the article.") + + (defvar gnus-view-pseudo-asynchronously nil + "*If non-nil, Gnus will view pseudo-articles asynchronously.") + + (defvar gnus-view-pseudos nil + "*If `automatic', pseudo-articles will be viewed automatically. + If `not-confirm', pseudos will be viewed automatically, and the user + will not be asked to confirm the command.") + + (defvar gnus-view-pseudos-separately t + "*If non-nil, one pseudo-article will be created for each file to be viewed. + If nil, all files that use the same viewing command will be given as a + list of parameters to that command.") + + (defvar gnus-insert-pseudo-articles t + "*If non-nil, insert pseudo-articles when decoding articles.") + + (defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + "*The format specification of the lines in the summary buffer. + + It works along the same lines as a normal formatting string, + with some simple extensions. + + %N Article number, left padded with spaces (string) + %S Subject (string) + %s Subject if it is at the root of a thread, and \"\" otherwise (string) + %n Name of the poster (string) + %a Extracted name of the poster (string) + %A Extracted address of the poster (string) + %F Contents of the From: header (string) + %x Contents of the Xref: header (string) + %D Date of the article (string) + %d Date of the article (string) in DD-MMM format + %M Message-id of the article (string) + %r References of the article (string) + %c Number of characters in the article (integer) + %L Number of lines in the article (integer) + %I Indentation based on thread level (a string of spaces) + %T A string with two possible values: 80 spaces if the article + is on thread level two or larger and 0 spaces on level one + %R \"A\" if this article has been replied to, \" \" otherwise (character) + %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") + %[ Opening bracket (character, \"[\" or \"<\") + %] Closing bracket (character, \"]\" or \">\") + %> Spaces of length thread-level (string) + %< Spaces of length (- 20 thread-level) (string) + %i Article score (number) + %z Article zcore (character) + %t Number of articles under the current thread (number). + %e Whether the thread is empty or not (character). + %l GroupLens score (string). + %u User defined specifier. The next character in the format string should + be a letter. Gnus will call the function gnus-user-format-function-X, + where X is the letter following %u. The function will be passed the + current header as argument. The function should return a string, which + will be inserted into the summary just like information from any other + 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. + + %S The subject") + + (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" + "*The format specification for the summary mode line. + It works along the same lines as a normal formatting string, + with some simple extensions: + + %G Group name + %p Unprefixed group name + %A Current article number + %V Gnus version + %U Number of unread articles in the group + %e Number of unselected articles in the group + %Z A string with unread/unselected article counts + %g Shortish group name + %S Subject of the current article + %u User-defined spec + %s Current score file name + %d Number of dormant articles + %r Number of articles that have been marked as read in this session + %E Number of articles expunged by the score files") + + (defvar gnus-summary-mark-below 0 + "*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. + By default, threads are sorted by article number. + + 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', + `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and + `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').") + + (defvar gnus-thread-score-function '+ + "*Function used for calculating the total score of a thread. + + The function is called with the scores of the article and each + subthread and should then return the score of the thread. + + Some functions you can use are `+', `max', or `min'.") + + (defvar gnus-summary-expunge-below nil + "All articles that have a score less than this variable will be expunged.") + + (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-summary-mode-hook nil + "*A hook for Gnus summary mode. + This hook is run before any variables are set in the summary buffer.") + + (defvar gnus-summary-exit-hook nil + "*A hook called on exit from the summary buffer.") + + (defvar gnus-summary-prepare-hook nil + "*A hook called after the summary buffer has been generated. + If you want to modify the summary buffer, you can use this hook.") + + (defvar gnus-summary-generate-hook nil + "*A hook run just before generating the summary buffer. + This hook is commonly used to customize threading variables and the + like.") + + (defvar gnus-select-group-hook nil + "*A hook called when a newsgroup is selected. + + If you'd like to simplify subjects like the + `gnus-summary-next-same-subject' command does, you can use the + following hook: + + (setq gnus-select-group-hook + (list + (lambda () + (mapcar (lambda (header) + (mail-header-set-subject + header + (gnus-simplify-subject + (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-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.") + (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522) + + (defvar gnus-exit-group-hook nil + "*A hook called when exiting (not quitting) summary mode.") + + (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. + + The default function `gnus-summary-highlight-line' will + highlight the line according to the `gnus-summary-highlight' + variable.") + + (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) + "*A hook called when an article is selected for the first time. + The hook is intended to mark an article as read (or unread) + automatically when it is selected.") + + (defvar gnus-summary-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. + (let ((table (or (copy-sequence standard-display-table) + (make-display-table))) + ;; Nix out all the control chars... + (i 32)) + (while (>= (setq i (1- i)) 0) + (aset table i [??])) + ;; ... but not newline and cr, of course. (cr is necessary for the + ;; selective display). + (aset table ?\n nil) + (aset 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 table i) + (aset table i [??])))) + table) + "Display table used in summary mode buffers.") + + ;;; Internal variables + + (defvar gnus-original-article-buffer " *Original Article*") + (defvar gnus-original-article nil) + (defvar gnus-article-internal-prepare-hook nil) + + (defvar gnus-thread-indent-array nil) + (defvar gnus-thread-indent-array-level gnus-thread-indent-level) + + ;; Avoid highlighting in kill files. + (defvar gnus-summary-inhibit-highlight nil) + (defvar gnus-newsgroup-selected-overlay nil) + (defvar gnus-inhibit-limiting nil) + (defvar gnus-newsgroup-adaptive-score-file nil) + (defvar gnus-current-score-file nil) + (defvar gnus-current-move-group nil) + (defvar gnus-current-copy-group nil) + (defvar gnus-current-crosspost-group nil) + + (defvar gnus-newsgroup-dependencies nil) + (defvar gnus-newsgroup-adaptive nil) + (defvar gnus-summary-display-article-function nil) + (defvar gnus-summary-highlight-line-function nil + "Function called after highlighting a summary line.") + + (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) + (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) + (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) + (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) + (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) + (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) + (?L gnus-tmp-lines ?d) + (?I gnus-tmp-indentation ?s) + (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) + (?R gnus-tmp-replied ?c) + (?\[ gnus-tmp-opening-bracket ?c) + (?\] gnus-tmp-closing-bracket ?c) + (?\> (make-string gnus-tmp-level ? ) ?s) + (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) + (?i gnus-tmp-score ?d) + (?z gnus-tmp-score-char ?c) + (?l (bbb-grouplens-score gnus-tmp-header) ?s) + (?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)) + "An alist of format specifications that can appear in summary lines, + 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) + (?A gnus-tmp-article-number ?d) + (?Z gnus-tmp-unread-and-unselected ?s) + (?V gnus-version ?s) + (?U gnus-tmp-unread-and-unticked ?d) + (?S gnus-tmp-subject ?s) + (?e gnus-tmp-unselected ?d) + (?u gnus-tmp-user-defined ?s) + (?d (length gnus-newsgroup-dormant) ?d) + (?t (length gnus-newsgroup-marked) ?d) + (?r (length gnus-newsgroup-reads) ?d) + (?E gnus-newsgroup-expunged-tally ?d) + (?s (gnus-current-score-file-nondirectory) ?s))) + + (defvar gnus-last-search-regexp nil + "Default regexp for article search command.") + + (defvar gnus-last-shell-command nil + "Default shell command on article.") + + (defvar gnus-newsgroup-begin nil) + (defvar gnus-newsgroup-end nil) + (defvar gnus-newsgroup-last-rmail nil) + (defvar gnus-newsgroup-last-mail nil) + (defvar gnus-newsgroup-last-folder nil) + (defvar gnus-newsgroup-last-file nil) + (defvar gnus-newsgroup-auto-expire nil) + (defvar gnus-newsgroup-active nil) + + (defvar gnus-newsgroup-data nil) + (defvar gnus-newsgroup-data-reverse nil) + (defvar gnus-newsgroup-limit nil) + (defvar gnus-newsgroup-limits nil) + + (defvar gnus-newsgroup-unreads nil + "List of unread articles in the current newsgroup.") + + (defvar gnus-newsgroup-unselected nil + "List of unselected unread articles in the current newsgroup.") + + (defvar gnus-newsgroup-reads nil + "Alist of read articles and article marks in the current newsgroup.") + + (defvar gnus-newsgroup-expunged-tally nil) + + (defvar gnus-newsgroup-marked nil + "List of ticked articles in the current newsgroup (a subset of unread art).") + + (defvar gnus-newsgroup-killed nil + "List of ranges of articles that have been through the scoring process.") + + (defvar gnus-newsgroup-cached nil + "List of articles that come from the article cache.") + + (defvar gnus-newsgroup-saved nil + "List of articles that have been saved.") + + (defvar gnus-newsgroup-kill-headers nil) + + (defvar gnus-newsgroup-replied nil + "List of articles that have been replied to in the current newsgroup.") + + (defvar gnus-newsgroup-expirable nil + "List of articles in the current newsgroup that can be expired.") + + (defvar gnus-newsgroup-processable nil + "List of articles in the current newsgroup that can be processed.") + + (defvar gnus-newsgroup-bookmarks nil + "List of articles in the current newsgroup that have bookmarks.") + + (defvar gnus-newsgroup-dormant nil + "List of dormant articles in the current newsgroup.") + + (defvar gnus-newsgroup-scored nil + "List of scored articles in the current newsgroup.") + + (defvar gnus-newsgroup-headers nil + "List of article headers in the current newsgroup.") + + (defvar gnus-newsgroup-threads nil) + + (defvar gnus-newsgroup-prepared nil + "Whether the current group has been prepared properly.") + + (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) + (defvar gnus-have-all-headers nil) + (defvar gnus-last-article nil) + (defvar gnus-newsgroup-history 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-thread-expunge-below + gnus-score-alist gnus-current-score-file gnus-summary-expunge-below + (gnus-summary-mark-below . global) + 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-reffed-article-number . -1) + (gnus-newsgroup-expunged-tally . 0) + gnus-cache-removable-articles gnus-newsgroup-cached + gnus-newsgroup-data gnus-newsgroup-data-reverse + gnus-newsgroup-limit gnus-newsgroup-limits) + "Variables that are buffer-local to the summary buffers.") + + ;; Byte-compiler warning. + (defvar gnus-article-mode-map) + + ;; Subject simplification. + + (defsubst gnus-simplify-subject-re (subject) + "Remove \"Re:\" from subject lines." + (if (string-match "^[Rr][Ee]: *" subject) + (substring subject (match-end 0)) + subject)) + + (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)) + + ;; Remove any leading "re:"s, any trailing paren phrases, and simplify + ;; all whitespace. + ;; Written by Stainless Steel Rat . + (defun gnus-simplify-buffer-fuzzy () + (let ((case-fold-search t)) + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (replace-match " " t t)) + (goto-char (point-min)) + (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t) + (goto-char (match-beginning 0)) + (while (or + (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") + (looking-at "^[[].*: .*[]]$")) + (goto-char (point-min)) + (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" + nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (while (re-search-forward "^[[].*: .*[]]$" nil t) + (goto-char (match-end 0)) + (delete-char -1) + (delete-region + (progn (goto-char (match-beginning 0))) + (re-search-forward ":")))) + (goto-char (point-min)) + (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (while (re-search-forward " +" nil t) + (replace-match " " t t)) + (goto-char (point-min)) + (while (re-search-forward " $" nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (while (re-search-forward "^ +" nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (when gnus-simplify-subject-fuzzy-regexp + (if (listp gnus-simplify-subject-fuzzy-regexp) + (let ((list gnus-simplify-subject-fuzzy-regexp)) + (while list + (goto-char (point-min)) + (while (re-search-forward (car list) nil t) + (replace-match "" t t)) + (setq list (cdr list)))) + (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) + (replace-match "" t t)))))) + + (defun gnus-simplify-subject-fuzzy (subject) + "Siplify a subject string fuzzily." + (save-excursion + (gnus-set-work-buffer) + (let ((case-fold-search t)) + (insert subject) + (inline (gnus-simplify-buffer-fuzzy)) + (buffer-string)))) + + (defsubst gnus-simplify-subject-fully (subject) + "Simplify a subject string according to the user's wishes." + (cond + ((null gnus-summary-gather-subject-limit) + (gnus-simplify-subject-re subject)) + ((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 + ((null simple-first) + (equal (gnus-simplify-subject-fully s1) + (gnus-simplify-subject-fully s2))) + (t + (equal s1 + (gnus-simplify-subject-fully s2))))) + + (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 + (and (setq bufname (buffer-name (car buflist))) + (string-match "Summary" bufname) + (save-excursion + (set-buffer bufname) + ;; We check that this is, indeed, a summary buffer. + (and (eq major-mode 'gnus-summary-mode) + ;; Also make sure this isn't bogus. + gnus-newsgroup-prepared)) + (push bufname buffers)) + (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))))) + + (defun gnus-summary-bubble-group () + "Increase the score of the current group. + This is a handy function to add to `gnus-summary-exit-hook' to + increase the score of each group you read." + (gnus-group-add-score gnus-newsgroup-name)) + + + ;;; + ;;; 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 + [delete] 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-article-hide-headers + "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 + "\C-c\C-b" gnus-bug + "*" gnus-cache-enter-article + "\M-*" gnus-cache-remove-article + "\M-&" gnus-summary-universal-argument + "\C-l" gnus-recenter + "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 + "j" gnus-summary-goto-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 + "^" gnus-summary-reparent-thread + "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 + [delete] 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 + "e" gnus-article-emphasize + "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-article-hide-headers + "v" gnus-summary-verbose-headers + "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 + "P" gnus-article-hide-pem + "\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 + [delete] 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) + ) + + + + (defun gnus-summary-mode (&optional group) + "Major mode for reading articles. + + All normal editing commands are switched off. + \\ + 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: + + \\{gnus-summary-mode-map}" + (interactive) + (when (and menu-bar-mode + (gnus-visual-p 'summary-menu 'menu)) + (gnus-summary-make-menu-bar)) + (kill-all-local-variables) + (gnus-summary-make-local-variables) + (gnus-make-thread-indent-array) + (gnus-simplify-mode-line) + (setq major-mode 'gnus-summary-mode) + (setq mode-name "Summary") + (make-local-variable 'minor-mode-alist) + (use-local-map gnus-summary-mode-map) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) ;Disable modification + (setq truncate-lines t) + (setq selective-display t) + (setq selective-display-ellipses t) ;Display `...' + (setq buffer-display-table gnus-summary-display-table) + (setq gnus-newsgroup-name group) + (make-local-variable 'gnus-summary-line-format) + (make-local-variable 'gnus-summary-line-format-spec) + (make-local-variable 'gnus-summary-mark-positions) + (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) + (gnus-update-summary-mark-positions) + (gnus-make-local-hook 'post-command-hook) + (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) + (run-hooks 'gnus-summary-mode-hook)) + + (defun gnus-summary-make-local-variables () + "Make all the local summary buffer variables." + (let ((locals gnus-summary-local-variables) + global local) + (while (setq local (pop locals)) + (if (consp local) + (progn + (if (eq (cdr local) 'global) + ;; Copy the global value of the variable. + (setq global (symbol-value (car local))) + ;; Use the value from the list. + (setq global (eval (cdr local)))) + (make-local-variable (car local)) + (set (car local) global)) + ;; Simple nil-valued local variable. + (make-local-variable local) + (set local nil))))) + + (defun gnus-summary-clear-local-variables () + (let ((locals gnus-summary-local-variables)) + (while locals + (if (consp (car locals)) + (and (vectorp (caar locals)) + (set (caar locals) nil)) + (and (vectorp (car locals)) + (set (car locals) nil))) + (setq locals (cdr locals))))) + + ;; Summary data functions. + + (defmacro gnus-data-number (data) + `(car ,data)) + + (defmacro gnus-data-set-number (data number) + `(setcar ,data ,number)) + + (defmacro gnus-data-mark (data) + `(nth 1 ,data)) + + (defmacro gnus-data-set-mark (data mark) + `(setcar (nthcdr 1 ,data) ,mark)) + + (defmacro gnus-data-pos (data) + `(nth 2 ,data)) + + (defmacro gnus-data-set-pos (data pos) + `(setcar (nthcdr 2 ,data) ,pos)) + + (defmacro gnus-data-header (data) + `(nth 3 ,data)) + + (defmacro gnus-data-level (data) + `(nth 4 ,data)) + + (defmacro gnus-data-unread-p (data) + `(= (nth 1 ,data) gnus-unread-mark)) + + (defmacro gnus-data-pseudo-p (data) + `(consp (nth 3 ,data))) + + (defmacro gnus-data-find (number) + `(assq ,number gnus-newsgroup-data)) + + (defmacro gnus-data-find-list (number &optional data) + `(let ((bdata ,(or data 'gnus-newsgroup-data))) + (memq (assq ,number bdata) + bdata))) + + (defmacro gnus-data-make (number mark pos header level) + `(list ,number ,mark ,pos ,header ,level)) + + (defun gnus-data-enter (after-article number mark pos header level offset) + (let ((data (gnus-data-find-list after-article))) + (or data (error "No such article: %d" after-article)) + (setcdr data (cons (gnus-data-make number mark pos header level) + (cdr data))) + (setq gnus-newsgroup-data-reverse nil) + (gnus-data-update-list (cddr data) offset))) + + (defun gnus-data-enter-list (after-article list &optional offset) + (when list + (let ((data (and after-article (gnus-data-find-list after-article))) + (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) + (progn + (setcdr list gnus-newsgroup-data) + (setq gnus-newsgroup-data ilist) + (and offset (gnus-data-update-list (cdr list) offset))) + (setcdr list (cdr data)) + (setcdr data ilist) + (and offset (gnus-data-update-list (cdr data) offset))) + (setq gnus-newsgroup-data-reverse nil)))) + + (defun gnus-data-remove (article &optional offset) + (let ((data gnus-newsgroup-data)) + (if (= (gnus-data-number (car data)) article) + (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) + gnus-newsgroup-data-reverse nil) + (while (cdr data) + (and (= (gnus-data-number (cadr data)) article) + (progn + (setcdr data (cddr data)) + (and offset (gnus-data-update-list (cdr data) offset)) + (setq data nil + gnus-newsgroup-data-reverse nil))) + (setq data (cdr data)))))) + + (defmacro gnus-data-list (backward) + `(if ,backward + (or gnus-newsgroup-data-reverse + (setq gnus-newsgroup-data-reverse + (reverse gnus-newsgroup-data))) + gnus-newsgroup-data)) + + (defun gnus-data-update-list (data offset) + "Add OFFSET to the POS of all data entries in DATA." + (while data + (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) + (setq data (cdr data)))) + + (defun gnus-data-compute-positions () + "Compute the positions of all articles." + (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))) + (setq data (cdr data))))) + + (defun gnus-summary-article-pseudo-p (article) + "Say whether this article is a pseudo article or not." + (not (vectorp (gnus-data-header (gnus-data-find article))))) + + (defun gnus-article-parent-p (number) + "Say whether this article is a parent or not." + (let ((data (gnus-data-find-list number))) + (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)))))) + + (defun gnus-article-children (number) + "Return a list of all children to NUMBER." + (let* ((data (gnus-data-find-list number)) + (level (gnus-data-level (car data))) + children) + (setq data (cdr data)) + (while (and data + (= (gnus-data-level (car data)) (1+ level))) + (push (gnus-data-number (car data)) children) + (setq data (cdr data))) + children)) + + (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))) + (and to (gnus-summary-goto-subject to)))) + + (defmacro gnus-summary-article-intangible-p () + "Say whether this article is intangible or not." + '(get-text-property (point) 'gnus-intangible)) + + ;; Some summary mode macros. + + (defmacro gnus-summary-article-number () + "The article number of the article on the current line. + If there isn's an article number here, then we return the current + 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) + `(gnus-data-header (gnus-data-find + ,(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 + ,(or number '(gnus-summary-article-number))))) + + (defmacro gnus-summary-article-pos (&optional number) + `(gnus-data-pos (gnus-data-find + ,(or number '(gnus-summary-article-number))))) + + (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) + (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) + gnus-newsgroup-data))))) + (and headers + (vectorp headers) + (mail-header-subject headers)))) + + (defmacro gnus-summary-article-score (&optional number) + "Return current article score." + `(or (cdr (assq ,(or number '(gnus-summary-article-number)) + gnus-newsgroup-scored)) + gnus-summary-default-score 0)) + + (defun gnus-summary-article-children (&optional number) + (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) + (level (gnus-data-level (car data))) + l children) + (while (and (setq data (cdr data)) + (> (setq l (gnus-data-level (car data))) level)) + (and (= (1+ level) l) + (setq children (cons (gnus-data-number (car data)) + children)))) + (nreverse children))) + + (defun gnus-summary-article-parent (&optional number) + (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) + (gnus-data-list t))) + (level (gnus-data-level (car data)))) + (if (zerop level) + () ; This is a root. + ;; We search until we find an article with a level less than + ;; this one. That function has to be the parent. + (while (and (setq data (cdr data)) + (not (< (gnus-data-level (car data)) level)))) + (and data (gnus-data-number (car data)))))) + + (defun gnus-unread-mark-p (mark) + "Say whether MARK is the unread mark." + (= mark gnus-unread-mark)) + + (defun gnus-read-mark-p (mark) + "Say whether MARK is one of the marks that mark as read. + This is all marks except unread, ticked, dormant, and expirable." + (not (or (= mark gnus-unread-mark) + (= mark gnus-ticked-mark) + (= mark gnus-dormant-mark) + (= mark gnus-expirable-mark)))) + + ;; Saving hidden threads. + + (put 'gnus-save-hidden-threads 'lisp-indent-function 0) + (put 'gnus-save-hidden-threads 'lisp-indent-hook 0) + (put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) + + (defmacro gnus-save-hidden-threads (&rest forms) + "Save hidden threads, eval FORMS, and restore the hidden threads." + (let ((config (make-symbol "config"))) + `(let ((,config (gnus-hidden-threads-configuration))) + (unwind-protect + (progn + ,@forms) + (gnus-restore-hidden-threads-configuration ,config))))) + + (defun gnus-hidden-threads-configuration () + "Return the current hidden threads configuration." + (save-excursion + (let (config) + (goto-char (point-min)) + (while (search-forward "\r" nil t) + (push (1- (point)) config)) + config))) + + (defun gnus-restore-hidden-threads-configuration (config) + "Restore hidden threads configuration from CONFIG." + (let (point buffer-read-only) + (while (setq point (pop config)) + (when (and (< point (point-max)) + (goto-char point) + (= (following-char) ?\n)) + (subst-char-in-region point (1+ point) ?\n ?\r))))) + + ;; Various summary mode internalish functions. + + (defun gnus-mouse-pick-article (e) + (interactive "e") + (mouse-set-point e) + (gnus-summary-next-page nil t)) + + (defun gnus-summary-setup-buffer (group) + "Initialize summary buffer." + (let ((buffer (concat "*Summary " group "*"))) + (if (get-buffer buffer) + (progn + (set-buffer buffer) + (setq gnus-summary-buffer (current-buffer)) + (not gnus-newsgroup-prepared)) + ;; Fix by Sudish Joseph + (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-article-current) + (make-local-variable 'gnus-original-article-buffer)) + (setq gnus-newsgroup-name group) + t))) + + (defun gnus-set-global-variables () + ;; 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) + (unread gnus-newsgroup-unreads) + (headers gnus-current-headers) + (data gnus-newsgroup-data) + (summary gnus-summary-buffer) + (article-buffer gnus-article-buffer) + (original gnus-original-article-buffer) + (gac gnus-article-current) + (reffed gnus-reffed-article-number) + (score-file gnus-current-score-file)) + (save-excursion + (set-buffer gnus-group-buffer) + (setq gnus-newsgroup-name name) + (setq gnus-newsgroup-marked marked) + (setq gnus-newsgroup-unreads unread) + (setq gnus-current-headers headers) + (setq gnus-newsgroup-data data) + (setq gnus-article-current gac) + (setq gnus-summary-buffer summary) + (setq gnus-article-buffer article-buffer) + (setq gnus-original-article-buffer original) + (setq gnus-reffed-article-number reffed) + (setq gnus-current-score-file score-file))))) + + (defun gnus-summary-last-article-p (&optional article) + "Return whether ARTICLE is the last article in the buffer." + (if (not (setq article (or article (gnus-summary-article-number)))) + t ; All non-existant numbers are the last article. :-) + (not (cdr (gnus-data-find-list article))))) + + (defun gnus-make-thread-indent-array () + (let ((n 200)) + (unless (and gnus-thread-indent-array + (= gnus-thread-indent-level gnus-thread-indent-array-level)) + (setq gnus-thread-indent-array (make-vector 201 "") + gnus-thread-indent-array-level gnus-thread-indent-level) + (while (>= n 0) + (aset gnus-thread-indent-array n + (make-string (* n gnus-thread-indent-level) ? )) + (setq n (1- n)))))) + + (defun gnus-update-summary-mark-positions () + "Compute where the summary marks are to go." + (save-excursion + (when (and gnus-summary-buffer + (get-buffer gnus-summary-buffer) + (buffer-name (get-buffer gnus-summary-buffer))) + (set-buffer gnus-summary-buffer)) + (let ((gnus-replied-mark 129) + (gnus-score-below-mark 130) + (gnus-score-over-mark 130) + (thread nil) + (gnus-visual nil) + (spec gnus-summary-line-format-spec) + pos) + (save-excursion + (gnus-set-work-buffer) + (let ((gnus-summary-line-format-spec spec)) + (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) + (- (point) 2))))) + (goto-char (point-min)) + (push (cons 'replied (and (search-forward "\201" nil t) + (- (point) 2))) + pos) + (goto-char (point-min)) + (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) + pos))) + (setq gnus-summary-mark-positions pos)))) + + (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) + "Insert a dummy root in the summary buffer." + (beginning-of-line) + (gnus-add-text-properties + (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) + (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) + + (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)) + (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) + (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) + (gnus-tmp-score-char + (if (or (null gnus-summary-default-score) + (<= (abs (- gnus-tmp-score gnus-summary-default-score)) + gnus-summary-zcore-fuzz)) ? + (if (< gnus-tmp-score gnus-summary-default-score) + gnus-score-below-mark gnus-score-over-mark))) + (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) + ((memq gnus-tmp-current gnus-newsgroup-cached) + gnus-cached-mark) + (gnus-tmp-replied gnus-replied-mark) + ((memq gnus-tmp-current gnus-newsgroup-saved) + 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))) + (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)))) + (t gnus-tmp-from))) + (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) + (gnus-tmp-number (mail-header-number gnus-tmp-header)) + (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) + (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) + (buffer-read-only nil)) + (when (string= gnus-tmp-name "") + (setq gnus-tmp-name gnus-tmp-from)) + (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) + (gnus-put-text-property + (point) + (progn (eval gnus-summary-line-format-spec) (point)) + 'gnus-number gnus-tmp-number) + (when (gnus-visual-p 'summary-highlight 'highlight) + (forward-line -1) + (run-hooks 'gnus-summary-update-hook) + (forward-line 1)))) + + (defun gnus-summary-update-line (&optional dont-update) + ;; Update summary line after change. + (when (and gnus-summary-default-score + (not gnus-summary-inhibit-highlight)) + (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. + (article (gnus-summary-article-number)) + (score (gnus-summary-article-score article))) + (unless dont-update + (if (and gnus-summary-mark-below + (< (gnus-summary-article-score) + gnus-summary-mark-below)) + ;; This article has a low score, so we mark it as read. + (when (memq article gnus-newsgroup-unreads) + (gnus-summary-mark-article-as-read gnus-low-score-mark)) + (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) + (<= (abs (- score gnus-summary-default-score)) + gnus-summary-zcore-fuzz)) ? + (if (< score gnus-summary-default-score) + gnus-score-below-mark gnus-score-over-mark)) 'score)) + ;; Do visual highlighting. + (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 0)))) + (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))) + + (defun gnus-summary-set-local-parameters (group) + "Go through the local params of GROUP and set all variable specs in that list." + (let ((params (gnus-info-params (gnus-get-info group))) + elem) + (while params + (setq elem (car params) + params (cdr params)) + (and (consp elem) ; Has to be a cons. + (consp (cdr elem)) ; The cdr has to be a list. + (symbolp (car elem)) ; Has to be a symbol in there. + (not (memq (car elem) + '(quit-config to-address to-list to-group))) + (progn ; So we set it. + (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. + If NO-ARTICLE is non-nil, no article is selected initially. + If NO-DISPLAY, don't generate a summary buffer." + (gnus-message 5 "Retrieving newsgroup: %s..." group) + (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)) + (if (not quit-config) + (progn + (set-buffer gnus-group-buffer) + (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))))) + (gnus-message 3 "Can't select group") + nil) + ;; The user did a `C-g' while prompting for number of articles, + ;; so we exit this group. + ((eq did-select 'quit) + (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) + (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)))) + ;; 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. + (run-hooks 'gnus-select-group-hook) + ;; Set any local variables in the group parameters. + (gnus-summary-set-local-parameters gnus-newsgroup-name) + (gnus-update-format-specifications) + ;; Do score processing. + (when gnus-use-scoring + (gnus-possibly-score-headers)) + ;; Check whether to fill in the gaps in the threads. + (when gnus-build-sparse-threads + (gnus-build-sparse-threads)) + ;; Find the initial limit. + (if gnus-show-threads + (if show-all + (let ((gnus-newsgroup-dormant nil)) + (gnus-summary-initial-limit show-all)) + (gnus-summary-initial-limit show-all)) + (setq gnus-newsgroup-limit + (mapcar + (lambda (header) (mail-header-number header)) + gnus-newsgroup-headers))) + ;; 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 (and (zerop (buffer-size)) + (not no-display)) + (cond (gnus-newsgroup-dormant + (gnus-summary-limit-include-dormant)) + ((and gnus-newsgroup-scored show-all) + (gnus-summary-limit-include-expunged t)))) + ;; Function `gnus-apply-kill-file' must be called in this hook. + (run-hooks 'gnus-apply-kill-hook) + (if (and (zerop (buffer-size)) + (not no-display)) + (progn + ;; 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 + ;; gnus-summary-prepare-hook since kill processing may not + ;; work with hidden articles. + (and gnus-show-threads + gnus-thread-hide-subtree + (gnus-summary-hide-all-threads)) + ;; Show first unread article if requested. + (if (and (not no-article) + (not no-display) + gnus-newsgroup-unreads + gnus-auto-select-first) + (unless (if (eq gnus-auto-select-first 'best) + (gnus-summary-best-unread-article) + (gnus-summary-first-unread-article)) + (gnus-configure-windows 'summary)) + ;; Don't select any articles, just move point to the first + ;; article in the group. + (goto-char (point-min)) + (gnus-summary-position-point) + (gnus-set-mode-line 'summary) + (gnus-configure-windows 'summary 'force)) + (when kill-buffer + (gnus-kill-or-deaden-summary kill-buffer)) + (when (get-buffer-window gnus-group-buffer t) + ;; 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 t)) + (when (gnus-group-goto-group group) + (recenter)) + (select-window owin)))) + ;; Mark this buffer as "prepared". + (setq gnus-newsgroup-prepared t) + t)))) + + (defun gnus-summary-prepare () + "Generate the summary buffer." + (let ((buffer-read-only nil)) + (erase-buffer) + (setq gnus-newsgroup-data nil + 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))) + + (defsubst gnus-pdf-simplify-subject (whole-subject) + "Simplify subject by the same rules as gnus-gather-threads-by-subject." + (let* ((sub nil) + (subject + (cond + ;; Truncate the subject. + ((numberp gnus-summary-gather-subject-limit) + (setq sub (gnus-simplify-subject-re whole-subject)) + (if (> (length sub) gnus-summary-gather-subject-limit) + (substring sub 0 gnus-summary-gather-subject-limit) + sub)) + ;; Fuzzily simplify it. + ((eq 'fuzzy gnus-summary-gather-subject-limit) + (gnus-simplify-subject-fuzzy whole-subject)) + ;; Just remove the leading "Re:". + (t + (gnus-simplify-subject-re whole-subject))))) + + (if (and gnus-summary-gather-exclude-subject + (string-match gnus-summary-gather-exclude-subject + subject)) + nil ; This article shouldn't be gathered + subject))) + + (defun gnus-summary-simplify-subject-query () + "Query where the respool algorithm would put this article." + (interactive) + (gnus-set-global-variables) + (gnus-summary-select-article) + (message (gnus-pdf-simplify-subject (gnus-summary-article-subject)))) + + (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 subject (gnus-pdf-simplify-subject + (setq whole-subject (mail-header-subject + (caar threads))))) + (if 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 (caar hthread)) + (setcar hthread (list whole-subject (car hthread)))) + ;; We add this new gathered thread to this gathered + ;; thread. + (setcdr (car hthread) + (nconc (cdar 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-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 (caar threads)) + (setcdr (car threads) + (sort (cdar 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 (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 (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 + ;; build complete threads - if the roots haven't been expired by the + ;; server, that is. + (let (id heads) + (mapatoms + (lambda (refs) + (when (not (car (symbol-value refs))) + (setq heads (cdr (symbol-value refs))) + (while heads + (if (memq (mail-header-number (caar heads)) + gnus-newsgroup-dormant) + (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))) + + (defun gnus-build-get-header (id) + ;; Look through the buffer of NOV lines and find the header to + ;; ID. Enter this line into the dependencies hash table, and return + ;; the id of the parent article (if any). + (let ((deps gnus-newsgroup-dependencies) + found header) + (prog1 + (save-excursion + (set-buffer nntp-server-buffer) + (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))) + (when found + (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 &optional iheader) + "Update ARTICLE in the summary buffer." + (set-buffer gnus-summary-buffer) + (let* ((header (or iheader (gnus-summary-article-header article))) + (id (mail-header-id header)) + (data (gnus-data-find article)) + (thread (gnus-id-to-thread id)) + (references (mail-header-references header)) + (parent + (gnus-id-to-thread + (or (gnus-parent-id + (if (and references + (not (equal "" references))) + references)) + "none"))) + (buffer-read-only nil) + (old (car thread)) + (number (mail-header-number header)) + pos) + (when thread + ;; !!! Should this be in or not? + (unless iheader + (setcar thread nil)) + (when parent + (delq thread parent)) + (if (gnus-summary-insert-subject id header iheader) + ;; Set the (possibly) new article number in the data structure. + (gnus-data-set-number data (gnus-id-to-article id)) + (setcar thread old) + nil)))) + + (defun gnus-rebuild-thread (id) + "Rebuild the thread containing ID." + (let ((buffer-read-only nil) + current thread 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 + (and (zerop (forward-line -1)) + (gnus-summary-article-number)))) + ;; If this is a gathered thread, we have to go some re-gathering. + (when (stringp (car thread)) + (let ((subject (car thread)) + roots thr) + (setq thread (cdr thread)) + (while thread + (unless (memq (setq thr (gnus-id-to-thread + (gnus-root-id + (mail-header-id (caar thread))))) + roots) + (push thr roots)) + (setq thread (cdr thread))) + ;; We now have all (unique) roots. + (if (= (length roots) 1) + ;; All the loose roots are now one solid root. + (setq thread (car roots)) + (setq thread (cons subject (gnus-sort-threads roots)))))) + (let (threads) + ;; We then insert this thread into the summary buffer. + (let (gnus-newsgroup-data gnus-newsgroup-threads) + (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) + (setq data (nreverse gnus-newsgroup-data)) + (setq threads gnus-newsgroup-threads)) + ;; We splice the new data into the data structure. + (gnus-data-enter-list current data) + (gnus-data-compute-positions) + (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) + + (defun gnus-number-to-header (number) + "Return the header for article NUMBER." + (let ((headers gnus-newsgroup-headers)) + (while (and headers + (not (= number (mail-header-number (car headers))))) + (pop headers)) + (when headers + (car headers)))) + + (defun gnus-parent-headers (headers &optional generation) + "Return the headers of the GENERATIONeth parent of HEADERS." + (unless generation + (setq generation 1)) + (let (references parent) + (while (and headers (not (zerop generation))) + (setq references (mail-header-references headers)) + (when (and references + (setq parent (gnus-parent-id references)) + (setq headers (car (gnus-id-to-thread parent)))) + (decf generation))) + headers)) + + (defun gnus-id-to-thread (id) + "Return the (sub-)thread where ID appears." + (gnus-gethash id gnus-newsgroup-dependencies)) + + (defun gnus-id-to-article (id) + "Return the article number of ID." + (let ((thread (gnus-id-to-thread id))) + (when (and thread + (car 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)) + (refs (mail-header-references (gnus-summary-article-header article))) + particle) + (cond + ((null level) nil) + ((zerop level) t) + ((null refs) t) + ((null (gnus-parent-id refs)) t) + ((and (= 1 level) + (null (setq particle (gnus-id-to-article + (gnus-parent-id refs)))) + (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 + 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 last-id) + ;; First go up in this thread until we find the root. + (setq last-id (gnus-root-id id)) + (setq headers (list (car (gnus-id-to-thread last-id)) + (caadr (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) + sub) + (while threads + (setq sub (car threads)) + (if (stringp (car sub)) + ;; This is a gathered thread, so we look at the roots + ;; below it to find whether this article is in this + ;; gathered root. + (progn + (setq sub (cdr sub)) + (while sub + (when (member (caar sub) headers) + (setq thread (car threads) + threads nil + sub nil)) + (setq sub (cdr sub)))) + ;; It's an ordinary thread, so we check it. + (when (eq (car sub) (car headers)) + (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 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) + (gnus-data-remove number)) + (setq thread (cdr thread)) + (while thread + (gnus-remove-thread-1 (pop thread))))) + + (defun gnus-sort-threads (threads) + "Sort THREADS." + (if (not gnus-thread-sort-functions) + threads + (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 + (setq gnus-newsgroup-headers (sort articles func)) + (gnus-message 7 "Sorting articles...done"))))) + + ;; Written by Hallvard B Furuseth . + (defmacro gnus-thread-header (thread) + ;; Return header of first article in THREAD. + ;; Note that THREAD must never, ever be anything else than a variable - + ;; 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) + "Sort articles by article number." + (< (mail-header-number h1) + (mail-header-number h2))) + + (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))))) + + (defun gnus-thread-sort-by-author (h1 h2) + "Sort threads by root author." + (gnus-article-sort-by-author + (gnus-thread-header h1) (gnus-thread-header h2))) + + (defsubst gnus-article-sort-by-subject (h1 h2) + "Sort articles by root subject." + (string-lessp + (downcase (gnus-simplify-subject-re (mail-header-subject h1))) + (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) + + (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) + "Sort articles by root article date." + (string-lessp + (inline (gnus-sortable-date (mail-header-date h1))) + (inline (gnus-sortable-date (mail-header-date h2))))) + + (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) + "Sort articles by root article score. + Unscored articles will be counted as having a score of zero." + (> (or (cdr (assq (mail-header-number h1) + gnus-newsgroup-scored)) + gnus-summary-default-score 0) + (or (cdr (assq (mail-header-number h2) + gnus-newsgroup-scored)) + gnus-summary-default-score 0))) + + (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) + "Sort threads by the sum of all scores in the thread. + Unscored articles will be counted as having a score of zero." + (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) + + (defun gnus-thread-total-score (thread) + ;; This function find the total score of THREAD. + (cond ((null thread) + 0) + ((consp thread) + (if (stringp (car thread)) + (apply gnus-thread-score-function 0 + (mapcar 'gnus-thread-total-score-1 (cdr thread))) + (gnus-thread-total-score-1 thread))) + (t + (gnus-thread-total-score-1 (list thread))))) + + (defun gnus-thread-total-score-1 (root) + ;; This function find the total score of the thread below ROOT. + (setq root (car root)) + (apply gnus-thread-score-function + (or (append + (mapcar 'gnus-thread-total-score + (cdr (gnus-gethash (mail-header-id root) + gnus-newsgroup-dependencies))) + (if (> (mail-header-number root) 0) + (list (or (cdr (assq (mail-header-number root) + gnus-newsgroup-scored)) + gnus-summary-default-score 0)))) + (list gnus-summary-default-score) + '(0)))) + + ;; Added by Per Abrahamsen . + (defvar gnus-tmp-prev-subject nil) + (defvar gnus-tmp-false-parent nil) + (defvar gnus-tmp-root-expunged nil) + (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...") + + (setq gnus-newsgroup-threads threads) + (beginning-of-line) + + (let ((gnus-tmp-level 0) + (default-score (or gnus-summary-default-score 0)) + (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) + thread number subject stack state gnus-tmp-gathered beg-match + new-roots gnus-tmp-new-adopts thread-end + gnus-tmp-header gnus-tmp-unread + gnus-tmp-replied gnus-tmp-subject-or-nil + gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score + gnus-tmp-score-char gnus-tmp-from gnus-tmp-name + gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) + + (setq gnus-tmp-prev-subject nil) + + (if (vectorp (car threads)) + ;; If this is a straight (sic) list of headers, then a + ;; threaded summary display isn't required, so we just create + ;; an unthreaded one. + (gnus-summary-prepare-unthreaded threads) + + ;; Do the threaded display. + + (while (or threads stack gnus-tmp-new-adopts new-roots) + + (if (and (= gnus-tmp-level 0) + (not (setq gnus-tmp-dummy-line nil)) + (or (not stack) + (= (caar stack) 0)) + (not gnus-tmp-false-parent) + (or gnus-tmp-new-adopts new-roots)) + (if gnus-tmp-new-adopts + (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) + thread (list (car gnus-tmp-new-adopts)) + gnus-tmp-header (caar thread) + gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) + (if new-roots + (setq thread (list (car new-roots)) + gnus-tmp-header (caar thread) + new-roots (cdr new-roots)))) + + (if threads + ;; If there are some threads, we do them before the + ;; threads on the stack. + (setq thread threads + gnus-tmp-header (caar 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) + stack (cdr stack) + gnus-tmp-header (caar thread)))) + + (setq gnus-tmp-false-parent nil) + (setq gnus-tmp-root-expunged nil) + (setq thread-end nil) + + (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 + (cddar thread))) + (setq gnus-tmp-gathered + (nconc (mapcar + (lambda (h) (mail-header-number (car h))) + (cddar thread)) + gnus-tmp-gathered)) + (setq thread (cons (list (caar thread) + (cadar thread)) + (cdr thread))) + (setq gnus-tmp-level -1 + 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))) + (cddar thread)) + gnus-tmp-gathered)) + (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)) + gnus-tmp-prev-subject + (not (inline + (gnus-subject-equal gnus-tmp-prev-subject subject)))) + (setq new-roots (nconc new-roots (list (car thread))) + thread-end t + gnus-tmp-header nil)) + ;; If the article lies outside the current limit, + ;; then we do not display it. + ((and (not (memq number gnus-newsgroup-limit)) + (not gnus-tmp-dummy-line)) + (setq gnus-tmp-gathered + (nconc (mapcar + (lambda (h) (mail-header-number (car h))) + (cdar thread)) + gnus-tmp-gathered)) + (setq gnus-tmp-new-adopts (if (cdar thread) + (append gnus-tmp-new-adopts + (cdar thread)) + gnus-tmp-new-adopts) + thread-end t + gnus-tmp-header nil) + (when (zerop gnus-tmp-level) + (setq gnus-tmp-root-expunged t))) + ;; Perhaps this article is to be marked as read? + ((and gnus-summary-mark-below + (< (or (cdr (assq number gnus-newsgroup-scored)) + default-score) + gnus-summary-mark-below) + ;; Don't touch sparse articles. + (not (memq number gnus-newsgroup-sparse)) + (not (memq number gnus-newsgroup-ancient))) + (setq gnus-newsgroup-unreads + (delq number gnus-newsgroup-unreads)) + (if gnus-newsgroup-auto-expire + (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) + ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) + (t (or (cdr (assq number gnus-newsgroup-reads)) + gnus-ancient-mark)))) + + (push (gnus-data-make number gnus-tmp-unread (1+ (point)) + gnus-tmp-header gnus-tmp-level) + 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) + (if (and (eq gnus-summary-make-false-root 'empty) + (memq number gnus-tmp-gathered) + gnus-tmp-prev-subject + (inline (gnus-subject-equal + gnus-tmp-prev-subject subject))) + gnus-summary-same-subject + subject)) + (t gnus-summary-same-subject))) + (if (and (eq gnus-summary-make-false-root 'adopt) + (= gnus-tmp-level 1) + (memq number gnus-tmp-gathered)) + (setq gnus-tmp-opening-bracket ?\< + 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)) + gnus-summary-default-score 0) + gnus-tmp-score-char + (if (or (null gnus-summary-default-score) + (<= (abs (- gnus-tmp-score gnus-summary-default-score)) + gnus-summary-zcore-fuzz)) ? + (if (< gnus-tmp-score gnus-summary-default-score) + gnus-score-below-mark gnus-score-over-mark)) + gnus-tmp-replied + (cond ((memq number gnus-newsgroup-processable) + gnus-process-mark) + ((memq number gnus-newsgroup-cached) + gnus-cached-mark) + ((memq number gnus-newsgroup-replied) + gnus-replied-mark) + ((memq number gnus-newsgroup-saved) + 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) + (setq beg-match (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-match))) + (t gnus-tmp-from))) + (when (string= gnus-tmp-name "") + (setq gnus-tmp-name gnus-tmp-from)) + (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) + (gnus-put-text-property + (point) + (progn (eval gnus-summary-line-format-spec) (point)) + 'gnus-number number) + (when gnus-visual-p + (forward-line -1) + (run-hooks 'gnus-summary-update-hook) + (forward-line 1)) + + (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 (cdar thread))) + (unless threads + (setq gnus-tmp-level 0))))) + (gnus-message 7 "Generating summary...done")) + + (defun gnus-summary-prepare-unthreaded (headers) + "Generate an unthreaded summary buffer based on HEADERS." + (let (header number mark) + + (while headers + ;; We may have to root out some bad articles... + (when (memq (setq number (mail-header-number + (setq header (pop headers)))) + gnus-newsgroup-limit) + ;; Mark article as read when it has a low score. + (when (and gnus-summary-mark-below + (< (or (cdr (assq number gnus-newsgroup-scored)) + gnus-summary-default-score 0) + gnus-summary-mark-below) + (not (memq number gnus-newsgroup-ancient))) + (setq gnus-newsgroup-unreads + (delq number gnus-newsgroup-unreads)) + (if gnus-newsgroup-auto-expire + (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 + header 0 nil mark (memq number gnus-newsgroup-replied) + (memq number gnus-newsgroup-expirable) + (mail-header-subject header) nil + (cdr (assq number gnus-newsgroup-scored)) + (memq number gnus-newsgroup-processable)))))) + + (defun gnus-select-newsgroup (group &optional read-all) + "Select newsgroup GROUP. + 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. + (when (equal major-mode 'gnus-summary-mode) + (kill-buffer (current-buffer))) + (error "Couldn't request group %s: %s" + group (gnus-status-message group)))) + + (unless (gnus-request-group group t) + (when (equal major-mode 'gnus-summary-mode) + (kill-buffer (current-buffer))) + (error "Couldn't request group %s: %s" + group (gnus-status-message group))) + + (setq gnus-newsgroup-name group) + (setq gnus-newsgroup-unselected nil) + (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) + + ;; Adjust and set lists of article marks. + (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 for %s..." gnus-newsgroup-name) + (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 for %s...done" gnus-newsgroup-name) + + ;; 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 + (eq gnus-headers-retrieved-by 'nov) + (gnus-build-old-threads)) + ;; Check whether auto-expire is to be done in this group. + (setq gnus-newsgroup-auto-expire + (gnus-group-auto-expirable-p group)) + ;; Set up the article buffer now, if necessary. + (unless gnus-single-article-buffer + (gnus-article-setup-buffer)) + ;; First and last article in this newsgroup. + (when gnus-newsgroup-headers + (setq gnus-newsgroup-begin + (mail-header-number (car gnus-newsgroup-headers)) + gnus-newsgroup-end + (mail-header-number + (gnus-last-element gnus-newsgroup-headers)))) + ;; GROUP is successfully selected. + (or gnus-newsgroup-headers t))))) + + (defun gnus-articles-to-read (group read-all) + ;; Find out what articles the user wants to read. + (let* ((articles + ;; Select all articles if `read-all' is non-nil, or if there + ;; are no unread articles. + (if (or read-all + (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)) + (scored (length scored-list)) + (number (length articles)) + (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)) + (let ((input + (read-string + (format + "How many articles from %s (default %d): " + gnus-newsgroup-name number)))) + (if (string-match "^[ \t]*$" input) number input))) + ((and (> scored marked) (< scored number) + (> (- scored number) 20)) + (let ((input + (read-string + (format "%s %s (%d scored, %d total): " + "How many articles from" + group scored number)))) + (if (string-match "^[ \t]*$" input) + number input))) + (t number)) + (quit nil)))))) + (setq select (if (stringp select) (string-to-number select) select)) + (if (or (null select) (zerop select)) + select + (if (and (not (zerop scored)) (<= (abs select) scored)) + (progn + (setq articles (sort scored-list '<)) + (setq number (length articles))) + (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. + (setq articles (nthcdr (- number select) articles)))) + (setq gnus-newsgroup-unselected + (gnus-sorted-intersection + gnus-newsgroup-unreads + (gnus-sorted-complement gnus-newsgroup-unreads articles))) + articles))) + + (defun gnus-killed-articles (killed articles) + (let (out) + (while articles + (if (inline (gnus-member-of-range (car articles) killed)) + (setq out (cons (car articles) out))) + (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)) + (active (gnus-active (gnus-info-group info))) + (min (car active)) + (max (cdr active)) + (types gnus-article-mark-lists) + (uncompressed '(score bookmark killed)) + marks var articles article mark) + + (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 save)) + (while articles + (when (or (< (setq article (pop articles)) min) (> article max)) + (set var (delq article (symbol-value var)))))) + ;; Adjust assocs. + ((memq mark uncompressed) + (while articles + (when (or (not (consp (setq article (pop articles)))) + (< (car article) min) + (> (car article) max)) + (set var (delq article (symbol-value var)))))))))) + + (defun gnus-update-missing-marks (missing) + "Go through the list of MISSING articles and remove them mark lists." + (when missing + (let ((types gnus-article-mark-lists) + var m) + ;; Go through all types. + (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 + (set var (delq (pop m) (symbol-value var))))))))) + + (defun gnus-update-marks () + "Enter the various lists of marked articles into the newsgroup info list." + (let ((types gnus-article-mark-lists) + (info (gnus-get-info gnus-newsgroup-name)) + (uncompressed '(score bookmark killed)) + type list newmarked symbol) + (when info + ;; 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))) + + ;; Enter these new marks into the info of the group. + (if (nthcdr 3 info) + (setcar (nthcdr 3 info) newmarked) + ;; Add the marks lists to the end of the info. + (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))) + (when (nthcdr (decf i) info) + (setcdr (nthcdr i info) nil))))))) + + (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)) + marked m) + (or (not info) + (and (not (setq marked (nthcdr 3 info))) + (or (null articles) + (setcdr (nthcdr 2 info) + (list (list (cons type (gnus-compress-sequence + articles t))))))) + (and (not (setq m (assq type (car marked)))) + (or (null articles) + (setcar marked + (cons (cons type (gnus-compress-sequence articles t) ) + (car marked))))) + (if force + (if (null articles) + (setcar (nthcdr 3 info) + (delq (assq type (car marked)) (car marked))) + (setcdr m (gnus-compress-sequence articles t))) + (setcdr m (gnus-compress-sequence + (sort (nconc (gnus-uncompress-range (cdr 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." + ;; Is this mode line one we keep updated? + (when (memq where gnus-updated-mode-lines) + (let (mode-string) + (save-excursion + ;; We evaluate this in the summary buffer since these + ;; 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) + (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) + (gnus-tmp-unselected (length gnus-newsgroup-unselected)) + (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 + gnus-tmp-unselected)))) + (gnus-tmp-subject + (if (and gnus-current-headers + (vectorp gnus-current-headers)) + (gnus-mode-string-quote + (mail-header-subject gnus-current-headers)) "")) + max-len + gnus-tmp-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 + (- (window-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. + (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) + ;; Update the mode line. + (setq mode-line-buffer-identification + (gnus-mode-line-buffer-identification + (list mode-string))) + (set-buffer-modified-p t)))) + + (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) + "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* ((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) + (while headers + (setq header (pop headers)) + (when (and (setq xrefs (mail-header-xref header)) + (not (memq (setq number (mail-header-number header)) + unreads))) + (setq start 0) + (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) + (setq start (match-end 0)) + (setq group (if prefix + (concat prefix (substring xrefs (match-beginning 1) + (match-end 1))) + (substring xrefs (match-beginning 1) (match-end 1)))) + (setq number + (string-to-int (substring xrefs (match-beginning 2) + (match-end 2)))) + (if (setq entry (gnus-gethash group xref-hashtb)) + (setcdr entry (cons number (cdr entry))) + (gnus-sethash group (cons number nil) xref-hashtb))))) + (and start xref-hashtb))) + + (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)))) + gnus-use-cross-reference + (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))))) + + (defun gnus-group-make-articles-read (group articles) + (let* ((num 0) + (entry (gnus-gethash group gnus-newsrc-hashtb)) + (info (nth 2 entry)) + (active (gnus-active group)) + range) + ;; First peel off all illegal article numbers. + (when active + (let ((ids articles) + id first) + (while (setq id (pop ids)) + (when (and first (> id (cdr active))) + ;; 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 + ;; Gnus believes possible. So we re-activate this + ;; group as well. This might mean doing the + ;; crossposting thingy will *increase* the number + ;; of articles in some groups. Tsk, tsk. + (setq active (or (gnus-activate-group group) active))) + (when (or (> id (cdr active)) + (< id (car active))) + (setq articles (delq id articles)))))) + ;; If the read list is nil, we init it. + (and active + (null (gnus-info-read info)) + (> (car active) 1) + (gnus-info-set-read info (cons 1 (1- (car active))))) + ;; Then we add the read articles to the range. + (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 + (if (numberp (car range)) + (setq num (1+ num)) + (setq num (+ num (- (1+ (cdar range)) (caar range))))) + (setq range (cdr range))) + (setq num (- (cdr active) num)))) + ;; Update the number of unread articles. + (setcar entry num) + ;; Update the group buffer. + (gnus-group-update-group group t))))) + + (defun gnus-methods-equal-p (m1 m2) + (let ((m1 (or m1 gnus-select-method)) + (m2 (or m2 gnus-select-method))) + (or (equal m1 m2) + (and (eq (car m1) (car m2)) + (or (not (memq 'address (assoc (symbol-name (car m1)) + gnus-valid-select-methods))) + (equal (nth 1 m1) (nth 1 m2))))))) + + (defsubst gnus-header-value () + (buffer-substring (match-end 0) (gnus-point-at-eol))) + + (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))) + headers id id-dep ref-dep end ref) + (save-excursion + (set-buffer nntp-server-buffer) + (run-hooks 'gnus-parse-headers-hook) + (let ((case-fold-search t) + in-reply-to header 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 + ref nil) + ;; 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. + (prog1 + (read cur) + (end-of-line) + (setq p (point)) + (narrow-to-region (point) + (or (and (search-forward "\n.\n" nil t) + (- (point) 2)) + (point)))) + ;; Subject. + (progn + (goto-char p) + (if (search-forward "\nsubject: " nil t) + (gnus-header-value) "(none)")) + ;; From. + (progn + (goto-char p) + (if (search-forward "\nfrom: " nil t) + (gnus-header-value) "(nobody)")) + ;; Date. + (progn + (goto-char p) + (if (search-forward "\ndate: " nil t) + (gnus-header-value) "")) + ;; Message-ID. + (progn + (goto-char p) + (if (search-forward "\nmessage-id: " nil t) + (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 + (goto-char p) + (if (search-forward "\nreferences: " nil t) + (progn + (setq end (point)) + (prog1 + (gnus-header-value) + (setq ref + (buffer-substring + (progn + (end-of-line) + (search-backward ">" end t) + (1+ (point))) + (progn + (search-backward "<" end t) + (point)))))) + ;; Get the references from the in-reply-to header if there + ;; were no references and the in-reply-to header looks + ;; promising. + (if (and (search-forward "\nin-reply-to: " nil t) + (setq in-reply-to (gnus-header-value)) + (string-match "<[^>]+>" in-reply-to)) + (setq ref (substring in-reply-to (match-beginning 0) + (match-end 0))) + (setq ref "")))) + ;; Chars. + 0 + ;; Lines. + (progn + (goto-char p) + (if (search-forward "\nlines: " nil t) + (if (numberp (setq lines (read cur))) + lines 0) + 0)) + ;; Xref. + (progn + (goto-char p) + (and (search-forward "\nxref: " nil t) + (gnus-header-value))))) + ;; We do the threading while we read the headers. The + ;; message-id and the last reference are both entered into + ;; the same hash table. Some tippy-toeing around has to be + ;; done in case an article has arrived before the article + ;; which it refers to. + (if (boundp (setq id-dep (intern 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 + (if (= (following-char) ?\t) + 0 + (let ((num (condition-case nil (read buffer) (error nil)))) + (if (numberp num) num 0))) + (or (eobp) (forward-char 1)))) + + (defmacro gnus-nov-skip-field () + '(search-forward "\t" eol 'move)) + + (defmacro gnus-nov-field () + '(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 dependencies) + "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 + ;; NNTP servers do not include Xrefs when using XOVER. + (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) + (let ((cur nntp-server-buffer) + (dependencies (or dependencies gnus-newsgroup-dependencies)) + number headers header) + (save-excursion + (set-buffer nntp-server-buffer) + ;; Allow the user to mangle the headers before parsing them. + (run-hooks 'gnus-parse-headers-hook) + (goto-char (point-min)) + (while (and sequence (not (eobp))) + (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))) + headers)) + + ;; 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) + + ;; overview: [num subject from date id refs chars lines misc] + (narrow-to-region (point) eol) + (or (eobp) (forward-char)) + + (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 + (buffer-substring + (1+ (point)) + (search-backward "<" beg t))) + (setq ref nil)))) + (gnus-nov-field)) ; refs + (gnus-nov-read-integer) ; chars + (gnus-nov-read-integer) ; lines + (if (= (following-char) ?\n) + nil + (gnus-nov-field)) ; misc + )) + (error (progn + (gnus-error 4 "Strange nov line") + (setq header nil) + (goto-char eol)))) + + (widen) + + ;; We build the thread tree. + (when header + (if (boundp (setq id-dep (intern id dependencies))) + (if (and (car (symbol-value id-dep)) + (not force-new)) + ;; An article with this Message-ID has already been seen, + ;; 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 (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))))) + header)) + + (defun gnus-article-get-xrefs () + "Fill in the Xref value in `gnus-current-headers', if necessary. + This is meant to be called in `gnus-article-internal-prepare-hook'." + (let ((headers (save-excursion (set-buffer gnus-summary-buffer) + gnus-current-headers))) + (or (not gnus-use-cross-reference) + (not headers) + (and (mail-header-xref headers) + (not (string= (mail-header-xref headers) ""))) + (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 &optional old-header use-old-header) + "Find article ID and insert the summary line for that article." + (let ((header (if (and old-header use-old-header) + old-header (gnus-read-header id))) + (number (and (numberp id) id)) + pos) + (when header + ;; Rebuild the thread that this article is part of and go to the + ;; article we have fetched. + (when (and (not gnus-show-threads) + old-header) + (when (setq pos (text-property-any + (point-min) (point-max) 'gnus-number + (mail-header-number old-header))) + (goto-char pos) + (gnus-delete-line) + (gnus-data-remove (mail-header-number old-header)))) + (when old-header + (mail-header-set-number header (mail-header-number old-header))) + (setq gnus-newsgroup-sparse + (delq (setq number (mail-header-number header)) + gnus-newsgroup-sparse)) + (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) + (gnus-rebuild-thread (mail-header-id header)) + (gnus-summary-goto-subject number nil t)) + (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 (mail-header-number header)))) + + (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 + (n + ;; A numerical prefix has been given. + (let ((backward (< n 0)) + (n (abs (prefix-numeric-value n))) + articles article) + (save-excursion + (while + (and (> n 0) + (push (setq article (gnus-summary-article-number)) + articles) + (if backward + (gnus-summary-find-prev nil article) + (gnus-summary-find-next nil article))) + (decf n))) + (nreverse articles))) + ((and (boundp 'transient-mark-mode) + transient-mark-mode + mark-active) + ;; Work on the region between point and mark. + (let ((max (max (point) (mark))) + 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))) + (nreverse articles)))) + (gnus-newsgroup-processable + ;; There are process-marked articles present. + (reverse gnus-newsgroup-processable)) + (t + ;; Just return the current article. + (list (gnus-summary-article-number))))) + + (defun gnus-summary-search-group (&optional backward use-level) + "Search for next unread newsgroup. + 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)))) + + (defun gnus-summary-best-group (&optional exclude-group) + "Find the name of the best unread group. + If EXCLUDE-GROUP, do not go to this group." + (save-excursion + (set-buffer gnus-group-buffer) + (save-excursion + (gnus-group-best-unread-group exclude-group)))) + + (defun gnus-summary-find-next (&optional unread article backward) + (if backward (gnus-summary-find-prev) + (let* ((dummy (gnus-summary-article-intangible-p)) + (article (or article (gnus-summary-article-number))) + (arts (gnus-data-find-list article)) + result) + (when (and (not dummy) + (or (not gnus-summary-check-current) + (not unread) + (not (gnus-data-unread-p (car arts))))) + (setq arts (cdr arts))) + (when (setq result + (if unread + (progn + (while arts + (when (gnus-data-unread-p (car arts)) + (setq result (car arts) + arts nil)) + (setq arts (cdr arts))) + result) + (car arts))) + (goto-char (gnus-data-pos result)) + (gnus-data-number result))))) + + (defun gnus-summary-find-prev (&optional unread article) + (let* ((eobp (eobp)) + (article (or article (gnus-summary-article-number))) + (arts (gnus-data-find-list article (gnus-data-list 'rev))) + result) + (when (and (not eobp) + (or (not gnus-summary-check-current) + (not unread) + (not (gnus-data-unread-p (car arts))))) + (setq arts (cdr arts))) + (if (setq result + (if unread + (progn + (while arts + (and (gnus-data-unread-p (car arts)) + (setq result (car arts) + arts nil)) + (setq arts (cdr arts))) + result) + (car arts))) + (progn + (goto-char (gnus-data-pos result)) + (gnus-data-number result))))) + + (defun gnus-summary-find-subject (subject &optional unread backward article) + (let* ((simp-subject (gnus-simplify-subject-fully subject)) + (article (or article (gnus-summary-article-number))) + (articles (gnus-data-list backward)) + (arts (gnus-data-find-list article articles)) + result) + (when (or (not gnus-summary-check-current) + (not unread) + (not (gnus-data-unread-p (car arts)))) + (setq arts (cdr arts))) + (while arts + (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)) + (setq arts (cdr arts))) + (and result + (goto-char (gnus-data-pos result)) + (gnus-data-number result)))) + + (defun gnus-summary-search-forward (&optional unread subject backward) + "Search forward for an article. + If UNREAD, look for unread articles. If SUBJECT, look for + articles with that subject. If BACKWARD, search backward instead." + (cond (subject (gnus-summary-find-subject subject unread backward)) + (backward (gnus-summary-find-prev unread)) + (t (gnus-summary-find-next unread)))) + + (defun gnus-recenter (&optional n) + "Center point in window and redisplay frame. + Also do horizontal recentering." + (interactive "P") + (when (and gnus-auto-center-summary + (not (eq gnus-auto-center-summary 'vertical))) + (gnus-horizontal-recenter)) + (recenter n)) + + (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) + ((< (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)))) + ;; 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. + (when (and (get-buffer-window (current-buffer) t) + (not (eq gnus-auto-center-summary 'vertical))) + (let ((selected (selected-window))) + (select-window (get-buffer-window (current-buffer) t)) + (gnus-summary-position-point) + (gnus-horizontal-recenter) + (select-window selected)))))) + + (defun gnus-summary-jump-to-group (newsgroup) + "Move point to NEWSGROUP in group mode buffer." + ;; Keep update point of group mode buffer if visible. + (if (eq (current-buffer) (get-buffer gnus-group-buffer)) + (save-window-excursion + ;; Take care of tree window mode. + (if (get-buffer-window gnus-group-buffer) + (pop-to-buffer gnus-group-buffer)) + (gnus-group-jump-to-group newsgroup)) + (save-excursion + ;; Take care of tree window mode. + (if (get-buffer-window gnus-group-buffer) + (pop-to-buffer gnus-group-buffer) + (set-buffer gnus-group-buffer)) + (gnus-group-jump-to-group newsgroup)))) + + ;; This function returns a list of article numbers based on the + ;; difference between the ranges of read articles in this group and + ;; the range of active articles. + (defun gnus-list-of-unread-articles (group) + (let* ((read (gnus-info-read (gnus-get-info group))) + (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 + ;; first unread article is the article after the last read + ;; article. Sounds logical, doesn't it? + (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)) + (caar 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) (cdar read)))) + (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) + (setq read (cdr read))))) + ;; And add the last unread articles. + (while (<= first last) + (setq unread (cons first unread)) + (setq first (1+ first))) + ;; Return the list of unread articles. + (nreverse unread))) + + (defun gnus-list-of-read-articles (group) + "Return a list of unread, unticked and non-dormant articles." + (let* ((info (gnus-get-info group)) + (marked (gnus-info-marks info)) + (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) + (gnus-error 1 "Undefined key") + (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. + With arg, turn line truncation on iff arg is positive." + (interactive "P") + (setq truncate-lines + (if (null arg) (not truncate-lines) + (> (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) + (when (gnus-ephemeral-group-p gnus-newsgroup-name) + (error "Ephemeral groups can't be reselected")) + (let ((current-subject (gnus-summary-article-number)) + (group gnus-newsgroup-name)) + (setq gnus-newsgroup-begin nil) + (gnus-summary-exit) + ;; We have to adjust the point of group mode buffer because the + ;; 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 nil t))) + + (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)) + (when gnus-newsgroup-kill-headers + (setq gnus-newsgroup-killed + (gnus-compress-sequence + (nconc + (gnus-set-sorted-intersection + (gnus-uncompress-range gnus-newsgroup-killed) + (setq gnus-newsgroup-unselected + (sort gnus-newsgroup-unselected '<))) + (setq gnus-newsgroup-unreads + (sort gnus-newsgroup-unreads '<))) t))) + (unless (listp (cdr gnus-newsgroup-killed)) + (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) + (let ((headers gnus-newsgroup-headers)) + (run-hooks 'gnus-exit-group-hook) + (unless gnus-save-score + (setq gnus-newsgroup-scored nil)) + ;; Set the new ranges of read articles. + (gnus-update-read-articles + group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) + ;; Set the current article marks. + (gnus-update-marks) + ;; Do the cross-ref thing. + (when gnus-use-cross-reference + (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) + ;; 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." + (interactive) + (gnus-set-global-variables) + (gnus-kill-save-kill-buffer) + (let* ((group gnus-newsgroup-name) + (quit-config (gnus-group-quit-config gnus-newsgroup-name)) + (mode major-mode) + (buf (current-buffer))) + (run-hooks 'gnus-summary-prepare-exit-hook) + ;; If we have several article buffers, we kill them at exit. + (unless gnus-single-article-buffer + (gnus-kill-buffer gnus-original-article-buffer) + (setq gnus-article-current nil)) + (when gnus-use-cache + (gnus-cache-possibly-remove-articles) + (gnus-cache-save-buffers)) + (gnus-async-prefetch-remove-group group) + (when gnus-use-trees + (gnus-tree-close group)) + ;; Make all changes in this group permanent. + (unless quit-config + (gnus-summary-update-info)) + (gnus-close-group group) + ;; Make sure where I was, and go to next newsgroup. + (set-buffer gnus-group-buffer) + (unless quit-config + (gnus-group-jump-to-group group)) + (run-hooks 'gnus-summary-exit-hook) + (unless quit-config + (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) + (gnus-kill-buffer gnus-original-article-buffer) + (setq gnus-article-current nil)) + (set-buffer buf) + (if (not gnus-kill-summary-on-exit) + (gnus-deaden-summary) + ;; 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) + (when (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer)) + ;; 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) + (pop-to-buffer gnus-group-buffer) + ;; Clear the current group name. + (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))))) + + (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) + (defun gnus-summary-exit-no-update (&optional no-questions) + "Quit reading current newsgroup without updating read article info." + (interactive) + (gnus-set-global-variables) + (let* ((group gnus-newsgroup-name) + (quit-config (gnus-group-quit-config group))) + (when (or no-questions + gnus-expert-user + (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) + (setq gnus-article-current nil)) + (if (not gnus-kill-summary-on-exit) + (gnus-deaden-summary) + (gnus-close-group group) + (gnus-summary-clear-local-variables) + (set-buffer gnus-group-buffer) + (gnus-summary-clear-local-variables) + (when (get-buffer gnus-summary-buffer) + (kill-buffer gnus-summary-buffer))) + (unless gnus-single-article-buffer + (setq gnus-article-current nil)) + (when gnus-use-trees + (gnus-tree-close group)) + (gnus-async-prefetch-remove-group group) + (when (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer)) + ;; Return to the group buffer. + (gnus-configure-windows 'group 'force) + ;; Clear the current group name. + (setq gnus-newsgroup-name nil) + (when (equal (gnus-group-group-name) group) + (gnus-group-next-unread-group 1)) + (when quit-config + (if (not (buffer-name (car quit-config))) + (gnus-configure-windows 'group 'force) + (set-buffer (car quit-config)) + (when (eq major-mode 'gnus-summary-mode) + (gnus-set-global-variables)) + (gnus-configure-windows (cdr quit-config))))))) + + ;;; Dead summaries. + + (defvar gnus-dead-summary-mode-map nil) + + (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.") + + (defun gnus-dead-summary-mode (&optional arg) + "Minor mode for Gnus summary buffers." + (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 + (unless (assq 'gnus-dead-summary-mode minor-mode-alist) + (push '(gnus-dead-summary-mode " Dead") minor-mode-alist)) + (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist) + (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map) + minor-mode-map-alist))))) + + (defun gnus-deaden-summary () + "Make the current summary buffer into a dead summary buffer." + ;; Kill any previous dead summary buffer. + (when (and gnus-dead-summary + (buffer-name gnus-dead-summary)) + (save-excursion + (set-buffer gnus-dead-summary) + (when gnus-dead-summary-mode + (kill-buffer (current-buffer))))) + ;; Make this the current dead summary. + (setq gnus-dead-summary (current-buffer)) + (gnus-dead-summary-mode 1) + (let ((name (buffer-name))) + (when (string-match "Summary" name) + (rename-buffer + (concat (substring name 0 (match-beginning 0)) "Dead " + (substring name (match-beginning 0))) t)))) + + (defun gnus-kill-or-deaden-summary (buffer) + "Kill or deaden the summary BUFFER." + (when (and (buffer-name buffer) + (not gnus-single-article-buffer)) + (save-excursion + (set-buffer buffer) + (gnus-kill-buffer gnus-article-buffer) + (gnus-kill-buffer gnus-original-article-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))) + (save-excursion + (set-buffer buffer) + (gnus-deaden-summary))))) + + (defun gnus-summary-wake-up-the-dead (&rest args) + "Wake up the dead summary buffer." + (interactive) + (gnus-dead-summary-mode -1) + (let ((name (buffer-name))) + (when (string-match "Dead " name) + (rename-buffer + (concat (substring name 0 (match-beginning 0)) + (substring name (match-end 0))) t))) + (gnus-message 3 "This dead summary is now alive again")) + + ;; Suggested by Andrew Eskilsson . + (defun gnus-summary-fetch-faq (&optional faq-dir) + "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)))) + + ;; Suggested by Per Abrahamsen . + (defun gnus-summary-describe-group (&optional force) + "Describe the current newsgroup." + (interactive "P") + (gnus-group-describe-group force gnus-newsgroup-name)) + + (defun gnus-summary-describe-briefly () + "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. + + (defun gnus-summary-next-group (&optional no-article target-group backward) + "Exit current newsgroup and then select next unread newsgroup. + If prefix argument NO-ARTICLE is non-nil, no article is selected + initially. If NEXT-GROUP, go to this group. If BACKWARD, go to + previous group instead." + (interactive "P") + (gnus-set-global-variables) + (let ((current-group gnus-newsgroup-name) + (current-buffer (current-buffer)) + entered) + ;; First we semi-exit this group to update Xrefs and all variables. + ;; We can't do a real exit, because the window conf must remain + ;; the same in case the user is prompted for info, and we don't + ;; want the window conf to change before that... + (gnus-summary-exit t) + (while (not entered) + ;; 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) + ;; There are no further groups, so we return to the group + ;; buffer. + (progn + (gnus-message 5 "Returning to the group buffer") + (setq entered t) + (set-buffer current-buffer) + (gnus-summary-exit)) + ;; We try to enter the target group. + (gnus-group-jump-to-group target-group) + (let ((unreads (gnus-group-group-unread))) + (if (and (or (eq t unreads) + (and unreads (not (zerop unreads)))) + (gnus-summary-read-group + target-group nil no-article current-buffer)) + (setq entered t) + (setq current-group target-group + target-group nil))))))) + + (defun gnus-summary-prev-group (&optional no-article) + "Exit current newsgroup and then select previous unread newsgroup. + If prefix argument NO-ARTICLE is non-nil, no article is selected initially." + (interactive "P") + (gnus-summary-next-group no-article nil t)) + + ;; Walking around summary lines. + + (defun gnus-summary-first-subject (&optional unread) + "Go to the first unread subject. + If UNREAD is non-nil, go to the first unread article. + 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") + nil) + ;; Pick the first article. + ((not unread) + (goto-char (gnus-data-pos (car gnus-newsgroup-data))) + (gnus-data-number (car gnus-newsgroup-data))) + ;; No unread articles. + ((null gnus-newsgroup-unreads) + (gnus-message 3 "No more unread articles") + nil) + ;; Find the first unread article. + (t + (let ((data gnus-newsgroup-data)) + (while (and data + (not (gnus-data-unread-p (car data)))) + (setq data (cdr data))) + (if data + (progn + (goto-char (gnus-data-pos (car data))) + (gnus-data-number (car data))))))) + (gnus-summary-position-point))) + + (defun gnus-summary-next-subject (n &optional unread dont-display) + "Go to next N'th summary line. + If N is negative, go to the previous N'th subject line. + If UNREAD is non-nil, only unread articles are selected. + The difference between N and the actual number of steps taken is + returned." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n))) + (while (and (> n 0) + (if backward + (gnus-summary-find-prev unread) + (gnus-summary-find-next unread))) + (setq n (1- n))) + (if (/= 0 n) (gnus-message 7 "No more%s articles" + (if unread " unread" ""))) + (unless dont-display + (gnus-summary-recenter) + (gnus-summary-position-point)) + n)) + + (defun gnus-summary-next-unread-subject (n) + "Go to next N'th unread summary line." + (interactive "p") + (gnus-summary-next-subject n t)) + + (defun gnus-summary-prev-subject (n &optional unread) + "Go to previous N'th summary line. + If optional argument UNREAD is non-nil, only unread article is selected." + (interactive "p") + (gnus-summary-next-subject (- n) unread)) + + (defun gnus-summary-prev-unread-subject (n) + "Go to previous N'th unread summary line." + (interactive "p") + (gnus-summary-next-subject (- n) t)) + + (defun gnus-summary-goto-subject (article &optional force silent) + "Go the subject line of ARTICLE. + If FORCE, also allow jumping to articles not currently shown." + (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 (and (vectorp force) force) t) + (setq data (gnus-data-find article))) + (goto-char b) + (if (not data) + (progn + (unless silent + (gnus-message 3 "Can't find article %d" article)) + nil) + (goto-char (gnus-data-pos data)) + article))) + + ;; Walking around summary lines with displaying articles. + + (defun gnus-summary-expand-window (&optional arg) + "Make the summary buffer take up the entire Emacs frame. + Given a prefix, will force an `article' buffer configuration." + (interactive "P") + (gnus-set-global-variables) + (if arg + (gnus-configure-windows 'article 'force) + (gnus-configure-windows 'summary 'force))) + + (defun gnus-summary-display-article (article &optional all-header) + "Display ARTICLE in article buffer." + (gnus-set-global-variables) + (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) + (unless (zerop gnus-current-article) + (gnus-summary-goto-subject gnus-current-article)) + (gnus-summary-recenter) + (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)))))) + + (defun gnus-summary-select-article (&optional all-headers force pseudo article) + "Select the current article. + If ALL-HEADERS is non-nil, show all header fields. If FORCE is + non-nil, the article will be re-fetched even if it already present in + the article buffer. If PSEUDO is non-nil, pseudo-articles will also + be displayed." + ;; Make sure we are in the summary buffer to work around bbdb bug. + (unless (eq major-mode 'gnus-summary-mode) + (set-buffer gnus-summary-buffer)) + (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 + (save-excursion + (set-buffer gnus-summary-buffer) + (if (or (and gnus-single-article-buffer + (or (null gnus-current-article) + (null gnus-article-current) + (null (get-buffer gnus-article-buffer)) + (not (eq article (cdr gnus-article-current))) + (not (equal (car gnus-article-current) + gnus-newsgroup-name)))) + (and (not gnus-single-article-buffer) + (or (null gnus-current-article) + (not (eq gnus-current-article article)))) + force) + ;; The requested article is different from the current article. + (prog1 + (gnus-summary-display-article article all-headers) + (setq did article)) + (if (or all-headers gnus-show-all-headers) + (gnus-article-show-all-headers)) + 'old)) + (if did + (gnus-article-set-window-start + (cdr (assq article gnus-newsgroup-bookmarks))))))) + + (defun gnus-summary-set-current-mark (&optional current-mark) + "Obsolete function." + nil) + + (defun gnus-summary-next-article (&optional unread subject backward push) + "Select the next article. + If UNREAD, only unread articles are selected. + If SUBJECT, only articles with SUBJECT are selected. + If BACKWARD, the previous article is selected instead of the next." + (interactive "P") + (gnus-set-global-variables) + (cond + ;; Is there such an article? + ((and (gnus-summary-search-forward unread subject backward) + (or (gnus-summary-display-article (gnus-summary-article-number)) + (eq (gnus-summary-article-mark) gnus-canceled-mark))) + (gnus-summary-position-point)) + ;; If not, we try the first unread, if that is wanted. + ((and subject + gnus-auto-select-same + (gnus-summary-first-unread-article)) + (gnus-summary-position-point) + (gnus-message 6 "Wrapped")) + ;; 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. + (t + (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 + ((or (not gnus-auto-select-next) + (not cmd)) + (gnus-message 7 "No more%s articles" (if unread " unread" ""))) + ((or (eq gnus-auto-select-next 'quietly) + (and (eq gnus-auto-select-next 'slightly-quietly) + push) + (and (eq gnus-auto-select-next 'almost-quietly) + (gnus-summary-last-article-p))) + ;; Select quietly. + (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) + (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) + (?\C-p (gnus-group-prev-unread-group 1)))) + keve key group ended) + (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 + 5 "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 + (car (gnus-gethash group gnus-newsrc-hashtb))) + (format " (Type %s to exit %s)" + (single-key-description cmd) + gnus-newsgroup-name))) + ;; 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) + (and group + (gnus-group-jump-to-group group)) + (eval (cadr (assq key keystrokes))) + (setq group (gnus-group-group-name)) + (switch-to-buffer obuf)) + (setq ended nil)) + ((equal key cmd) + (if (or (not group) + (gnus-ephemeral-group-p gnus-newsgroup-name)) + (gnus-summary-exit) + (gnus-summary-next-group nil group backward))) + (t + (push (cdr keve) unread-command-events)))))) + + (defun gnus-summary-next-unread-article () + "Select unread article after current one." + (interactive) + (gnus-summary-next-article t (and gnus-auto-select-same + (gnus-summary-article-subject)))) + + (defun gnus-summary-prev-article (&optional unread subject) + "Select the article after the current one. + If UNREAD is non-nil, only unread articles are selected." + (interactive "P") + (gnus-summary-next-article unread subject t)) + + (defun gnus-summary-prev-unread-article () + "Select unred article before current one." + (interactive) + (gnus-summary-prev-article t (and gnus-auto-select-same + (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) + (let ((article (gnus-summary-article-number)) + (endp nil)) + (gnus-configure-windows 'article) + (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) + (if (and (eq gnus-summary-goto-unread 'never) + (not (gnus-summary-last-article-p article))) + (gnus-summary-next-article) + (gnus-summary-next-unread-article)) + (if (or (null gnus-current-article) + (null gnus-article-current) + (/= article (cdr gnus-article-current)) + (not (equal (car gnus-article-current) gnus-newsgroup-name))) + ;; Selected subject is different from current article's. + (gnus-summary-display-article article) + (gnus-eval-in-buffer-window 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 (and (eq gnus-summary-goto-unread 'never) + (not (gnus-summary-last-article-p article))) + (gnus-summary-next-article) + (gnus-summary-next-unread-article))))))) + (gnus-summary-recenter) + (gnus-summary-position-point))) + + (defun gnus-summary-prev-page (&optional lines) + "Show previous page of selected article. + Argument LINES specifies lines to be scrolled down." + (interactive "P") + (gnus-set-global-variables) + (let ((article (gnus-summary-article-number))) + (gnus-configure-windows 'article) + (if (or (null gnus-current-article) + (null gnus-article-current) + (/= article (cdr gnus-article-current)) + (not (equal (car gnus-article-current) gnus-newsgroup-name))) + ;; Selected subject is different from current article's. + (gnus-summary-display-article article) + (gnus-summary-recenter) + (gnus-eval-in-buffer-window gnus-article-buffer + (gnus-article-prev-page lines)))) + (gnus-summary-position-point)) + + (defun gnus-summary-scroll-up (lines) + "Scroll up (or down) one line current article. + Argument LINES specifies lines to be scrolled up (or down if negative)." + (interactive "p") + (gnus-set-global-variables) + (gnus-configure-windows 'article) + (gnus-summary-show-thread) + (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) + (gnus-eval-in-buffer-window gnus-article-buffer + (cond ((> lines 0) + (if (gnus-article-next-page lines) + (gnus-message 3 "End of message"))) + ((< lines 0) + (gnus-article-prev-page (- lines)))))) + (gnus-summary-recenter) + (gnus-summary-position-point)) + + (defun gnus-summary-next-same-subject () + "Select next article which has the same subject as current one." + (interactive) + (gnus-set-global-variables) + (gnus-summary-next-article nil (gnus-summary-article-subject))) + + (defun gnus-summary-prev-same-subject () + "Select previous article which has the same subject as current one." + (interactive) + (gnus-set-global-variables) + (gnus-summary-prev-article nil (gnus-summary-article-subject))) + + (defun gnus-summary-next-unread-same-subject () + "Select next unread article which has the same subject as current one." + (interactive) + (gnus-set-global-variables) + (gnus-summary-next-article t (gnus-summary-article-subject))) + + (defun gnus-summary-prev-unread-same-subject () + "Select previous unread article which has the same subject as current one." + (interactive) + (gnus-set-global-variables) + (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) + (prog1 + (if (gnus-summary-first-subject t) + (progn + (gnus-summary-show-thread) + (gnus-summary-first-subject t) + (gnus-summary-display-article (gnus-summary-article-number)))) + (gnus-summary-position-point))) + + (defun gnus-summary-best-unread-article () + "Select the unread article with the highest score." + (interactive) + (gnus-set-global-variables) + (let ((best -1000000) + (data gnus-newsgroup-data) + 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 + article (gnus-data-number (car data)))) + (setq data (cdr data))) + (prog1 + (if article + (gnus-summary-goto-article article) + (error "No unread articles")) + (gnus-summary-position-point)))) + + (defun gnus-summary-last-subject () + "Go to the last displayed subject line in the group." + (let ((article (gnus-data-number (car (gnus-data-list t))))) + (when article + (gnus-summary-goto-subject article)))) + + (defun gnus-summary-goto-article (article &optional all-headers force) + "Fetch ARTICLE and display it if it exists. + If ALL-HEADERS is non-nil, no header lines are hidden." + (interactive + (list + (string-to-int + (completing-read + "Article number: " + (mapcar (lambda (number) (list (int-to-string number))) + gnus-newsgroup-limit))) + current-prefix-arg + t)) + (prog1 + (if (gnus-summary-goto-subject article force) + (gnus-summary-display-article article all-headers) + (gnus-message 4 "Couldn't go to article %s" article) nil) + (gnus-summary-position-point))) + + (defun gnus-summary-goto-last-article () + "Go to the previously read article." + (interactive) + (prog1 + (and gnus-last-article + (gnus-summary-goto-article gnus-last-article)) + (gnus-summary-position-point))) + + (defun gnus-summary-pop-article (number) + "Pop one article off the history and go to the previous. + NUMBER articles will be popped off." + (interactive "p") + (let (to) + (setq gnus-newsgroup-history + (cdr (setq to (nthcdr number gnus-newsgroup-history)))) + (if to + (gnus-summary-goto-article (car to)) + (error "Article history empty"))) + (gnus-summary-position-point)) + + ;; Summary commands and functions for limiting the summary buffer. + + (defun gnus-summary-limit-to-articles (n) + "Limit the summary buffer to the next N articles. + If not given a prefix, use the process marked articles instead." + (interactive "P") + (gnus-set-global-variables) + (prog1 + (let ((articles (gnus-summary-work-articles n))) + (setq gnus-newsgroup-processable nil) + (gnus-summary-limit articles)) + (gnus-summary-position-point))) + + (defun gnus-summary-pop-limit (&optional total) + "Restore the previous limit. + If given a prefix, remove all limits." + (interactive "P") + (gnus-set-global-variables) + (when total + (setq gnus-newsgroup-limits + (list (mapcar (lambda (h) (mail-header-number h)) + gnus-newsgroup-headers)))) + (unless gnus-newsgroup-limits + (error "No limit to pop")) + (prog1 + (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 + (or header "subject") subject 'all))) + (or articles (error "Found no matches for \"%s\"" subject)) + (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) + "Limit the summary buffer to articles that are not marked as read. + If ALL is non-nil, limit strictly to unread articles." + (interactive "P") + (if all + (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 + gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark) + 'reverse))) + + (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) + (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) + + (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) + (prog1 + (let ((data gnus-newsgroup-data) + (marks (if (listp marks) marks + (append marks nil))) ; Transform to list. + articles) + (while data + (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) + (memq (gnus-data-mark (car data)) marks)) + (setq articles (cons (gnus-data-number (car data)) articles))) + (setq data (cdr data))) + (gnus-summary-limit articles)) + (gnus-summary-position-point))) + + (defun gnus-summary-limit-to-score (&optional score) + "Limit to articles with score at or above SCORE." + (interactive "P") + (gnus-set-global-variables) + (setq score (if score + (prefix-numeric-value score) + (or gnus-summary-default-score 0))) + (let ((data gnus-newsgroup-data) + articles) + (while data + (when (>= (gnus-summary-article-score (gnus-data-number (car data))) + score) + (push (gnus-data-number (car data)) articles)) + (setq data (cdr data))) + (prog1 + (gnus-summary-limit articles) + (gnus-summary-position-point)))) + + (defun gnus-summary-limit-include-dormant () + "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)) + (gnus-summary-position-point))) + + (defun gnus-summary-limit-exclude-dormant () + "Hide all dormant articles." + (interactive) + (gnus-set-global-variables) + (prog1 + (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) + (gnus-summary-position-point))) + + (defun gnus-summary-limit-exclude-childless-dormant () + "Hide all dormant articles that have no children." + (interactive) + (gnus-set-global-variables) + (let ((data (gnus-data-list t)) + articles d children) + ;; Find all articles that are either not dormant or have + ;; children. + (while (setq d (pop data)) + (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) + (and (setq children + (gnus-article-children (gnus-data-number d))) + (let (found) + (while children + (when (memq (car children) articles) + (setq children nil + found t)) + (pop children)) + found))) + (push (gnus-data-number d) articles))) + ;; Do the limiting. + (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) + (let ((total (length gnus-newsgroup-data)) + (data (gnus-data-find-list (gnus-summary-article-number))) + (gnus-summary-mark-below nil) ; Inhibit this. + found) + ;; This will do all the work of generating the new summary buffer + ;; according to the new limit. + (gnus-summary-prepare) + ;; Hide any threads, possibly. + (and gnus-show-threads + gnus-thread-hide-subtree + (gnus-summary-hide-all-threads)) + ;; Try to return to the article you were at, or one 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)) + (setq data (cdr data)))) + (or found + ;; If there is no data, that means that we were after the last + ;; article. The same goes when we can't find any articles + ;; after the current one. + (progn + (goto-char (point-max)) + (gnus-summary-find-prev))) + ;; We return how many articles were removed from the summary + ;; buffer as a result of the new limit. + (- total (length gnus-newsgroup-data)))) + + (defsubst gnus-invisible-cut-children (threads) + (let ((num 0)) + (while threads + (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) + (incf num)) + (pop threads)) + (< num 2))) + + (defsubst gnus-cut-thread (thread) + "Go forwards in the thread until we find an article that we want to display." + (when (or (eq gnus-fetch-old-headers 'some) + (eq gnus-build-sparse-threads 'some) + (eq gnus-build-sparse-threads 'more)) + ;; Deal with old-fetched headers and sparse threads. + (while (and + thread + (or + (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) + (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)) + (or (<= (length (cdr thread)) 1) + (gnus-invisible-cut-children (cdr thread)))) + (setq thread (cadr thread)))) + 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) + (eq gnus-build-sparse-threads 'more)) + (let ((th threads)) + (while th + (setcar th (gnus-cut-thread (car th))) + (setq th (cdr th))))) + ;; Remove nixed out threads. + (delq nil threads)) + + (defun gnus-summary-initial-limit (&optional show-if-empty) + "Figure out what the initial limit is supposed to be on group entry. + This entails weeding out unwanted dormants, low-scored articles, + fetch-old-headers verbiage, and so on." + ;; Most groups have nothing to remove. + (if (or gnus-inhibit-limiting + (and (null gnus-newsgroup-dormant) + (not (eq gnus-fetch-old-headers 'some)) + (null gnus-summary-expunge-below) + (not (eq gnus-build-sparse-threads 'some)) + (not (eq gnus-build-sparse-threads 'more)) + (null gnus-thread-expunge-below) + (not gnus-use-nocem))) + () ; Do nothing. + (push gnus-newsgroup-limit gnus-newsgroup-limits) + (setq gnus-newsgroup-limit nil) + (mapatoms + (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)) + (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)) + + (defun gnus-summary-limit-children (thread) + "Return 1 if this subthread is visible and 0 if it is not." + ;; First we get the number of visible children to this thread. This + ;; 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 "fetch-old-headered" and there is only one + ;; visible child (or less), then we don't want this article. + (and (eq gnus-fetch-old-headers 'some) + (memq number gnus-newsgroup-ancient) + (zerop children)) + ;; If this is a sparsely inserted article with no children, + ;; we don't want it. + (and (eq gnus-build-sparse-threads 'some) + (memq number gnus-newsgroup-sparse) + (zerop children)) + ;; If we use expunging, and this article is really + ;; low-scored, then we don't want this article. + (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) + (and gnus-use-nocem + (gnus-nocem-unwanted-article-p (mail-header-id (car thread))))) + ;; 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) + (push (cons number gnus-low-score-mark) + gnus-newsgroup-reads))) + ;; Go recursively through all subthreads. + (mapcar 'gnus-expunge-thread (cdr thread))) + + ;; Summary article oriented commands + + (defun gnus-summary-refer-parent-article (n) + "Refer parent article N times. + 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 + (message-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 (setq ref (or ref (mail-header-references header))) + (or (gnus-summary-refer-article (gnus-parent-id ref)) + (gnus-message 1 "Couldn't find parent")) + (gnus-message 1 "No references in article %d" + (gnus-summary-article-number)) + nil))) + (setq n (1- n))) + (gnus-summary-position-point) + n) + + (defun gnus-summary-refer-references () + "Fetch all articles mentioned in the References header. + Return how many articles were fetched." + (interactive) + (gnus-set-global-variables) + (let ((ref (mail-header-references (gnus-summary-article-header))) + (current (gnus-summary-article-number)) + (n 0)) + ;; For each Message-ID in the References header... + (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: ") + (when (and (stringp message-id) + (not (zerop (length message-id)))) + ;; Construct the correct Message-ID if necessary. + ;; Suggested by tale@pawl.rpi.edu. + (unless (string-match "^<" message-id) + (setq message-id (concat "<" message-id))) + (unless (string-match ">$" message-id) + (setq message-id (concat message-id ">"))) + (let* ((header (gnus-id-to-header message-id)) + (sparse (and header + (memq (mail-header-number header) + gnus-newsgroup-sparse)))) + (if header + (prog1 + ;; The article is present in the buffer, to we just go to it. + (gnus-summary-goto-article + (mail-header-number header) nil header) + (when sparse + (gnus-summary-update-article (mail-header-number header)))) + ;; We fetch the article + (let ((gnus-override-method + (and (gnus-news-group-p gnus-newsgroup-name) + gnus-refer-article-method)) + number) + ;; Start the special refer-article method, if necessary. + (when (and gnus-refer-article-method + (gnus-news-group-p gnus-newsgroup-name)) + (gnus-check-server gnus-refer-article-method)) + ;; Fetch the header, and display the article. + (if (setq number (gnus-summary-insert-subject message-id)) + (gnus-summary-select-article nil nil nil number) + (gnus-message 3 "Couldn't fetch article %s" message-id))))))) + + (defun gnus-summary-enter-digest-group (&optional force) + "Enter a digest group based on the current article." + (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) + (case-fold-search t) + (buf (current-buffer)) + dig) + (save-excursion + (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) + (insert-buffer-substring gnus-original-article-buffer) + (narrow-to-region + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point))) + (goto-char (point-min)) + (delete-matching-lines "^\\(Path\\):\\|^From ") + (widen)) + (unwind-protect + (if (gnus-group-read-ephemeral-group + name `(nndoc ,name (nndoc-address + ,(get-buffer dig)) + (nndoc-article-type ,(if force 'digest 'guess))) t) + ;; Make all postings to this group go to the parent group. + (nconc (gnus-info-params (gnus-get-info name)) + (list (cons 'to-group ogroup))) + ;; Couldn't select this doc group. + (switch-to-buffer buf) + (gnus-set-global-variables) + (gnus-configure-windows 'summary) + (gnus-message 3 "Article couldn't be entered?")) + (kill-buffer dig)))) + + (defun gnus-summary-isearch-article (&optional regexp-p) + "Do incremental search forward on the current article. + If REGEXP-P (the prefix) is non-nil, do regexp isearch." + (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))) + + (defun gnus-summary-search-article-forward (regexp &optional backward) + "Search for an article containing REGEXP forward. + If BACKWARD, search backward instead." + (interactive + (list (read-string + (format "Search article %s (regexp%s): " + (if current-prefix-arg "backward" "forward") + (if gnus-last-search-regexp + (concat ", default " gnus-last-search-regexp) + ""))) + current-prefix-arg)) + (gnus-set-global-variables) + (if (string-equal regexp "") + (setq regexp (or gnus-last-search-regexp "")) + (setq gnus-last-search-regexp regexp)) + (unless (gnus-summary-search-article regexp backward) + (error "Search failed: \"%s\"" regexp))) + + (defun gnus-summary-search-article-backward (regexp) + "Search for an article containing REGEXP backward." + (interactive + (list (read-string + (format "Search article backward (regexp%s): " + (if gnus-last-search-regexp + (concat ", default " gnus-last-search-regexp) + ""))))) + (gnus-summary-search-article-forward regexp 'backward)) + + (defun gnus-summary-search-article (regexp &optional backward) + "Search for an article containing REGEXP. + Optional argument BACKWARD means do search for backward. + `gnus-select-article-hook' is not called during the search." + (let ((gnus-select-article-hook nil) ;Disable hook. + (gnus-article-display-hook nil) + (gnus-mark-article-hook nil) ;Inhibit marking as read. + (re-search + (if backward + 're-search-backward 're-search-forward)) + (sum (current-buffer)) + (found nil)) + (gnus-save-hidden-threads + (gnus-summary-select-article) + (set-buffer gnus-article-buffer) + (when backward + (forward-line -1)) + (while (not found) + (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) + (if (if backward + (re-search-backward regexp nil t) + (re-search-forward regexp nil t)) + ;; We found the regexp. + (progn + (setq found 'found) + (beginning-of-line) + (set-window-start + (get-buffer-window (current-buffer)) + (point)) + (forward-line 1) + (set-buffer sum)) + ;; We didn't find it, so we go to the next article. + (set-buffer sum) + (if (not (if backward (gnus-summary-find-prev) + (gnus-summary-find-next))) + ;; No more articles. + (setq found t) + ;; Select the next article and adjust point. + (gnus-summary-select-article) + (set-buffer gnus-article-buffer) + (widen) + (goto-char (if backward (point-max) (point-min)))))) + (gnus-message 7 "")) + ;; Return whether we found the regexp. + (when (eq found 'found) + (gnus-summary-show-thread) + (gnus-summary-goto-subject gnus-current-article) + (gnus-summary-position-point) + t))) + + (defun gnus-summary-find-matching (header regexp &optional backward unread + not-case-fold) + "Return a list of all articles that match REGEXP on HEADER. + The search stars on the current article and goes forwards unless + BACKWARD is non-nil. If BACKWARD is `all', do all articles. + If UNREAD is non-nil, only unread articles will + 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 (intern (concat "mail-header-" header))) + (error "%s is not a valid header" header)) + (while data + (setq d (car data)) + (and (or (not unread) ; We want all articles... + (gnus-data-unread-p d)) ; Or just unreads. + (vectorp (gnus-data-header d)) ; It's not a pseudo. + (string-match regexp (funcall func (gnus-data-header d))) ; Match. + (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" + "Message-ID" "Xref" "References" "Body")) + nil 'require-match)) + (read-string "Regexp: ") + (read-key-sequence "Command: ") + current-prefix-arg)) + (when (equal header "Body") + (setq header "")) + (gnus-set-global-variables) + ;; Hidden thread subtrees must be searched as well. + (gnus-summary-show-all-threads) + ;; We don't want to change current point nor window configuration. + (save-excursion + (save-window-excursion + (gnus-message 6 "Executing %s..." (key-description command)) + ;; We'd like to execute COMMAND interactively so as to give arguments. + (gnus-execute header regexp + `(lambda () (call-interactively ',(key-binding command))) + backward) + (gnus-message 6 "Executing %s...done" (key-description command))))) + + (defun gnus-summary-beginning-of-article () + "Scroll the article back to the beginning." + (interactive) + (gnus-set-global-variables) + (gnus-summary-select-article) + (gnus-configure-windows 'article) + (gnus-eval-in-buffer-window gnus-article-buffer + (widen) + (goto-char (point-min)) + (and gnus-break-pages (gnus-narrow-to-page)))) + + (defun gnus-summary-end-of-article () + "Scroll to the end of the article." + (interactive) + (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)) + (recenter -3) + (and gnus-break-pages (gnus-narrow-to-page)))) + + (defun gnus-summary-show-article (&optional arg) + "Force re-fetching of the current article. + If ARG (the prefix) is non-nil, show the raw article without any + article massaging functions being run." + (interactive "P") + (gnus-set-global-variables) + (if (not arg) + ;; Select the article the normal way. + (gnus-summary-select-article nil 'force) + ;; Bind the article treatment functions to nil. + (let ((gnus-have-all-headers t) + gnus-article-display-hook + gnus-article-prepare-hook + gnus-break-pages + gnus-visual) + (gnus-summary-select-article nil 'force))) + (gnus-summary-goto-subject gnus-current-article) + ; (gnus-configure-windows 'article) + (gnus-summary-position-point)) + + (defun gnus-summary-verbose-headers (&optional arg) + "Toggle permanent full header display. + If ARG is a positive number, turn header display on. + If ARG is a negative number, turn header display off." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-toggle-header arg) + (setq gnus-show-all-headers + (cond ((or (not (numberp arg)) + (zerop arg)) + (not gnus-show-all-headers)) + ((natnump arg) + t)))) + + (defun gnus-summary-toggle-header (&optional arg) + "Show the headers if they are hidden, or hide them if they are shown. + If ARG is a positive number, show the entire header. + If ARG is a negative number, hide the unwanted header lines." + (interactive "P") + (gnus-set-global-variables) + (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) + (goto-char (point-min)) + (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))))) + (insert-buffer-substring gnus-original-article-buffer 1 e) + (let ((article-inhibit-hiding t)) + (run-hooks 'gnus-article-display-hook)) + (if (or (not hidden) (and (numberp arg) (< arg 0))) + (gnus-article-hide-headers))))) + + (defun gnus-summary-show-all-headers () + "Make all header lines visible." + (interactive) + (gnus-set-global-variables) + (gnus-article-show-all-headers)) + + (defun gnus-summary-toggle-mime (&optional arg) + "Toggle MIME processing. + If ARG is a positive number, turn MIME processing on." + (interactive "P") + (gnus-set-global-variables) + (setq gnus-show-mime + (if (null arg) (not gnus-show-mime) + (> (prefix-numeric-value arg) 0))) + (gnus-summary-select-article t 'force)) + + (defun gnus-summary-caesar-message (&optional arg) + "Caesar rotate the current article by 13. + The numerical prefix specifies how manu places to rotate each letter + forward." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-select-article) + (let ((mail-header-separator "")) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (let ((start (window-start)) + buffer-read-only) + (message-caesar-buffer-body arg) + (set-window-start (get-buffer-window (current-buffer)) start)))))) + + (defun gnus-summary-stop-page-breaking () + "Stop page breaking in the current article." + (interactive) + (gnus-set-global-variables) + (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 non-nil, 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 "P") + (unless action (setq action 'move)) + (gnus-set-global-variables) + ;; Check whether the source group supports the required functions. + (cond ((and (eq action 'move) + (not (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name))) + (error "The current group does not support article moving")) + ((and (eq action 'crosspost) + (not (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 to-groups) + (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)) + (symbol-value (intern (format "gnus-current-%s-group" action))) + articles prefix)) + (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) + (setq to-method (or select-method + (gnus-group-name-to-method 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 (car 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 + to-newsgroup (list 'quote select-method) + (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 + to-newsgroup select-method (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 + to-newsgroup select-method (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) + (or select-method + (gnus-find-method-for-group to-newsgroup))) + gnus-newsrc-hashtb))) + (info (nth 2 entry)) + (to-group (gnus-info-group info))) + ;; Update the group that has been moved to. + (when (and info + (memq action '(move copy))) + (unless (member to-group to-groups) + (push to-group to-groups)) + + (unless (memq article gnus-newsgroup-unreads) + (gnus-info-set-read + info (gnus-add-to-range (gnus-info-read info) + (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 + to-group 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))))) + ;; If the other group is the same as this group, + ;; then we have to add the mark to the list. + (when (equal to-group gnus-newsgroup-name) + (set (intern (format "gnus-newsgroup-%s" (caar marks))) + (cons to-article + (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))))) + ;; Copy mark to other group. + (gnus-add-marked-articles + to-group (cdar 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) + (when (eq action 'move) + (gnus-summary-mark-article article gnus-canceled-mark))) + (gnus-summary-remove-process-mark article)) + ;; Re-activate all groups that have been moved to. + (while to-groups + (gnus-activate-group (pop to-groups))) + + (gnus-kill-buffer copy-buf) + (gnus-summary-position-point) + (gnus-set-mode-line 'summary))) + + (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 non-nil, do not move to a specific newsgroup, but + re-spool using this method." + (interactive "P") + (gnus-summary-move-article n nil select-method '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)) + + (defvar gnus-summary-respool-default-method nil + "Default method for respooling an article. + If nil, use to the current newsgroup method.") + + (defun gnus-summary-respool-article (&optional n method) + "Respool the current article. + The article will be squeezed through the mail spooling process again, + which means that it will be put in some mail newsgroup or other + depending on `nnmail-split-methods'. + If N is a positive number, respool the N next articles. + If N is a negative number, respool the N previous articles. + If N is nil and any articles have been marked with the process mark, + respool those articles instead. + + Respooling can be done both from mail groups and \"real\" newsgroups. + In the former case, the articles in question will be moved from the + current group into whatever groups they are destined to. In the + latter case, they will be copied into the relevant groups." + (interactive + (list current-prefix-arg + (let* ((methods (gnus-methods-using 'respool)) + (methname + (symbol-name (or gnus-summary-respool-default-method + (car (gnus-find-method-for-group + gnus-newsgroup-name))))) + (method + (gnus-completing-read + methname "What backend do you want to use when respooling?" + methods nil t nil 'gnus-method-history)) + ms) + (cond + ((zerop (length (setq ms (gnus-servers-using-backend method)))) + (list (intern method) "")) + ((= 1 (length ms)) + (car ms)) + (t + (cdr (completing-read + "Server name: " + (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t))))))) + (gnus-set-global-variables) + (unless method + (error "No method given for respooling")) + (if (assoc (symbol-name + (car (gnus-find-method-for-group gnus-newsgroup-name))) + (gnus-methods-using 'respool)) + (gnus-summary-move-article n nil method) + (gnus-summary-copy-article n nil 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)) + (or (file-readable-p file) + (not (file-regular-p file)) + (error "Can't read %s" file)) + (save-excursion + (set-buffer (get-buffer-create " *import file*")) + (buffer-disable-undo (current-buffer)) + (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: " (message-make-message-id) "\n" + "Lines: " (int-to-string lines) "\n" + "Chars: " (int-to-string (nth 7 atts)) "\n\n")) + (gnus-request-accept-article group nil t) + (kill-buffer (current-buffer))))) + + (defun gnus-summary-expire-articles (&optional now) + "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)) + (expirable (if total + (gnus-list-of-read-articles gnus-newsgroup-name) + (setq gnus-newsgroup-expirable + (sort gnus-newsgroup-expirable '<)))) + (expiry-wait (if now 'immediate + (gnus-group-get-parameter + gnus-newsgroup-name 'expiry-wait))) + es) + (when expirable + ;; There are expirable articles in this group, so we run them + ;; through the expiry process. + (gnus-message 6 "Expiring articles...") + ;; The list of articles that weren't expired is returned. + (if expiry-wait + (let ((nnmail-expiry-wait-function nil) + (nnmail-expiry-wait expiry-wait)) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (or total (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (while expirable + (unless (memq (car expirable) es) + (when (gnus-data-find (car expirable)) + (gnus-summary-mark-article + (car expirable) gnus-canceled-mark))) + (setq expirable (cdr expirable))))) + (gnus-message 6 "Expiring articles...done"))))) + + (defun gnus-summary-expire-articles-now () + "Expunge all expirable articles in the current group. + This means that *all* articles that are marked as expirable will be + deleted forever, right now." + (interactive) + (gnus-set-global-variables) + (or gnus-expert-user + (gnus-y-or-n-p + "Are you really, really, really sure you want to delete all these messages? ") + (error "Phew!")) + (gnus-summary-expire-articles t)) + + ;; 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) + (format "these %s articles" (length 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)))) + (gnus-summary-position-point) + (gnus-set-mode-line 'summary) + not-deleted)) + + (defun gnus-summary-edit-article (&optional force) + "Enter into a buffer and edit the current article. + This will have permanent effect only in mail groups. + If FORCE is non-nil, allow editing of articles even in read-only + groups." + (interactive "P") + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-set-global-variables) + (when (and (not force) + (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing.")) + (gnus-summary-select-article t nil t) + (gnus-configure-windows 'article) + (select-window (get-buffer-window gnus-article-buffer)) + (gnus-message 6 "C-c C-c to end edits") + (setq buffer-read-only nil) + (text-mode) + (use-local-map (copy-keymap (current-local-map))) + (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) + (buffer-enable-undo) + (widen) + (goto-char (point-min)) + (search-forward "\n\n" nil t))) + + (defun gnus-summary-edit-article-done () + "Make edits to the current article permanent." + (interactive) + (if (gnus-group-read-only-p) + (progn + (let ((beep (not (eq major-mode 'text-mode)))) + (gnus-summary-edit-article-postpone) + (when beep + (gnus-error + 3 "The current newsgroup does not support article editing.")))) + (let ((buf (format "%s" (buffer-string)))) + (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)) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))) + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current)))) + (save-excursion + (when (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq gnus-original-article nil))) + (setq gnus-article-current nil + gnus-current-article nil) + (run-hooks 'gnus-article-display-hook) + (and (gnus-visual-p 'summary-highlight 'highlight) + (run-hooks 'gnus-visual-mark-article-hook))))) + + (defun gnus-summary-edit-article-postpone () + "Postpone changes to the current article." + (interactive) + (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))) + + (defun gnus-summary-respool-query () + "Query where the respool algorithm would put this article." + (interactive) + (gnus-set-global-variables) + (gnus-summary-select-article) + (save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (goto-char (point-min)) + (search-forward "\n\n") + (narrow-to-region (point-min) (point)) + (pp-eval-expression + (list 'quote (mapcar 'car (nnmail-article-group 'identity))))))) + + ;; Summary marking commands. + + (defun gnus-summary-kill-same-subject-and-select (&optional unmark) + "Mark articles which has the same subject as read, and then select the next. + If UNMARK is positive, remove any kind of mark. + If UNMARK is negative, tick articles." + (interactive "P") + (gnus-set-global-variables) + (if unmark + (setq unmark (prefix-numeric-value unmark))) + (let ((count + (gnus-summary-mark-same-subject + (gnus-summary-article-subject) unmark))) + ;; Select next unread article. If auto-select-same mode, should + ;; select the first unread article. + (gnus-summary-next-article t (and gnus-auto-select-same + (gnus-summary-article-subject))) + (gnus-message 7 "%d article%s marked as %s" + count (if (= count 1) " is" "s are") + (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") + (gnus-set-global-variables) + (if unmark + (setq unmark (prefix-numeric-value unmark))) + (let ((count + (gnus-summary-mark-same-subject + (gnus-summary-article-subject) unmark))) + ;; If marked as read, go to next unread subject. + (if (null unmark) + ;; Go to next unread subject. + (gnus-summary-next-subject 1 t)) + (gnus-message 7 "%d articles are marked as %s" + count (if unmark "unread" "read")))) + + (defun gnus-summary-mark-same-subject (subject &optional unmark) + "Mark articles with same SUBJECT as read, and return marked number. + If optional argument UNMARK is positive, remove any kinds of marks. + 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) + (gnus-summary-find-subject subject)) + (setq count (1+ count)))) + ((> unmark 0) ; Tick. + (while (and + (progn + (gnus-summary-mark-article-as-unread gnus-ticked-mark) + (gnus-summary-show-thread) t) + (gnus-summary-find-subject subject)) + (setq count (1+ count)))) + (t ; Mark as unread. + (while (and + (progn + (gnus-summary-mark-article-as-unread gnus-unread-mark) + (gnus-summary-show-thread) t) + (gnus-summary-find-subject subject)) + (setq count (1+ count))))) + (gnus-set-mode-line 'summary) + ;; Return the number of marked articles. + count))) + + (defun gnus-summary-mark-as-processable (n &optional unmark) + "Set the process mark on the next N articles. + If N is negative, mark backward instead. If UNMARK is non-nil, remove + the process mark instead. The difference between N and the actual + number of articles marked is returned." + (interactive "p") + (gnus-set-global-variables) + (let ((backward (< n 0)) + (n (abs n))) + (while (and + (> n 0) + (if unmark + (gnus-summary-remove-process-mark + (gnus-summary-article-number)) + (gnus-summary-set-process-mark (gnus-summary-article-number))) + (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) + (setq n (1- n))) + (if (/= 0 n) (gnus-message 7 "No more articles")) + (gnus-summary-recenter) + (gnus-summary-position-point) + n)) + + (defun gnus-summary-unmark-as-processable (n) + "Remove the process mark from the next N articles. + If N is negative, mark backward instead. The difference between N and + the actual number of articles marked is returned." + (interactive "p") + (gnus-set-global-variables) + (gnus-summary-mark-as-processable n t)) + + (defun gnus-summary-unmark-all-processable () + "Remove the process mark from all articles." + (interactive) + (gnus-set-global-variables) + (save-excursion + (while gnus-newsgroup-processable + (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) + (gnus-summary-position-point)) + + (defun gnus-summary-mark-as-expirable (n) + "Mark N articles forward as expirable. + If N is negative, mark backward instead. The difference between N and + the actual number of articles marked is returned." + (interactive "p") + (gnus-set-global-variables) + (gnus-summary-mark-forward n gnus-expirable-mark)) + + (defun gnus-summary-mark-article-as-replied (article) + "Mark ARTICLE replied and update the summary line." + (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) + (let ((buffer-read-only nil)) + (when (gnus-summary-goto-subject article) + (gnus-summary-update-secondary-mark article)))) + + (defun gnus-summary-set-bookmark (article) + "Set a bookmark in current article." + (interactive (list (gnus-summary-article-number))) + (gnus-set-global-variables) + (if (or (not (get-buffer gnus-article-buffer)) + (not gnus-current-article) + (not gnus-article-current) + (not (equal gnus-newsgroup-name (car gnus-article-current)))) + (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 + (min (point) + (save-excursion + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (point))) + (point)))) + gnus-newsgroup-bookmarks)) + (gnus-message 6 "A bookmark has been added to the current article.")) + + (defun gnus-summary-remove-bookmark (article) + "Remove the bookmark from the current article." + (interactive (list (gnus-summary-article-number))) + (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.")))) + + ;; Suggested by Daniel Quinlan . + (defun gnus-summary-mark-as-dormant (n) + "Mark N articles forward as dormant. + If N is negative, mark backward instead. The difference between N and + the actual number of articles marked is returned." + (interactive "p") + (gnus-set-global-variables) + (gnus-summary-mark-forward n gnus-dormant-mark)) + + (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) + (gnus-summary-update-secondary-mark article))) + + (defun gnus-summary-remove-process-mark (article) + "Remove the process mark from ARTICLE and update the summary line." + (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) + (when (gnus-summary-goto-subject article) + (gnus-summary-show-thread) + (gnus-summary-update-secondary-mark article))) + + (defun gnus-summary-set-saved-mark (article) + "Set the process mark on ARTICLE and update the summary line." + (push article gnus-newsgroup-saved) + (when (gnus-summary-goto-subject article) + (gnus-summary-update-secondary-mark article))) + + (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, ?r by default. + The difference between N and the actual number of articles marked is + returned." + (interactive "p") + (gnus-set-global-variables) + (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) + (gnus-summary-position-point) + (gnus-set-mode-line 'summary) + n)) + + (defun gnus-summary-mark-article-as-read (mark) + "Mark the current article quickly as read with MARK." + (let ((article (gnus-summary-article-number))) + (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) + (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (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)) + + (defun gnus-summary-mark-article-as-unread (mark) + "Mark the current article quickly as unread with MARK." + (let ((article (gnus-summary-article-number))) + (if (< article 0) + (gnus-error 1 "Unmarkable article") + (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) + (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) + (cond ((= mark gnus-ticked-mark) + (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)) + + ;; See whether the article is to be put in the cache. + (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)))) + + ;; Fix the mark. + (gnus-summary-update-mark mark 'unread)) + t)) + + (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)))) + (setq mark gnus-expirable-mark)) + (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)) + + ;; See whether the article is to be put in the cache. + (and gnus-use-cache + (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)))) + + (if (gnus-summary-goto-subject article nil t) + (let ((buffer-read-only nil)) + (gnus-summary-show-thread) + ;; Fix the mark. + (gnus-summary-update-mark mark 'unread) + t)))) + + (defun gnus-summary-update-secondary-mark (article) + "Update the secondary (read, process, cache) mark." + (gnus-summary-update-mark + (cond ((memq article gnus-newsgroup-processable) + gnus-process-mark) + ((memq article gnus-newsgroup-cached) + gnus-cached-mark) + ((memq article gnus-newsgroup-replied) + gnus-replied-mark) + ((memq article gnus-newsgroup-saved) + gnus-saved-mark) + (t gnus-unread-mark)) + 'replied) + (when (gnus-visual-p 'summary-highlight 'highlight) + (run-hooks 'gnus-summary-update-hook)) + t) + + (defun gnus-summary-update-mark (mark type) + (beginning-of-line) + (let ((forward (cdr (assq type gnus-summary-mark-positions))) + (buffer-read-only nil)) + (when (and forward + (<= (+ forward (point)) (point-max))) + ;; Go to the right position on the line. + (goto-char (+ forward (point))) + ;; Replace the old mark with the new mark. + (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. + (let ((mark (or mark gnus-del-mark))) + (if (= mark gnus-expirable-mark) + (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) + (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) + ;; Remove from unread and marked lists. + (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) + (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) + "Enter ARTICLE in the pertinent lists and remove it from others." + (let ((mark (or mark gnus-ticked-mark))) + (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) + (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) + (cond ((= mark gnus-ticked-mark) + (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. + If N is negative, tick backwards instead. + The difference between N and the number of articles ticked is returned." + (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. + The difference between N and the number of articles ticked is returned." + (interactive "p") + (gnus-summary-mark-forward (- n) gnus-ticked-mark)) + + (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) + (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) + (defun gnus-summary-tick-article (&optional article clear-mark) + "Mark current article as unread. + Optional 1st argument ARTICLE specifies article number to be marked as unread. + Optional 2nd argument CLEAR-MARK remove any kinds of mark." + (interactive) + (gnus-summary-mark-article article (if clear-mark gnus-unread-mark + gnus-ticked-mark))) + + (defun gnus-summary-mark-as-read-forward (n) + "Mark N articles as read forwards. + If N is negative, mark backwards instead. + The difference between N and the actual number of articles marked is + returned." + (interactive "p") + (gnus-summary-mark-forward n gnus-del-mark t)) + + (defun gnus-summary-mark-as-read-backward (n) + "Mark the N articles as read backwards. + The difference between N and the actual number of articles marked is + returned." + (interactive "p") + (gnus-summary-mark-forward (- n) gnus-del-mark t)) + + (defun gnus-summary-mark-as-read (&optional article mark) + "Mark current article as read. + ARTICLE specifies the article to be marked as read. + MARK specifies a string to be inserted at the beginning of the line." + (gnus-summary-mark-article article mark)) + + (defun gnus-summary-clear-mark-forward (n) + "Clear marks from N articles forward. + If N is negative, clear backward instead. + The difference between N and the number of marks cleared is returned." + (interactive "p") + (gnus-summary-mark-forward n gnus-unread-mark)) + + (defun gnus-summary-clear-mark-backward (n) + "Clear marks from N articles backward. + The difference between N and the number of marks cleared is returned." + (interactive "p") + (gnus-summary-mark-forward (- n) gnus-unread-mark)) + + (defun gnus-summary-mark-unread-as-read () + "Intended to be used by `gnus-summary-mark-article-hook'." + (when (memq gnus-current-article gnus-newsgroup-unreads) + (gnus-summary-mark-article gnus-current-article gnus-read-mark))) + + (defun gnus-summary-mark-read-and-unread-as-read () + "Intended to be used by `gnus-summary-mark-article-hook'." + (let ((mark (gnus-summary-article-mark))) + (when (or (gnus-unread-mark-p mark) + (gnus-read-mark-p mark)) + (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) + + (defun gnus-summary-mark-region-as-read (point mark all) + "Mark all unread articles between point and mark as read. + If given a prefix, mark all articles between point and mark as read, + even ticked and dormant ones." + (interactive "r\nP") + (save-excursion + (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)) + t) + (gnus-summary-find-next)))))) + + (defun gnus-summary-mark-below (score mark) + "Mark articles with score less than SCORE with MARK." + (interactive "P\ncMark: ") + (gnus-set-global-variables) + (setq score (if score + (prefix-numeric-value score) + (or gnus-summary-default-score 0))) + (save-excursion + (set-buffer gnus-summary-buffer) + (goto-char (point-min)) + (while + (progn + (and (< (gnus-summary-article-score) score) + (gnus-summary-mark-article nil mark)) + (gnus-summary-find-next))))) + + (defun gnus-summary-kill-below (&optional score) + "Mark articles with score below SCORE as read." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-mark-below score gnus-killed-mark)) + + (defun gnus-summary-clear-above (&optional score) + "Clear all marks from articles with score above SCORE." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-mark-above score gnus-unread-mark)) + + (defun gnus-summary-tick-above (&optional score) + "Tick all articles with score above SCORE." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-mark-above score gnus-ticked-mark)) + + (defun gnus-summary-mark-above (score mark) + "Mark articles with score over SCORE with MARK." + (interactive "P\ncMark: ") + (gnus-set-global-variables) + (setq score (if score + (prefix-numeric-value score) + (or gnus-summary-default-score 0))) + (save-excursion + (set-buffer gnus-summary-buffer) + (goto-char (point-min)) + (while (and (progn + (if (> (gnus-summary-article-score) score) + (gnus-summary-mark-article nil mark)) + 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 (&optional no-error) + "Display all the hidden articles that were expunged for low scores." + (interactive) + (gnus-set-global-variables) + (let ((buffer-read-only nil)) + (let ((scored gnus-newsgroup-scored) + headers h) + (while scored + (or (gnus-summary-goto-subject (caar scored)) + (and (setq h (gnus-summary-article-header (caar scored))) + (< (cdar scored) gnus-summary-expunge-below) + (setq headers (cons h headers)))) + (setq scored (cdr scored))) + (if (not headers) + (when (not no-error) + (error "No expunged articles hidden.")) + (goto-char (point-min)) + (gnus-summary-prepare-unthreaded (nreverse headers)) + (goto-char (point-min)) + (gnus-summary-position-point) + t)))) + + (defun gnus-summary-catchup (&optional all quietly to-here not-mark) + "Mark all articles not marked as unread in this newsgroup as read. + If prefix argument ALL is non-nil, all articles are marked as read. + If QUIETLY is non-nil, no questions will be asked. + If TO-HERE is non-nil, it should be a point in the buffer. All + articles before this point will be marked as read. + The number of articles marked as read is returned." + (interactive "P") + (gnus-set-global-variables) + (prog1 + (if (or quietly + (not gnus-interactive-catchup) ;Without confirmation? + gnus-expert-user + (gnus-y-or-n-p + (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 + (when all + (setq gnus-newsgroup-marked nil + 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))))) + (unless to-here + (setq gnus-newsgroup-unreads nil)) + (gnus-set-mode-line 'summary))) + (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) + (if (and (not to-here) (eq 'nnvirtual (car method))) + (nnvirtual-catchup-group + (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) + (gnus-summary-position-point))) + + (defun gnus-summary-catchup-to-here (&optional all) + "Mark all unticked articles before the current one as read. + If ALL is non-nil, also mark ticked and dormant articles as read." + (interactive "P") + (gnus-set-global-variables) + (save-excursion + (gnus-save-hidden-threads + (let ((beg (point))) + ;; We check that there are unread articles. + (when (or all (gnus-summary-find-prev)) + (gnus-summary-catchup all t beg))))) + (gnus-summary-position-point)) + + (defun gnus-summary-catchup-all (&optional quietly) + "Mark all articles in this newsgroup as read." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-catchup t quietly)) + + (defun gnus-summary-catchup-and-exit (&optional all quietly) + "Mark all articles not marked as unread in this newsgroup as read, then exit. + If prefix argument ALL is non-nil, all articles are marked as read." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-catchup all quietly nil 'fast) + ;; Select next newsgroup or exit. + (if (eq gnus-auto-select-next 'quietly) + (gnus-summary-next-group nil) + (gnus-summary-exit))) + + (defun gnus-summary-catchup-all-and-exit (&optional quietly) + "Mark all articles in this newsgroup as read, and then exit." + (interactive "P") + (gnus-set-global-variables) + (gnus-summary-catchup-and-exit t quietly)) + + ;; Suggested by "Arne Eofsson" . + (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 + (gnus-summary-catchup all)) + (gnus-summary-next-article t nil nil t)) + + ;; Thread-based commands. + + (defun gnus-summary-articles-in-thread (&optional article) + "Return a list of all articles in the current thread. + If ARTICLE is non-nil, return all articles in the thread that starts + with that article." + (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))))) + ((eq gnus-thread-operation-ignore-subject 'fuzzy) + (gnus-simplify-subject-fuzzy + (mail-header-subject (gnus-data-header (car data))))) + (t nil))) + (end-point (save-excursion + (if (gnus-summary-go-to-next-thread) + (point) (point-max)))) + articles) + (while (and data + (< (gnus-data-pos (car data)) end-point)) + (when (or (not top-subject) + (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))))))) + (push (gnus-data-number (car data)) articles)) + (unless (and (setq data (cdr data)) + (> (gnus-data-level (car data)) top-level)) + (setq data nil))) + ;; Return the list of articles. + (nreverse articles))) + + (defun gnus-summary-rethread-current () + "Rethread the thread the current article is part of." + (interactive) + (gnus-set-global-variables) + (let* ((gnus-show-threads t) + (article (gnus-summary-article-number)) + (id (mail-header-id (gnus-summary-article-header))) + (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) + (unless id + (error "No article on the current line")) + (gnus-rebuild-thread id) + (gnus-summary-goto-subject article))) + + (defun gnus-summary-reparent-thread () + "Make current article child of the marked (or previous) article. + + Note that the re-threading will only work if `gnus-thread-ignore-subject' + is non-nil or the Subject: of both articles are the same." + (interactive) + (or (not (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing.")) + (or (<= (length gnus-newsgroup-processable) 1) + (error "No more than one article may be marked.")) + (save-window-excursion + (let ((gnus-article-buffer " *reparent*") + (current-article (gnus-summary-article-number)) + ; first grab the marked article, otherwise one line up. + (parent-article (if (not (null gnus-newsgroup-processable)) + (car gnus-newsgroup-processable) + (save-excursion + (if (eq (forward-line -1) 0) + (gnus-summary-article-number) + (error "Beginning of summary buffer.")))))) + (or (not (eq current-article parent-article)) + (error "An article may not be self-referential.")) + (let ((message-id (mail-header-id + (gnus-summary-article-header parent-article)))) + (or (and message-id (not (equal message-id ""))) + (error "No message-id in desired parent.")) + (gnus-summary-select-article t t nil current-article) + (set-buffer gnus-article-buffer) + (setq buffer-read-only nil) + (let ((buf (format "%s" (buffer-string)))) + (erase-buffer) + (insert buf)) + (goto-char (point-min)) + (if (search-forward-regexp "^References: " nil t) + (insert message-id " " ) + (insert "References: " message-id "\n")) + (or (gnus-request-replace-article current-article + (car gnus-article-current) + gnus-article-buffer) + (error "Couldn't replace article.")) + (set-buffer gnus-summary-buffer) + (gnus-summary-unmark-all-processable) + (gnus-summary-rethread-current) + (gnus-message 3 "Article %d is now the child of article %d." + current-article parent-article))))) + + (defun gnus-summary-toggle-threads (&optional arg) + "Toggle showing conversation threads. + If ARG is positive number, turn showing conversation threads on." + (interactive "P") + (gnus-set-global-variables) + (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) + (setq gnus-show-threads + (if (null arg) (not gnus-show-threads) + (> (prefix-numeric-value arg) 0))) + (gnus-summary-prepare) + (gnus-summary-goto-subject current) + (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off")) + (gnus-summary-position-point))) + + (defun gnus-summary-show-all-threads () + "Show all threads." + (interactive) + (gnus-set-global-variables) + (save-excursion + (let ((buffer-read-only nil)) + (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) + (gnus-summary-position-point)) + + (defun gnus-summary-show-thread () + "Show thread subtrees. + Returns nil if no thread was there to be shown." + (interactive) + (gnus-set-global-variables) + (let ((buffer-read-only nil) + (orig (point)) + ;; first goto end then to beg, to have point at beg after let + (end (progn (end-of-line) (point))) + (beg (progn (beginning-of-line) (point)))) + (prog1 + ;; Any hidden lines here? + (search-forward "\r" end t) + (subst-char-in-region beg end ?\^M ?\n t) + (goto-char orig) + (gnus-summary-position-point)))) + + (defun gnus-summary-hide-all-threads () + "Hide all thread subtrees." + (interactive) + (gnus-set-global-variables) + (save-excursion + (goto-char (point-min)) + (gnus-summary-hide-thread) + (while (zerop (gnus-summary-next-thread 1 t)) + (gnus-summary-hide-thread))) + (gnus-summary-position-point)) + + (defun gnus-summary-hide-thread () + "Hide thread subtrees. + Returns nil if no threads were there to be hidden." + (interactive) + (gnus-set-global-variables) + (let ((buffer-read-only nil) + (start (point)) + (article (gnus-summary-article-number))) + (goto-char start) + ;; Go forward until either the buffer ends or the subthread + ;; ends. + (when (and (not (eobp)) + (or (zerop (gnus-summary-next-thread 1 t)) + (goto-char (point-max)))) + (prog1 + (if (and (> (point) start) + (search-backward "\n" start t)) + (progn + (subst-char-in-region start (point) ?\n ?\^M) + (gnus-summary-goto-subject article)) + (goto-char start) + nil) + ;;(gnus-summary-position-point) + )))) + + (defun gnus-summary-go-to-next-thread (&optional previous) + "Go to the same level (or less) next thread. + If PREVIOUS is non-nil, go to previous thread instead. + Return the article number moved to, or nil if moving was impossible." + (let ((level (gnus-summary-thread-level)) + (way (if previous -1 1)) + (beg (point))) + (forward-line way) + (while (and (not (eobp)) + (< level (gnus-summary-thread-level))) + (forward-line way)) + (if (eobp) + (progn + (goto-char beg) + nil) + (setq beg (point)) + (prog1 + (gnus-summary-article-number) + (goto-char beg))))) + + (defun gnus-summary-go-to-next-thread-old (&optional previous) + "Go to the same level (or less) next thread. + If PREVIOUS is non-nil, go to previous thread instead. + Return the article number moved to, or nil if moving was impossible." + (if (and (eq gnus-summary-make-false-root 'dummy) + (gnus-summary-article-intangible-p)) + (let ((beg (point))) + (while (and (zerop (forward-line 1)) + (not (gnus-summary-article-intangible-p)) + (not (zerop (save-excursion + (gnus-summary-thread-level)))))) + (if (eobp) + (progn + (goto-char beg) + nil) + (point))) + (let* ((level (gnus-summary-thread-level)) + (article (gnus-summary-article-number)) + (data (cdr (gnus-data-find-list article (gnus-data-list previous)))) + oart) + (while data + (if (<= (gnus-data-level (car data)) level) + (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) + "Go to the same level next N'th thread. + If N is negative, search backward instead. + Returns the difference between N and the number of skips actually + done. + + If SILENT, don't output messages." + (interactive "p") + (gnus-set-global-variables) + (let ((backward (< n 0)) + (n (abs n)) + old dum int) + (while (and (> n 0) + (gnus-summary-go-to-next-thread backward)) + (decf n)) + (unless silent + (gnus-summary-position-point)) + (when (and (not silent) (/= 0 n)) + (gnus-message 7 "No more threads")) + n)) + + (defun gnus-summary-prev-thread (n) + "Go to the same level previous N'th thread. + Returns the difference between N and the number of skips actually + done." + (interactive "p") + (gnus-set-global-variables) + (gnus-summary-next-thread (- n))) + + (defun gnus-summary-go-down-thread () + "Go down one level in the current thread." + (let ((children (gnus-summary-article-children))) + (and children + (gnus-summary-goto-subject (car children))))) + + (defun gnus-summary-go-up-thread () + "Go up one level in the current thread." + (let ((parent (gnus-summary-article-parent))) + (and parent + (gnus-summary-goto-subject parent)))) + + (defun gnus-summary-down-thread (n) + "Go down thread N steps. + If N is negative, go up instead. + Returns the difference between N and how many steps down that were + taken." + (interactive "p") + (gnus-set-global-variables) + (let ((up (< n 0)) + (n (abs n))) + (while (and (> n 0) + (if up (gnus-summary-go-up-thread) + (gnus-summary-go-down-thread))) + (setq n (1- n))) + (gnus-summary-position-point) + (if (/= 0 n) (gnus-message 7 "Can't go further")) + n)) + + (defun gnus-summary-up-thread (n) + "Go up thread N steps. + If N is negative, go up instead. + Returns the difference between N and how many steps down that were + taken." + (interactive "p") + (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. + If the prefix argument is negative, tick articles instead." + (interactive "P") + (gnus-set-global-variables) + (when unmark + (setq unmark (prefix-numeric-value unmark))) + (let ((articles (gnus-summary-articles-in-thread))) + (save-excursion + ;; Expand the thread. + (gnus-summary-show-thread) + ;; 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. + (and (null unmark) + gnus-thread-hide-killed + (gnus-summary-hide-thread)) + ;; If marked as read, go to next unread subject. + (if (null unmark) + ;; Go to next unread subject. + (gnus-summary-next-subject 1 t))) + (gnus-set-mode-line 'summary)) + + ;; Summary sorting commands + + (defun gnus-summary-sort-by-number (&optional reverse) + "Sort summary buffer by article number. + Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'number reverse)) + + (defun gnus-summary-sort-by-author (&optional reverse) + "Sort summary buffer by author name alphabetically. + If case-fold-search is non-nil, case of letters is ignored. + Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'author reverse)) + + (defun gnus-summary-sort-by-subject (&optional reverse) + "Sort summary buffer by subject alphabetically. `Re:'s are ignored. + If case-fold-search is non-nil, case of letters is ignored. + Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'subject reverse)) + + (defun gnus-summary-sort-by-date (&optional reverse) + "Sort summary buffer by date. + Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'date reverse)) + + (defun gnus-summary-sort-by-score (&optional reverse) + "Sort summary buffer by score. + Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'score reverse)) + + (defun gnus-summary-sort (predicate reverse) + "Sort summary buffer by PREDICATE. REVERSE means reverse order." + (gnus-set-global-variables) + (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) + (article (intern (format "gnus-article-sort-by-%s" predicate))) + (gnus-thread-sort-functions + (list + (if (not reverse) + thread + `(lambda (t1 t2) + (,thread t2 t1))))) + (gnus-article-sort-functions + (list + (if (not reverse) + article + `(lambda (t1 t2) + (,article t2 t1))))) + (buffer-read-only) + (gnus-summary-prepare-hook nil)) + ;; We do the sorting by regenerating the threads. + (gnus-summary-prepare) + ;; Hide subthreads if needed. + (when (and gnus-show-threads gnus-thread-hide-subtree) + (gnus-summary-hide-all-threads)))) + + ;; Summary saving commands. + + (defun gnus-summary-save-article (&optional n not-saved) + "Save the current article using the default saver function. + If N is a positive number, save the N next articles. + If N is a negative number, save the N previous articles. + If N is nil and any articles have been marked with the process mark, + save those articles instead. + The variable `gnus-default-article-saver' specifies the saver function." + (interactive "P") + (gnus-set-global-variables) + (let ((articles (gnus-summary-work-articles n)) + (save-buffer (save-excursion + (nnheader-set-temp-buffer " *Gnus Save*"))) + header article file) + (while articles + (setq header (gnus-summary-article-header + (setq article (pop articles)))) + (if (not (vectorp header)) + ;; This is a pseudo-article. + (if (assq 'name header) + (gnus-copy-file (cdr (assq 'name header))) + (gnus-message 1 "Article %d is unsaveable" article)) + ;; This is a real article. + (save-window-excursion + (gnus-summary-select-article t nil nil article)) + (save-excursion + (set-buffer save-buffer) + (erase-buffer) + (insert-buffer-substring gnus-original-article-buffer)) + (setq file (gnus-article-save save-buffer file)) + (gnus-summary-remove-process-mark article) + (unless not-saved + (gnus-summary-set-saved-mark article)))) + (gnus-kill-buffer save-buffer) + (gnus-summary-position-point) + n)) + + (defun gnus-summary-pipe-output (&optional arg) + "Pipe the current article to a subprocess. + If N is a positive number, pipe the N next articles. + If N is a negative number, pipe the N previous articles. + If N is nil and any articles have been marked with the process mark, + pipe those articles instead." + (interactive "P") + (gnus-set-global-variables) + (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) + (gnus-summary-save-article arg t)) + (gnus-configure-windows 'pipe)) + + (defun gnus-summary-save-article-mail (&optional arg) + "Append the current article to an mail file. + If N is a positive number, save the N next articles. + If N is a negative number, save the N previous articles. + If N is nil and any articles have been marked with the process mark, + save those articles instead." + (interactive "P") + (gnus-set-global-variables) + (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) + (gnus-summary-save-article arg))) + + (defun gnus-summary-save-article-rmail (&optional arg) + "Append the current article to an rmail file. + If N is a positive number, save the N next articles. + If N is a negative number, save the N previous articles. + If N is nil and any articles have been marked with the process mark, + save those articles instead." + (interactive "P") + (gnus-set-global-variables) + (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) + (gnus-summary-save-article arg))) + + (defun gnus-summary-save-article-file (&optional arg) + "Append the current article to a file. + If N is a positive number, save the N next articles. + If N is a negative number, save the N previous articles. + If N is nil and any articles have been marked with the process mark, + save those articles instead." + (interactive "P") + (gnus-set-global-variables) + (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) + (gnus-summary-save-article arg))) + + (defun gnus-summary-save-article-body-file (&optional arg) + "Append the current article body to a file. + If N is a positive number, save the N next articles. + If N is a negative number, save the N previous articles. + If N is nil and any articles have been marked with the process mark, + save those articles instead." + (interactive "P") + (gnus-set-global-variables) + (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) + (gnus-summary-save-article arg))) + + (defun gnus-get-split-value (methods) + "Return a value based on the split METHODS." + (let (split-name method result match) + (when methods + (save-excursion + (set-buffer gnus-original-article-buffer) + (save-restriction + (nnheader-narrow-to-headers) + (while methods + (goto-char (point-min)) + (setq method (pop methods)) + (setq match (car method)) + (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))))) + (setq split-name (append (cdr method) split-name)) + (cond ((stringp result) + (push result split-name)) + ((consp result) + (setq split-name (append result split-name))))))))) + split-name)) + + (defun gnus-read-move-group-name (prompt default articles prefix) + "Read a group name." + (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) + (minibuffer-confirm-incomplete nil) ; XEmacs + group-map + (dum (mapatoms + (lambda (g) + (and (boundp g) + (symbol-name g) + (memq 'respool + (assoc (symbol-name + (car (gnus-find-method-for-group + (symbol-name g)))) + gnus-valid-select-methods)) + (push (list (symbol-name g)) group-map))) + gnus-active-hashtb)) + (prom + (format "%s %s to:" + prompt + (if (> (length articles) 1) + (format "these %d articles" (length articles)) + "this article"))) + (to-newsgroup + (cond + ((null split-name) + (gnus-completing-read default prom + group-map nil nil prefix + 'gnus-group-history)) + ((= 1 (length split-name)) + (gnus-completing-read (car split-name) prom group-map + nil nil nil + 'gnus-group-history)) + (t + (gnus-completing-read nil prom + (mapcar (lambda (el) (list el)) + (nreverse split-name)) + nil nil nil + 'gnus-group-history))))) + (when to-newsgroup + (if (or (string= to-newsgroup "") + (string= to-newsgroup prefix)) + (setq to-newsgroup (or default ""))) + (or (gnus-active to-newsgroup) + (gnus-activate-group to-newsgroup) + (if (gnus-y-or-n-p (format "No such group: %s. Create it? " + to-newsgroup)) + (or (and (gnus-request-create-group + to-newsgroup (gnus-group-name-to-method to-newsgroup)) + (gnus-activate-group to-newsgroup nil nil + (gnus-group-name-to-method + to-newsgroup))) + (error "Couldn't create group %s" to-newsgroup))) + (error "No such group: %s" to-newsgroup))) + to-newsgroup)) + + ;; Summary extract commands + + (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<))) + files action) + (while ps + (setq action (cdr (assq 'action (car ps)))) + (setq files (list (cdr (assq 'name (car ps))))) + (while (and ps (cdr ps) + (string= (or action "1") + (or (cdr (assq 'action (cadr ps))) "2"))) + (setq files (cons (cdr (assq 'name (cadr ps))) files)) + (setcdr ps (cddr ps))) + (if (not files) + () + (if (not (string-match "%s" action)) + (setq files (cons " " files))) + (setq files (cons " " files)) + (and (assq 'execute (car ps)) + (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)) + (while pslist + (and (assq 'execute (car pslist)) + (gnus-execute-command (cdr (assq 'execute (car pslist))) + (eq gnus-view-pseudos 'not-confirm))) + (setq pslist (cdr pslist))) + (save-excursion + (while pslist + (setq after-article (or (cdr (assq 'article (car pslist))) + (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' + (gnus-add-text-properties + b (1- 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)) + (push gnus-reffed-article-number gnus-newsgroup-unreads) + (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) + (setq pslist (cdr pslist))))))) + + (defun gnus-pseudos< (p1 p2) + (let ((c1 (cdr (assq 'action p1))) + (c2 (cdr (assq 'action p2)))) + (and c1 c2 (string< c1 c2)))) + + (defun gnus-request-pseudo-article (props) + (cond ((assq 'execute props) + (gnus-execute-command (cdr (assq 'execute props))))) + (let ((gnus-current-article (gnus-summary-article-number))) + (run-hooks 'gnus-mark-article-hook))) + + (defun gnus-execute-command (command &optional automatic) + (save-excursion + (gnus-article-setup-buffer) + (set-buffer gnus-article-buffer) + (setq buffer-read-only nil) + (let ((command (if automatic command (read-string "Command: " command))) + ;; Just binding this here doesn't help, because there might + ;; be output from the process after exiting the scope of + ;; this `let'. + ;; (buffer-read-only nil) + ) + (erase-buffer) + (insert "$ " command "\n\n") + (if gnus-view-pseudo-asynchronously + (start-process "gnus-execute" nil shell-file-name + shell-command-switch command) + (call-process shell-file-name nil t nil + shell-command-switch command))))) + + ;; Summary kill commands. + + (defun gnus-summary-edit-global-kill (article) + "Edit the \"global\" kill file." + (interactive (list (gnus-summary-article-number))) + (gnus-set-global-variables) + (gnus-group-edit-global-kill article)) + + (defun gnus-summary-edit-local-kill () + "Edit a local kill file applied to the current newsgroup." + (interactive) + (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)) + + ;;; Header reading. + + (defun gnus-read-header (id &optional header) + "Read the headers of article ID and enter them into the Gnus system." + (let ((group gnus-newsgroup-name) + (gnus-override-method + (and (gnus-news-group-p gnus-newsgroup-name) + gnus-refer-article-method)) + where) + ;; First we check to see whether the header in question is already + ;; fetched. + (if (stringp id) + ;; This is a Message-ID. + (setq header (or header (gnus-id-to-header id))) + ;; This is an article number. + (setq header (or header (gnus-summary-article-header id)))) + (if (and header + (not (memq (mail-header-number header) gnus-newsgroup-sparse))) + ;; We have found the header. + header + ;; We have to really fetch the header to this article. + (when (setq where (gnus-request-head id group)) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-max)) + (insert ".\n") + (goto-char (point-min)) + (insert "211 ") + (princ (cond + ((numberp id) id) + ((cdr where) (cdr where)) + (header (mail-header-number header)) + (t gnus-reffed-article-number)) + (current-buffer)) + (insert " Article retrieved.\n")) + ;(when (and header + ; (memq (mail-header-number header) gnus-newsgroup-sparse)) + ; (setcar (gnus-id-to-thread id) nil)) + (if (not (setq header (car (gnus-get-newsgroup-headers)))) + () ; Malformed head. + (unless (memq (mail-header-number header) gnus-newsgroup-sparse) + (if (and (stringp id) + (not (string= (gnus-group-real-name group) + (car where)))) + ;; If we fetched by Message-ID and the article came + ;; from a different group, we fudge some bogus article + ;; numbers for this article. + (mail-header-set-number header gnus-reffed-article-number)) + (decf gnus-reffed-article-number) + (gnus-remove-header (mail-header-number header)) + (push header gnus-newsgroup-headers) + (setq gnus-current-headers header) + (push (mail-header-number header) gnus-newsgroup-limit)) + header))))) + + (defun gnus-remove-header (number) + "Remove header NUMBER from `gnus-newsgroup-headers'." + (if (and gnus-newsgroup-headers + (= number (mail-header-number (car gnus-newsgroup-headers)))) + (pop gnus-newsgroup-headers) + (let ((headers gnus-newsgroup-headers)) + (while (and (cdr headers) + (not (= number (mail-header-number (cadr headers))))) + (pop headers)) + (when (cdr headers) + (setcdr headers (cddr headers)))))) + + (provide 'gnus-sum) + + ;;; gnus-sum.el ends here *** pub/rgnus/lisp/gnus-topic.el Tue Jul 30 19:55:35 1996 --- rgnus/lisp/gnus-topic.el Mon Jul 29 13:50:52 1996 *************** *** 26,33 **** ;;; Code: (require 'gnus) - (eval-when-compile (require 'cl)) (defvar gnus-topic-mode nil "Minor mode for Gnus group buffers.") --- 26,35 ---- ;;; Code: + (require 'gnus-load) + (require 'gnus-group) + (require 'gnus-start) (require 'gnus) (defvar gnus-topic-mode nil "Minor mode for Gnus group buffers.") *************** *** 378,384 **** gnus-topic-tallied-groups nil gnus-topology-checked-p nil)) - (defun gnus-topic-check-topology () ;; The first time we set the topology to whatever we have ;; gotten here, which can be rather random. --- 380,385 ---- *************** *** 426,431 **** --- 427,433 ---- (defvar gnus-tmp-topics nil) (defun gnus-topic-list (&optional topology) + "Return a list of all topics in the topology." (unless topology (setq topology gnus-topic-topology gnus-tmp-topics nil)) *** pub/rgnus/lisp/gnus-util.el Tue Jul 30 22:59:22 1996 --- rgnus/lisp/gnus-util.el Mon Jul 29 13:29:57 1996 *************** *** 0 **** --- 1,503 ---- + ;;; gnus-util.el --- utility functions for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; Nothing in this file depends on any other parts of Gnus -- all + ;; functions and macros in this file are utility functions that are + ;; used by Gnus and may be used by any other package without loading + ;; Gnus first. + + ;;; Code: + + (require 'cl) + (require 'nnheader) + (require 'timezone) + (require 'message) + + (defmacro gnus-eval-in-buffer-window (buffer &rest forms) + "Pop to BUFFER, evaluate FORMS, and then return to the original window." + (let ((tempvar (make-symbol "GnusStartBufferWindow")) + (w (make-symbol "w")) + (buf (make-symbol "buf"))) + `(let* ((,tempvar (selected-window)) + (,buf ,buffer) + (,w (get-buffer-window ,buf 'visible))) + (unwind-protect + (progn + (if ,w + (select-window ,w) + (pop-to-buffer ,buf)) + ,@forms) + (select-window ,tempvar))))) + + (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) + (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) + (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) + + (defmacro gnus-intern-safe (string hashtable) + "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." + `(let ((symbol (intern ,string ,hashtable))) + (or (boundp symbol) + (set symbol nil)) + symbol)) + + ;; modified by MORIOKA Tomohiko + ;; function `substring' might cut on a middle of multi-octet + ;; character. + (defun gnus-truncate-string (str width) + (substring str 0 width)) + + ;; Added by Geoffrey T. Dairiki . A safe way + ;; to limit the length of a string. This function is necessary since + ;; `(substr "abc" 0 30)' pukes with "Args out of range". + (defsubst gnus-limit-string (str width) + (if (> (length str) width) + (substring str 0 width) + str)) + + (defsubst gnus-functionp (form) + "Return non-nil if FORM is funcallable." + (or (and (symbolp form) (fboundp form)) + (and (listp form) (eq (car form) 'lambda)))) + + (defsubst gnus-goto-char (point) + (and point (goto-char point))) + + (defmacro gnus-buffer-exists-p (buffer) + `(let ((buffer ,buffer)) + (and buffer + (funcall (if (stringp buffer) 'get-buffer 'buffer-name) + buffer)))) + + (defmacro gnus-kill-buffer (buffer) + `(let ((buf ,buffer)) + (if (gnus-buffer-exists-p buf) + (kill-buffer buf)))) + + (defsubst gnus-point-at-bol () + "Return point at the beginning of the line." + (let ((p (point))) + (beginning-of-line) + (prog1 + (point) + (goto-char p)))) + + (defsubst gnus-point-at-eol () + "Return point at the end of the line." + (let ((p (point))) + (end-of-line) + (prog1 + (point) + (goto-char p)))) + + (defun gnus-delete-first (elt list) + "Delete by side effect the first occurrence of ELT as a member of LIST." + (if (equal (car list) elt) + (cdr list) + (let ((total list)) + (while (and (cdr list) + (not (equal (cadr list) elt))) + (setq list (cdr list))) + (when (cdr list) + (setcdr list (cddr list))) + total))) + + ;; Delete the current line (and the next N lines). + (defmacro gnus-delete-line (&optional n) + `(delete-region (progn (beginning-of-line) (point)) + (progn (forward-line ,(or n 1)) (point)))) + + (defun gnus-byte-code (func) + "Return a form that can be `eval'ed based on FUNC." + (let ((fval (symbol-function func))) + (if (byte-code-function-p fval) + (let ((flist (append fval nil))) + (setcar flist 'byte-code) + flist) + (cons 'progn (cddr fval))))) + + (defun gnus-extract-address-components (from) + (let (name address) + ;; First find the address - the thing with the @ in it. This may + ;; not be accurate in mail addresses, but does the trick most of + ;; the time in news messages. + (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) + (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)))) + + (defun gnus-fetch-field (field) + "Return the value of the header FIELD of current article." + (save-excursion + (save-restriction + (let ((case-fold-search t) + (inhibit-point-motion-hooks t)) + (nnheader-narrow-to-headers) + (message-fetch-field field))))) + + (defun gnus-goto-colon () + (beginning-of-line) + (search-forward ":" (gnus-point-at-eol) t)) + + (defun gnus-remove-text-with-property (prop) + "Delete all text in the current buffer with text property PROP." + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (while (get-text-property (point) prop) + (delete-char 1)) + (goto-char (next-single-property-change (point) prop nil (point-max)))))) + + (defun gnus-newsgroup-directory-form (newsgroup) + "Make hierarchical directory name from NEWSGROUP name." + (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) + (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)) + ;; Replace all occurrences of `.' with `/'. + (while (< idx len) + (if (= (aref newsgroup idx) ?.) + (aset newsgroup idx ?/)) + (setq idx (1+ idx))) + newsgroup)) + + (defun gnus-newsgroup-savable-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-string> (s1 s2) + (not (or (string< s1 s2) + (string= s1 s2)))) + + ;;; Time functions. + + (defun gnus-days-between (date1 date2) + ;; Return the number of days between date1 and date2. + (- (gnus-day-number date1) (gnus-day-number date2))) + + (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-time-less (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + + (defun gnus-file-newer-than (file date) + (let ((fdate (nth 5 (file-attributes file)))) + (or (> (car fdate) (car date)) + (and (= (car fdate) (car date)) + (> (nth 1 fdate) (nth 1 date)))))) + + ;;; Keymap macros. + + (defmacro gnus-local-set-keys (&rest plist) + "Set the keys in PLIST in the current keymap." + `(gnus-define-keys-1 (current-local-map) ',plist)) + + (defmacro gnus-define-keys (keymap &rest plist) + "Define all keys in PLIST in KEYMAP." + `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) + + (put 'gnus-define-keys 'lisp-indent-function 1) + (put 'gnus-define-keys 'lisp-indent-hook 1) + (put 'gnus-define-keymap 'lisp-indent-function 1) + (put 'gnus-define-keymap 'lisp-indent-hook 1) + + (defmacro gnus-define-keymap (keymap &rest plist) + "Define all keys in PLIST in KEYMAP." + `(gnus-define-keys-1 ,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))) + ((keymapp 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-completing-read (default prompt &rest args) + ;; Like `completing-read', except that DEFAULT is the default argument. + (let* ((prompt (if default + (concat prompt " (default " default ") ") + (concat prompt " "))) + (answer (apply 'completing-read prompt args))) + (if (or (null answer) (zerop (length answer))) + default + answer))) + + ;; Two silly functions to ensure that all `y-or-n-p' questions clear + ;; the echo area. + (defun gnus-y-or-n-p (prompt) + (prog1 + (y-or-n-p prompt) + (message ""))) + + (defun gnus-yes-or-no-p (prompt) + (prog1 + (yes-or-no-p prompt) + (message ""))) + + ;; I suspect there's a better way, but I haven't taken the time to do + ;; it yet. -erik selberg@cs.washington.edu + (defun gnus-dd-mmm (messy-date) + "Return a string like DD-MMM from a big messy string" + (let ((datevec (condition-case () (timezone-parse-date messy-date) + (error nil)))) + (if (not datevec) + "??-???" + (format "%2s-%s" + (condition-case () + ;; Make sure leading zeroes are stripped. + (number-to-string (string-to-number (aref datevec 2))) + (error "??")) + (capitalize + (or (car + (nth (1- (string-to-number (aref datevec 1))) + timezone-months-assoc)) + "???")))))) + + (defun gnus-mode-string-quote (string) + "Quote all \"%\" in STRING." + (save-excursion + (gnus-set-work-buffer) + (insert string) + (goto-char (point-min)) + (while (search-forward "%" nil t) + (insert "%")) + (buffer-string))) + + ;; Make a hash table (default and minimum size is 255). + ;; Optional argument HASHSIZE specifies the table size. + (defun gnus-make-hashtable (&optional hashsize) + (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0)) + + ;; Make a number that is suitable for hashing; bigger than MIN and one + ;; less than 2^x. + (defun gnus-create-hash-size (min) + (let ((i 1)) + (while (< i min) + (setq i (* 2 i))) + (1- i))) + + (defvar gnus-verbose 7 + "*Integer that says how verbose Gnus should be. + The higher the number, the more messages Gnus will flash to say what + it's doing. At zero, Gnus will be totally mute; at five, Gnus will + display most important messages; and at ten, Gnus will keep on + jabbering all the time.") + + ;; 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. + (defun gnus-message (level &rest args) + (if (<= level gnus-verbose) + (apply 'message args) + ;; We have to do this format thingy here even if the result isn't + ;; shown - the return value has to be the same as the return value + ;; from `message'. + (apply 'format args))) + + (defun gnus-error (level &rest args) + "Beep an error if LEVEL is equal to or less than `gnus-verbose'." + (when (<= (floor level) gnus-verbose) + (apply 'message args) + (ding) + (let (duration) + (when (and (floatp level) + (not (zerop (setq duration (* 10 (- level (floor level))))))) + (sit-for duration)))) + nil) + + (defun gnus-parent-id (references) + "Return the last Message-ID in REFERENCES." + (when (and references + (string-match "\\(<[^\n<>]+>\\)[ \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-buffer-live-p (buffer) + "Say whether BUFFER is alive or not." + (and buffer + (get-buffer buffer) + (buffer-name (get-buffer buffer)))) + + (defun gnus-horizontal-recenter () + "Recenter the current buffer horizontally." + (if (< (current-column) (/ (window-width) 2)) + (set-window-hscroll (get-buffer-window (current-buffer) t) 0) + (let* ((orig (point)) + (end (window-end (get-buffer-window (current-buffer) t))) + (max 0)) + ;; Find the longest line currently displayed in the window. + (goto-char (window-start)) + (while (and (not (eobp)) + (< (point) 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) t) + (min (- (current-column) (/ (window-width) 3)) + (+ 2 (- max (window-width))))) + (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) + max))) + + (defun gnus-read-event-char () + "Get the next event." + (let ((event (read-event))) + (cons (and (numberp event) event) event))) + + (defun gnus-sortable-date (date) + "Make sortable string by string-lessp from DATE. + Timezone package is used." + (condition-case () + (progn + (setq date (inline (timezone-fix-time + date nil + (aref (inline (timezone-parse-date date)) 4)))) + (inline + (timezone-make-sortable-date + (aref date 0) (aref date 1) (aref date 2) + (inline + (timezone-make-time-string + (aref date 3) (aref date 4) (aref date 5)))))) + (error ""))) + + (defun gnus-copy-file (file &optional to) + "Copy FILE to TO." + (interactive + (list (read-file-name "Copy file: " default-directory) + (read-file-name "Copy file to: " default-directory))) + (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)) + + (defun gnus-kill-all-overlays () + "Delete all overlays in the current buffer." + (when (fboundp 'overlay-lists) + (let* ((overlayss (overlay-lists)) + (buffer-read-only nil) + (overlays (nconc (car overlayss) (cdr overlayss)))) + (while overlays + (delete-overlay (pop overlays)))))) + + (defvar gnus-work-buffer " *gnus work*") + + (defun gnus-set-work-buffer () + "Put point in the empty Gnus work buffer." + (if (get-buffer gnus-work-buffer) + (progn + (set-buffer gnus-work-buffer) + (erase-buffer)) + (set-buffer (get-buffer-create gnus-work-buffer)) + (kill-all-local-variables) + (buffer-disable-undo (current-buffer)))) + + (defmacro gnus-group-real-name (group) + "Find the real name of a foreign newsgroup." + `(let ((gname ,group)) + (if (string-match ":[^:]+$" gname) + (substring gname (1+ (match-beginning 0))) + gname))) + + (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))) + + (provide 'gnus-util) + + ;;; gnus-util.el ends here *** pub/rgnus/lisp/gnus-uu.el Thu Jul 18 01:33:52 1996 --- rgnus/lisp/gnus-uu.el Sun Jul 28 20:31:12 1996 *************** *** 26,34 **** ;;; Code: ! (require 'gnus) ! (require 'gnus-msg) ! (eval-when-compile (require 'cl)) ;; Default viewing action rules --- 26,34 ---- ;;; Code: ! (require 'gnus-load) ! (require 'gnus-art) ! (require 'message) ;; Default viewing action rules *************** *** 1581,1587 **** (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) (if (not (file-directory-p gnus-uu-work-dir)) ! (gnus-make-directory gnus-uu-work-dir)) (set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir) --- 1581,1587 ---- (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) (if (not (file-directory-p gnus-uu-work-dir)) ! (make-directory gnus-uu-work-dir t)) (set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir) *** pub/rgnus/lisp/gnus-vis.el Wed Jul 24 06:36:19 1996 --- rgnus/lisp/gnus-vis.el Mon Jul 29 11:35:30 1996 *************** *** 26,37 **** ;;; Code: ! (require 'gnus) (require 'gnus-ems) (require 'easymenu) (require 'custom) (require 'browse-url) (require 'gnus-score) (eval-when-compile (require 'cl)) (defvar gnus-group-menu-hook nil --- 26,40 ---- ;;; Code: ! (require 'gnus-load) (require 'gnus-ems) (require 'easymenu) (require 'custom) (require 'browse-url) (require 'gnus-score) + (require 'gnus-art) + (require 'gnus-group) + (require 'gnus-range) (eval-when-compile (require 'cl)) (defvar gnus-group-menu-hook nil *************** *** 625,630 **** --- 628,634 ---- ["Lapsed" gnus-article-date-lapsed t]) ("Filter" ["Overstrike" gnus-article-treat-overstrike t] + ["Emphasis" gnus-article-emphasize 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] *************** *** 1345,1351 **** (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after ! `gnus-signature-separator' using `gnus-signature-face'." (interactive) (save-excursion (set-buffer gnus-article-buffer) --- 1349,1355 ---- (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after ! `article-signature-separator' using `gnus-signature-face'." (interactive) (save-excursion (set-buffer gnus-article-buffer) *************** *** 1353,1363 **** (inhibit-point-motion-hooks t)) (save-restriction (when (and gnus-signature-face ! (gnus-narrow-to-signature)) (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) 'face gnus-signature-face) (widen) ! (re-search-backward gnus-signature-separator nil t) (let ((start (match-beginning 0)) (end (set-marker (make-marker) (1+ (match-end 0))))) (gnus-article-add-button start (1- end) 'gnus-signature-toggle --- 1357,1367 ---- (inhibit-point-motion-hooks t)) (save-restriction (when (and gnus-signature-face ! (article-narrow-to-signature)) (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) 'face gnus-signature-face) (widen) ! (re-search-backward article-signature-separator nil t) (let ((start (match-beginning 0)) (end (set-marker (make-marker) (1+ (match-end 0))))) (gnus-article-add-button start (1- end) 'gnus-signature-toggle *************** *** 1461,1468 **** (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) (if (get-text-property end 'invisible) ! (gnus-unhide-text end (point-max)) ! (gnus-hide-text end (point-max) gnus-hidden-properties))))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. --- 1465,1472 ---- (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) (if (get-text-property end 'invisible) ! (article-unhide-text end (point-max)) ! (article-hide-text end (point-max) article-hidden-properties))))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. *** pub/rgnus/lisp/gnus-vm.el Tue May 21 17:06:15 1996 --- rgnus/lisp/gnus-vm.el Sun Jul 28 13:48:36 1996 *************** *** 34,39 **** --- 34,40 ---- (require 'message) (require 'gnus) (require 'gnus-msg) + (require 'gnus-load) (eval-when-compile (autoload 'vm-mode "vm") *************** *** 95,101 **** (folder folder) (t (gnus-read-save-file-name "Save article in VM folder:" default-name)))) ! (gnus-make-directory (file-name-directory folder)) (set-buffer gnus-original-article-buffer) (save-excursion (save-restriction --- 96,102 ---- (folder folder) (t (gnus-read-save-file-name "Save article in VM folder:" default-name)))) ! (make-directory (file-name-directory folder) t) (set-buffer gnus-original-article-buffer) (save-excursion (save-restriction *** pub/rgnus/lisp/gnus-win.el Tue Jul 30 22:59:23 1996 --- rgnus/lisp/gnus-win.el Sun Jul 28 13:48:36 1996 *************** *** 0 **** --- 1,503 ---- + ;;; gnus-win.el --- window configuration functions for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-load) + + (defvar gnus-use-full-window t + "*If non-nil, use the entire Emacs screen.") + + (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)) + (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)))) + (message + (vertical 1.0 + (message 1.0 point))) + (pick + (vertical 1.0 + (article 1.0 point))) + (info + (vertical 1.0 + (info 1.0 point))) + (summary-faq + (vertical 1.0 + (summary 0.25) + (faq 1.0 point))) + (edit-group + (vertical 1.0 + (group 0.5) + (edit-group 1.0 point))) + (edit-server + (vertical 1.0 + (server 0.5) + (edit-server 1.0 point))) + (edit-score + (vertical 1.0 + (summary 0.25) + (edit-score 1.0 point))) + (post + (vertical 1.0 + (post 1.0 point))) + (reply + (vertical 1.0 + (article-copy 0.5) + (message 1.0 point))) + (forward + (vertical 1.0 + (message 1.0 point))) + (reply-yank + (vertical 1.0 + (message 1.0 point))) + (mail-bounce + (vertical 1.0 + (article 0.5) + (message 1.0 point))) + (draft + (vertical 1.0 + (draft 1.0 point))) + (pipe + (vertical 1.0 + (summary 0.25 point) + (if gnus-carpal '(summary-carpal 4)) + ("*Shell Command Output*" 1.0))) + (bug + (vertical 1.0 + ("*Gnus Help Bug*" 0.5) + ("*Gnus Bug*" 1.0 point))) + (compose-bounce + (vertical 1.0 + (article 0.5) + (message 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 + be present to denote which buffer point is to go to after making this + buffer configuration.") + + (defvar gnus-window-to-buffer + '((group . gnus-group-buffer) + (summary . gnus-summary-buffer) + (article . gnus-article-buffer) + (server . gnus-server-buffer) + (browse . "*Gnus Browse Server*") + (edit-group . gnus-group-edit-buffer) + (edit-server . gnus-server-edit-buffer) + (group-carpal . gnus-carpal-group-buffer) + (summary-carpal . gnus-carpal-summary-buffer) + (server-carpal . gnus-carpal-server-buffer) + (browse-carpal . gnus-carpal-browse-buffer) + (edit-score . gnus-score-edit-buffer) + (message . gnus-message-buffer) + (mail . gnus-message-buffer) + (post-news . gnus-message-buffer) + (faq . gnus-faq-buffer) + (picons . "*Picons*") + (tree . gnus-tree-buffer) + (info . gnus-info-buffer) + (article-copy . gnus-article-copy) + (draft . gnus-draft-buffer)) + "Mapping from short symbols to buffer names or buffer variables.") + + (defvar gnus-created-frames nil) + + (defun gnus-kill-gnus-frames () + "Kill all frames Gnus has created." + (while gnus-created-frames + (when (frame-live-p (car gnus-created-frames)) + ;; We slap a condition-case around this `delete-frame' to ensure + ;; against errors if we try do delete the single frame that's left. + (condition-case () + (delete-frame (car gnus-created-frames)) + (error nil))) + (pop gnus-created-frames))) + + (defun gnus-windows-old-to-new (setting) + ;; First we take care of the really, really old Gnus 3 actions. + (when (symbolp setting) + (setq setting + ;; Take care of ooold GNUS 3.x values. + (cond ((eq setting 'SelectArticle) 'article) + ((memq setting '(SelectSubject ExpandSubject)) 'summary) + ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group) + (t setting)))) + (if (or (listp setting) + (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)) + (elem (cadr (assq setting gnus-window-configuration))) + (total (apply '+ elem)) + (types '(group summary article)) + (pbuf (if (eq setting 'newsgroups) 'group 'summary)) + (i 0) + perc + out) + (while (< i 3) + (or (not (numberp (nth i elem))) + (zerop (nth i elem)) + (progn + (setq perc (if (= i 2) + 1.0 + (/ (float (nth 0 elem)) total))) + (setq out (cons (if (eq pbuf (nth i types)) + (list (nth i types) perc 'point) + (list (nth i types) perc)) + out)))) + (setq i (1+ i))) + `(vertical 1.0 ,@(nreverse out))))) + + ;;;###autoload + (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 + (setq window (get-buffer-window (current-buffer)))) + (select-window window) + ;; This might be an old-stylee buffer config. + (when (vectorp split) + (setq split (append split nil))) + (when (or (consp (car split)) + (vectorp (car split))) + (push 1.0 split) + (push 'vertical split)) + ;; The SPLIT might be something that is to be evaled to + ;; return a new SPLIT. + (while (and (not (assq (car split) gnus-window-to-buffer)) + (gnus-functionp (car split))) + (setq split (eval split))) + (let* ((type (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) + (unless buffer + (error "Illegal buffer type: %s" type)) + (unless (setq buf (get-buffer (if (symbolp buffer) + (symbol-value buffer) buffer))) + (setq buf (get-buffer-create (if (symbolp buffer) + (symbol-value buffer) buffer)))) + (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)))) + (push frame gnus-created-frames)) + ;; 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) + ;; First we have to compute the sizes of all new windows. + (while subs + (setq sub (append (pop subs) nil)) + (while (and (not (assq (car sub) gnus-window-to-buffer)) + (gnus-functionp (car sub))) + (setq sub (eval sub))) + (when sub + (push sub comp-subs) + (setq size (cadar comp-subs)) + (cond ((equal size 1.0) + (setq rest (car comp-subs)) + (setq s 0)) + ((floatp size) + (setq s (floor (* size len)))) + ((integerp size) + (setq s size)) + (t + (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. + (if rest + (setcar (cdr rest) (- len total)) + (error "No 1.0 specs in %s" split)) + ;; The we do the actual splitting in a nice recursive + ;; fashion. + (setq comp-subs (nreverse comp-subs)) + (while comp-subs + (if (null (cdr comp-subs)) + (setq new-win window) + (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) + (setq comp-subs (cdr comp-subs)))) + ;; Return the proper window, if any. + (when result + (select-window result)))))) + + (defvar gnus-frame-split-p nil) + + (defun gnus-configure-windows (setting &optional force) + (setq setting (gnus-windows-old-to-new setting)) + (let ((split (if (symbolp setting) + (cadr (assq setting gnus-buffer-configuration)) + setting)) + all-visible) + + (setq gnus-frame-split-p nil) + + (unless split + (error "No such setting: %s" setting)) + + (if (and (setq all-visible (gnus-all-windows-visible-p split)) + (not force)) + ;; 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. + (let ((frame (selected-frame))) + (unwind-protect + (if gnus-use-full-window + ;; We want to remove all other windows. + (if (not gnus-frame-split-p) + ;; This is not a `frame' split, so we ignore the + ;; other frames. + (delete-other-windows) + ;; This is a `frame' split, so we delete all windows + ;; on all frames. + (mapcar + (lambda (frame) + (unless (eq (cdr (assq 'minibuffer + (frame-parameters frame))) + 'only) + (select-frame frame) + (delete-other-windows))) + (frame-list))) + ;; Just remove some windows. + (gnus-remove-some-windows) + (switch-to-buffer nntp-server-buffer)) + (select-frame frame))) + + (switch-to-buffer nntp-server-buffer) + (gnus-configure-frame split (get-buffer-window (current-buffer)))))) + + (defun gnus-all-windows-visible-p (split) + "Say whether all buffers in SPLIT are currently visible. + In particular, the value returned will be the window that + should have point." + (let ((stack (list split)) + (all-visible t) + type buffer win buf) + (while (and (setq split (pop stack)) + all-visible) + ;; Be backwards compatible. + (when (vectorp split) + (setq split (append split nil))) + (when (or (consp (car split)) + (vectorp (car split))) + (push 1.0 split) + (push 'vertical split)) + ;; The SPLIT might be something that is to be evaled to + ;; return a new SPLIT. + (while (and (not (assq (car split) gnus-window-to-buffer)) + (gnus-functionp (car split))) + (setq split (eval split))) + + (setq type (elt split 0)) + (cond + ;; Nothing here. + ((null split) t) + ;; A buffer. + ((not (memq type '(horizontal vertical frame))) + (setq buffer (cond ((stringp type) type) + (t (cdr (assq type gnus-window-to-buffer))))) + (unless buffer + (error "Illegal buffer type: %s" type)) + (when (setq buf (get-buffer (if (symbolp buffer) + (symbol-value buffer) + buffer))) + (setq win (get-buffer-window buf t))) + (if win + (when (memq 'point split) + (setq all-visible win)) + (setq all-visible nil))) + (t + (when (eq type 'frame) + (setq gnus-frame-split-p t)) + (setq stack (append (cddr split) stack))))) + (unless (eq all-visible t) + all-visible))) + + (defun gnus-window-top-edge (&optional window) + (nth 1 (window-edges window))) + + (defun gnus-remove-some-windows () + (let ((buffers gnus-window-to-buffer) + buf bufs lowest-buf lowest) + (save-excursion + ;; Remove windows on all known Gnus buffers. + (while buffers + (setq buf (cdar buffers)) + (if (symbolp buf) + (setq buf (and (boundp buf) (symbol-value buf)))) + (and buf + (get-buffer-window buf) + (progn + (setq bufs (cons buf bufs)) + (pop-to-buffer buf) + (if (or (not lowest) + (< (gnus-window-top-edge) lowest)) + (progn + (setq lowest (gnus-window-top-edge)) + (setq lowest-buf buf))))) + (setq buffers (cdr buffers))) + ;; Remove windows on *all* summary buffers. + (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) + (if (or (not lowest) + (< (gnus-window-top-edge) lowest)) + (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))) + (while bufs + (and (not (eq (car bufs) lowest-buf)) + (delete-windows-on (car bufs))) + (setq bufs (cdr bufs)))))) + + (provide 'gnus-win) + + ;;; gnus-win.el ends here *** pub/rgnus/lisp/gnus-xmas.el Fri Jul 19 01:27:41 1996 --- rgnus/lisp/gnus-xmas.el Tue Jul 30 22:26:18 1996 *************** *** 25,32 **** ;;; Code: (require 'text-props) - (eval-when-compile (require 'cl)) (defvar menu-bar-mode (featurep 'menubar)) (require 'messagexmas) --- 25,32 ---- ;;; Code: + (require 'gnus-load) (require 'text-props) (defvar menu-bar-mode (featurep 'menubar)) (require 'messagexmas) *************** *** 50,63 **** (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") ! (defvar gnus-xmas-logo-color-style 'september "Color styles used for the Gnus logo.") (defvar gnus-xmas-logo-colors (cdr (assq gnus-xmas-logo-color-style gnus-xmas-logo-color-alist)) "Colors used for the Gnus logo.") ! (defvar gnus-article-x-face-command (if (featurep 'xface) 'gnus-xmas-article-display-xface "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -") --- 50,63 ---- (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") ! (defvar gnus-xmas-logo-color-style 'flame "Color styles used for the Gnus logo.") (defvar gnus-xmas-logo-colors (cdr (assq gnus-xmas-logo-color-style gnus-xmas-logo-color-alist)) "Colors used for the Gnus logo.") ! (defvar article-x-face-command (if (featurep 'xface) 'gnus-xmas-article-display-xface "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -") *************** *** 747,754 **** (setq beg (point)) (forward-char) (if hide ! (gnus-hide-text beg (point) gnus-hidden-properties) ! (gnus-unhide-text beg (point))) (setq beg (point))) (save-window-excursion (select-window (get-buffer-window (current-buffer))) --- 747,754 ---- (setq beg (point)) (forward-char) (if hide ! (article-hide-text beg (point) gnus-hidden-properties) ! (article-unhide-text beg (point))) (setq beg (point))) (save-window-excursion (select-window (get-buffer-window (current-buffer))) *** pub/rgnus/lisp/gnus.el Tue Jul 30 19:55:02 1996 --- rgnus/lisp/gnus.el Tue Jul 30 21:52:10 1996 *************** *** 28,2154 **** (eval '(run-hooks 'gnus-load-hook)) ! (require 'mail-utils) ! (require 'timezone) ! (require 'nnheader) ! (require 'nnmail) ! (require 'nnoo) ! ! (eval-when-compile (require 'cl)) ! ! (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/") ! "*Directory variable from which all other Gnus file variables are derived.") ! ! ;; Site dependent variables. These variables should be defined in ! ;; paths.el. ! ! (defvar gnus-default-nntp-server nil ! "Specify a default NNTP server. ! This variable should be defined in paths.el, and should never be set ! by the user. ! 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.") ! ! (defvar gnus-local-domain nil ! "Local domain name without a host name. ! The DOMAINNAME environment variable is used instead if it is defined. ! If the `system-name' function returns the full Internet name, there is ! no need to set this variable.") ! ! (defvar gnus-local-organization nil ! "String with a description of what organization (if any) the user belongs to. ! The ORGANIZATION environment variable is used instead if it is defined. ! If this variable contains a function, this function will be called ! with the current newsgroup name as the argument. The function should ! return a string. ! ! In any case, if the string (either in the variable, in the environment ! variable, or returned by the function) is a file name, the contents of ! this file will be used as the organization.") ! ! ;; Customization variables ! ! ;; Don't touch this variable. ! (defvar gnus-nntp-service "nntp" ! "*NNTP service name (\"nntp\" or 119). ! This is an obsolete variable, which is scarcely used. If you use an ! nntp server for your newsgroup and want to change the port number ! used to 899, you would say something along these lines: ! ! (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") ! ! (defvar gnus-nntpserver-file "/etc/nntpserver" ! "*A file with only the name of the nntp server in it.") ! ! ;; This function is used to check both the environment variable ! ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find ! ;; an nntp server name default. ! (defun gnus-getenv-nntpserver () ! (or (getenv "NNTPSERVER") ! (and (file-readable-p gnus-nntpserver-file) ! (save-excursion ! (set-buffer (get-buffer-create " *gnus nntp*")) ! (buffer-disable-undo (current-buffer)) ! (insert-file-contents gnus-nntpserver-file) ! (let ((name (buffer-string))) ! (prog1 ! (if (string-match "^[ \t\n]*$" name) ! nil ! name) ! (kill-buffer (current-buffer)))))))) ! ! (defvar gnus-select-method ! (nconc ! (list 'nntp (or (condition-case () ! (gnus-getenv-nntpserver) ! (error nil)) ! (if (and gnus-default-nntp-server ! (not (string= gnus-default-nntp-server ""))) ! gnus-default-nntp-server) ! (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: ! ! (setq gnus-select-method '(nntp \"flab.flab.edu\")) ! ! If you want to use your local spool, say: ! ! (setq gnus-select-method (list 'nnspool (system-name))) ! ! If you use this variable, you must set `gnus-nntp-server' to nil. ! ! 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 ,(nnheader-concat message-directory "archive")) ! (nnfolder-active-file ! ,(nnheader-concat message-directory "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. ! ! It's probably not a very effective to change this variable once you've ! run Gnus once. After doing that, you must edit this server from the ! server buffer.") ! ! (defvar gnus-message-archive-group nil ! "*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. ! ! If you want to save your mail in one group and the news articles you ! write in another group, you could say something like: ! ! \(setq gnus-message-archive-group ! '((if (message-news-p) ! \"misc-news\" ! \"misc-mail\"))) ! ! Normally the group names returned by this variable should be ! unprefixed -- which implictly means \"store on the archive server\". ! However, you may wish to store the message on some other server. In ! that case, just return a fully prefixed name of the group -- ! \"nnml+private:mail.misc\", for instance.") ! ! (defvar gnus-refer-article-method nil ! "*Preferred method for fetching an article by Message-ID. ! If you are reading news from the local spool (with nnspool), fetching ! articles by Message-ID is painfully slow. By setting this method to an ! nntp method, you might get acceptable results. ! ! The value of this variable must be a valid select method as discussed ! in the documentation of `gnus-select-method'.") ! ! (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: ! ! (setq gnus-secondary-select-methods '((nnml \"\")))") ! ! (defvar gnus-secondary-servers nil ! "*List of NNTP servers that the user can choose between interactively. ! To make Gnus query you for a server, you have to give `gnus' a ! non-numeric prefix - `C-u M-x gnus', in short.") ! ! (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" ! "*Your `.newsrc' file. ! `.newsrc-SERVER' will be used instead if that exists.") ! ! (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/" ! "/ftp@sunsite.auc.dk:/pub/usenet/" ! "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" ! "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" ! "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" ! "/ftp@rtfm.mit.edu:/pub/usenet/" ! "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" ! "/ftp@ftp.sunet.se:/pub/usenet/" ! "/ftp@nctuccca.edu.tw:/USENET/FAQ/" ! "/ftp@hwarang.postech.ac.kr:/pub/usenet/" ! "/ftp@ftp.hk.super.net:/mirror/faqs/") ! "*Directory where the group FAQs are stored. ! This will most commonly be on a remote machine, and the file will be ! fetched by ange-ftp. ! ! This variable can also be a list of directories. In that case, the ! first element in the list will be used by default. The others can ! be used when being prompted for a site. ! ! Note that Gnus uses an aol machine as the default directory. If this ! feels fundamentally unclean, just think of it as a way to finally get ! something of value back from them. ! ! 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 ! Europe: ftp.uni-paderborn.de /pub/FAQ ! src.doc.ic.ac.uk /usenet/news-FAQS ! ftp.sunet.se /pub/usenet ! sunsite.auc.dk /pub/usenet ! Asia: nctuccca.edu.tw /USENET/FAQ ! hwarang.postech.ac.kr /pub/usenet ! 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 ! "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" ! "*The address of the most recent (ding) articles.") ! ! (defvar gnus-default-subscribed-newsgroups nil ! "*This variable lists what newsgroups should be subscribed the first time Gnus is used. ! It should be a list of strings. ! If it is `t', Gnus will not do anything special the first time it is ! started; it'll just use the normal newsgroups subscription methods.") ! ! (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. ! If nil, each group will get its own article buffer.") ! ! (defvar gnus-use-dribble-file t ! "*Non-nil means that Gnus will use a dribble file to store user updates. ! If Emacs should crash without saving the .newsrc files, complete ! information can be restored from the dribble file.") ! ! (defvar gnus-dribble-directory nil ! "*The directory where dribble files will be saved. ! If this variable is nil, the directory where the .newsrc files are ! saved will be used.") ! ! (defvar gnus-asynchronous nil ! "*If non-nil, Gnus will supply backends with data needed for async article fetching.") ! ! (defvar gnus-kill-summary-on-exit t ! "*If non-nil, kill the summary buffer when you exit from it. ! If nil, the summary will become a \"*Dead Summary*\" buffer, and ! it will be killed sometime later.") ! ! (defvar gnus-large-newsgroup 200 ! "*The number of articles which indicates a large newsgroup. ! If the number of articles in a newsgroup is greater than this value, ! confirmation is required for selecting the newsgroup.") ! ! ;; Suggested by Andrew Eskilsson . ! (defvar gnus-no-groups-message "No news is horrible news" ! "*Message displayed by Gnus when no groups are available.") ! ! (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) ! "*Non-nil means that the default name of a file to save articles in is the group name. ! If it's nil, the directory form of the group name is used instead. ! ! If this variable is a list, and the list contains the element ! `not-score', long file names will not be used for score files; if it ! contains the element `not-save', long file names will not be used for ! saving; and if it contains the element `not-kill', long file names ! will not be used for kill files. ! ! Note that the default for this variable varies according to what system ! type you're using. On `usg-unix-v' and `xenix' this variable defaults ! to nil while on all other systems it defaults to t.") ! ! (defvar gnus-article-save-directory gnus-directory ! "*Name of the directory articles will be saved in (default \"~/News\").") ! ! (defvar gnus-kill-files-directory gnus-directory ! "*Name of the directory where kill files will be stored (default \"~/News\").") ! ! (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail ! "*A function to save articles in your favorite format. ! The function must be interactively callable (in other words, it must ! be an Emacs command). ! ! Gnus provides the following functions: ! ! * gnus-summary-save-in-rmail (Rmail format) ! * gnus-summary-save-in-mail (Unix mail format) ! * gnus-summary-save-in-folder (MH folder) ! * gnus-summary-save-in-file (article format). ! * gnus-summary-save-in-vm (use VM's folder format).") ! ! (defvar gnus-prompt-before-saving 'always ! "*This variable says how much prompting is to be done when saving articles. ! If it is nil, no prompting will be done, and the articles will be ! saved to the default files. If this variable is `always', each and ! every article that is saved will be preceded by a prompt, even when ! saving large batches of articles. If this variable is neither nil not ! `always', there the user will be prompted once for a file name for ! each invocation of the saving commands.") ! ! (defvar gnus-rmail-save-name (function gnus-plain-save-name) ! "*A function generating a file name to save articles in Rmail format. ! The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") ! ! (defvar gnus-mail-save-name (function gnus-plain-save-name) ! "*A function generating a file name to save articles in Unix mail format. ! The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") ! ! (defvar gnus-folder-save-name (function gnus-folder-save-name) ! "*A function generating a file name to save articles in MH folder. ! The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.") ! ! (defvar gnus-file-save-name (function gnus-numeric-save-name) ! "*A function generating a file name to save articles in article format. ! 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 ! the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", ! you could set this variable to something like: ! ! '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") ! (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) ! ! This variable is an alist where the where the key is the match and the ! 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. ! ! If this form or function returns a string, this string will be used as ! a possible file name; and if it returns a non-nil list, that list will ! be used as possible file names.") ! ! (defvar gnus-move-split-methods nil ! "*Variable used to suggest where articles are to be moved to. ! It uses the same syntax as the `gnus-split-methods' variable.") ! ! (defvar gnus-save-score nil ! "*If non-nil, save group scoring info.") ! ! (defvar gnus-use-adaptive-scoring nil ! "*If non-nil, use some adaptive scoring scheme.") ! ! (defvar gnus-use-cache 'passive ! "*If nil, Gnus will ignore the article cache. ! If `passive', it will allow entering (and reading) articles ! 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-use-grouplens nil ! "*If non-nil, use GroupLens ratings.") ! ! (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 ! read. If it is neither nil nor a number, Gnus will keep all read ! articles. This is not a good idea.") ! ! (defvar gnus-use-nocem nil ! "*If non-nil, Gnus will read NoCeM cancel messages.") ! ! (defvar gnus-use-demon nil ! "If non-nil, Gnus might use some demons.") ! ! (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 ! "*Non-nil means that Gnus will try to build threads by grabbing old headers. ! If an unread article in the group refers to an older, already read (or ! 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.") ! ! ;see gnus-cus.el ! ;(defvar gnus-visual t ! ; "*If non-nil, will do various highlighting. ! ;If nil, no mouse highlights (or any other highlights) will be ! ;performed. This might speed up Gnus some when generating large group ! ;and summary buffers.") ! ! (defvar gnus-novice-user t ! "*Non-nil means that you are a usenet novice. ! If non-nil, verbose messages may be displayed and confirmations may be ! required.") ! ! (defvar gnus-expert-user nil ! "*Non-nil means that you will never be asked for confirmation about anything. ! And that means *anything*.") ! ! (defvar gnus-verbose 7 ! "*Integer that says how verbose Gnus should be. ! The higher the number, the more messages Gnus will flash to say what ! it's doing. At zero, Gnus will be totally mute; at five, Gnus will ! display most important messages; and at ten, Gnus will keep on ! jabbering all the time.") ! ! (defvar gnus-keep-same-level nil ! "*Non-nil means that the next newsgroup after the current will be on the same level. ! 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 ! than the current level. ! If this variable is `best', Gnus will make the next newsgroup the one ! with the best level.") ! ! (defvar gnus-summary-make-false-root 'adopt ! "*nil means that Gnus won't gather loose threads. ! 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. ! ! If this variable is non-nil, it should be one of `none', `adopt', ! `dummy' or `empty'. ! ! If this variable is `none', Gnus will not make a false root, but just ! present the sub-threads after another. ! If this variable is `dummy', Gnus will create a dummy root that will ! have all the sub-threads as children. ! 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)$" ! "*A regexp to match subjects to be excluded from loose thread gathering. ! As loose thread gathering is done on subjects only, that means that ! there can be many false gatherings performed. By rooting out certain ! common subjects, gathering might become saner.") ! ! (defvar gnus-summary-gather-subject-limit nil ! "*Maximum length of subject comparisons when gathering loose threads. ! Use nil to compare full subjects. Setting this variable to a low ! number will help gather threads that have been corrupted by ! newsreaders chopping off subject lines, but it might also mean that ! unrelated articles that have subject that happen to begin with the ! same few characters will be incorrectly gathered. ! ! 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 fuzzily.") ! ! (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 `more', fill in all leaf nodes that Gnus can find. 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. ! This variable will only be used if the value of ! `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 run gnus-find-new-newsgroups at startup. ! This normally finds new newsgroups by comparing the active groups the ! servers have already reported with those Gnus already knows, either alive ! or killed. ! ! When any of the following are true, gnus-find-new-newsgroups will instead ! ask the servers (primary, secondary, and archive servers) to list new ! groups since the last time it checked: ! 1. This variable is `ask-server'. ! 2. This variable is a list of select methods (see below). ! 3. `gnus-read-active-file' is nil or `some'. ! 4. A prefix argument is given to gnus-find-new-newsgroups interactively. ! ! Thus, if this variable is `ask-server' or a list of select methods or ! `gnus-read-active-file' is nil or `some', then the killed list is no ! longer necessary, so you could safely set `gnus-save-killed-list' to nil. ! ! This variable can be a list of select methods which Gnus will query with ! the `ask-server' method in addition to the primary, secondary, and archive ! 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].") ! ! (defvar gnus-check-bogus-newsgroups nil ! "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. ! If this variable is nil, then you have to tell Gnus explicitly to ! check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups].") ! ! (defvar gnus-read-active-file t ! "*Non-nil means that Gnus will read the entire active file at startup. ! If this variable is nil, Gnus will only know about the groups in your ! `.newsrc' file. ! ! If this variable is `some', Gnus will try to only read the relevant ! parts of the active file from the server. Not all servers support ! this, and it might be quite slow with other servers, but this should ! generally be faster than both the t and nil value. ! ! If you set this variable to nil or `some', you probably still want to ! be told about new newsgroups that arrive. To do that, set ! `gnus-check-new-newsgroups' to `ask-server'. This may not work ! properly with all servers.") ! ! (defvar gnus-level-subscribed 5 ! "*Groups with levels less than or equal to this variable are subscribed.") ! ! (defvar gnus-level-unsubscribed 7 ! "*Groups with levels less than or equal to this variable are unsubscribed. ! Groups with levels less than `gnus-level-subscribed', which should be ! less than this variable, are subscribed.") ! ! (defvar gnus-level-zombie 8 ! "*Groups with this level are zombie groups.") ! ! (defvar gnus-level-killed 9 ! "*Groups with this level are killed.") ! ! (defvar gnus-level-default-subscribed 3 ! "*New subscribed groups will be subscribed at this level.") ! ! (defvar gnus-level-default-unsubscribed 6 ! "*New unsubscribed groups will be unsubscribed at this level.") ! ! (defvar gnus-activate-level (1+ gnus-level-subscribed) ! "*Groups higher than this level won't be activated on startup. ! Setting this variable to something log might save lots of time when ! you have many groups that you aren't interested in.") ! ! (defvar gnus-activate-foreign-newsgroups 4 ! "*If nil, Gnus will not check foreign newsgroups at startup. ! 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 ! might take a while. By setting this variable to nil, you'll save time, ! but you won't be told how many unread articles there are in the ! groups.") ! ! (defvar gnus-save-newsrc-file t ! "*Non-nil means that Gnus will save the `.newsrc' file. ! Gnus always saves its own startup file, which is called ! \".newsrc.eld\". The file called \".newsrc\" is in a format that can ! be readily understood by other newsreaders. If you don't plan on ! using other newsreaders, set this variable to nil to save some time on ! exit.") ! ! (defvar gnus-save-killed-list t ! "*If non-nil, save the list of killed groups to the startup file. ! If you set this variable to nil, you'll save both time (when starting ! and quitting) and space (both memory and disk), but it will also mean ! that Gnus has no record of which groups are new and which are old, so ! the automatic new newsgroups subscription methods become meaningless. ! ! You should always set `gnus-check-new-newsgroups' to `ask-server' or ! nil if you set this variable to nil.") ! ! (defvar gnus-interactive-catchup t ! "*If non-nil, require your confirmation when catching up a group.") ! ! (defvar gnus-interactive-exit t ! "*If non-nil, require your confirmation when exiting Gnus.") ! ! (defvar gnus-kill-killed t ! "*If non-nil, Gnus will apply kill files to already killed articles. ! If it is nil, Gnus will never apply kill files to articles that have ! already been through the scoring process, which might very well save lots ! of time.") ! ! (defvar gnus-extract-address-components 'gnus-extract-address-components ! "*Function for extracting address components from a From header. ! Two pre-defined function exist: `gnus-extract-address-components', ! which is the default, quite fast, and too simplistic solution, and ! `mail-extract-address-components', which works much better, but is ! slower.") ! ! (defvar gnus-summary-default-score 0 ! "*Default article score level. ! If this variable is nil, scoring will be disabled.") ! ! (defvar gnus-summary-zcore-fuzz 0 ! "*Fuzziness factor for the zcore in the summary buffer. ! Articles with scores closer than this to `gnus-summary-default-score' ! will not be marked.") ! ! (defvar gnus-simplify-subject-fuzzy-regexp nil ! "*Strings to be removed when doing fuzzy matches. ! This can either be a regular expression or list of regular expressions ! that will be removed from subject strings if fuzzy subject ! simplification is selected.") ! ! (defvar gnus-permanently-visible-groups nil ! "*Regexp to match groups that should always be listed in the group buffer. ! This means that they will still be listed when there are no unread ! articles in the groups.") ! ! (defvar gnus-list-groups-with-ticked-articles t ! "*If non-nil, list groups that have only ticked articles. ! If nil, only list groups that have unread articles.") ! ! (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 ! "*If non-nil, once you set a level, Gnus will use this level.") ! ! (defvar gnus-group-list-inactive-groups t ! "*If non-nil, inactive groups will be listed.") ! ! (defvar gnus-show-mime nil ! "*If non-nil, do mime processing of articles. ! The articles will simply be fed to the function given by ! `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.") ! ! (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.") ! ! (defvar gnus-thread-hide-subtree nil ! "*If non-nil, hide all threads initially. ! If threads are hidden, you have to run the command ! `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' ! to expose hidden threads.") ! ! (defvar gnus-thread-hide-killed t ! "*If non-nil, hide killed threads automatically.") ! ! (defvar gnus-thread-ignore-subject nil ! "*If non-nil, ignore subjects and do all threading based on the Reference header. ! If nil, which is the default, articles that have different subjects ! from their parents will start separate threads.") ! ! (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 ! variable is `fuzzy', only articles that have subjects that are fuzzily ! equal will be included.") ! ! (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, ! thus making them effectively non-existent.") ! ! (defvar gnus-ignored-headers ! "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" ! "*All headers that match this regexp will be hidden. ! 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.") ! ! (defvar gnus-save-all-headers t ! "*If non-nil, don't remove any headers before saving.") ! ! (defvar gnus-saved-headers gnus-visible-headers ! "*Headers to keep if `gnus-save-all-headers' is nil. ! If `gnus-save-all-headers' is non-nil, this variable will be ignored. ! If that variable is nil, however, all headers that match this regexp ! will be kept while the rest will be deleted before saving.") ! (defvar gnus-inhibit-startup-message nil ! "*If non-nil, the startup message will not be displayed.") ! (defvar gnus-signature-separator "^-- *$" ! "Regexp matching signature separator.") ! (defvar gnus-signature-limit nil ! "Provide a limit to what is considered a signature. ! If it is a number, no signature may not be longer (in characters) than ! that number. If it is a function, the function will be called without ! any parameters, and if it returns nil, there is no signature in the ! buffer. If it is a string, it will be used as a regexp. If it ! matches, the text in question is not a signature.") ! ! (defvar gnus-auto-extend-newsgroup t ! "*If non-nil, extend newsgroup forward and backward when requested.") ! ! (defvar gnus-auto-select-first t ! "*If nil, don't select the first unread article when entering a group. ! If this variable is `best', select the highest-scored unread article ! in the group. If neither nil nor `best', select the first unread ! article. ! ! 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 ! confirmation if you are located on the last article in the group. ! Finally, if this variable is `slightly-quietly', the `Z n' command ! will go to the next group without confirmation.") ! ! (defvar gnus-auto-select-same nil ! "*If non-nil, select the next article with the same subject.") ! ! (defvar gnus-summary-check-current nil ! "*If non-nil, consider the current article when moving. ! The \"unread\" movement commands will stay on the same line if the ! current article is unread.") ! ! (defvar gnus-auto-center-summary t ! "*If non-nil, always center the current summary buffer. ! In particular, if `vertical' do only vertical recentering. If non-nil ! and non-`vertical', do both horizontal and vertical recentering.") ! ! (defvar gnus-break-pages t ! "*If non-nil, do page breaking on articles. ! The page delimiter is specified by the `gnus-page-delimiter' ! variable.") ! ! (defvar gnus-page-delimiter "^\^L" ! "*Regexp describing what to use as article page delimiters. ! The default value is \"^\^L\", which is a form linefeed at the ! beginning of a line.") ! ! (defvar gnus-use-full-window t ! "*If non-nil, use the entire Emacs screen.") ! ! (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)) ! (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)))) ! (message ! (vertical 1.0 ! (message 1.0 point))) ! (pick ! (vertical 1.0 ! (article 1.0 point))) ! (info ! (vertical 1.0 ! (info 1.0 point))) ! (summary-faq ! (vertical 1.0 ! (summary 0.25) ! (faq 1.0 point))) ! (edit-group ! (vertical 1.0 ! (group 0.5) ! (edit-group 1.0 point))) ! (edit-server ! (vertical 1.0 ! (server 0.5) ! (edit-server 1.0 point))) ! (edit-score ! (vertical 1.0 ! (summary 0.25) ! (edit-score 1.0 point))) ! (post ! (vertical 1.0 ! (post 1.0 point))) ! (reply ! (vertical 1.0 ! (article-copy 0.5) ! (message 1.0 point))) ! (forward ! (vertical 1.0 ! (message 1.0 point))) ! (reply-yank ! (vertical 1.0 ! (message 1.0 point))) ! (mail-bounce ! (vertical 1.0 ! (article 0.5) ! (message 1.0 point))) ! (draft ! (vertical 1.0 ! (draft 1.0 point))) ! (pipe ! (vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal '(summary-carpal 4)) ! ("*Shell Command Output*" 1.0))) ! (bug ! (vertical 1.0 ! ("*Gnus Help Bug*" 0.5) ! ("*Gnus Bug*" 1.0 point))) ! (compose-bounce ! (vertical 1.0 ! (article 0.5) ! (message 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 ! be present to denote which buffer point is to go to after making this ! buffer configuration.") ! ! (defvar gnus-window-to-buffer ! '((group . gnus-group-buffer) ! (summary . gnus-summary-buffer) ! (article . gnus-article-buffer) ! (server . gnus-server-buffer) ! (browse . "*Gnus Browse Server*") ! (edit-group . gnus-group-edit-buffer) ! (edit-server . gnus-server-edit-buffer) ! (group-carpal . gnus-carpal-group-buffer) ! (summary-carpal . gnus-carpal-summary-buffer) ! (server-carpal . gnus-carpal-server-buffer) ! (browse-carpal . gnus-carpal-browse-buffer) ! (edit-score . gnus-score-edit-buffer) ! (message . gnus-message-buffer) ! (mail . gnus-message-buffer) ! (post-news . gnus-message-buffer) ! (faq . gnus-faq-buffer) ! (picons . "*Picons*") ! (tree . gnus-tree-buffer) ! (info . gnus-info-buffer) ! (article-copy . gnus-article-copy) ! (draft . gnus-draft-buffer)) ! "Mapping from short symbols to buffer names or buffer variables.") ! ! (defvar gnus-carpal nil ! "*If non-nil, display clickable icons.") ! ! (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies ! "*Function called with a group name when new group is detected. ! A few pre-made functions are supplied: `gnus-subscribe-randomly' ! inserts new groups at the beginning of the list of groups; ! `gnus-subscribe-alphabetically' inserts new groups in strict ! alphabetic order; `gnus-subscribe-hierarchically' inserts new groups ! in hierarchical newsgroup order; `gnus-subscribe-interactively' asks ! for your decision; `gnus-subscribe-killed' kills all new groups; ! `gnus-subscribe-zombies' will make all new groups into zombies.") ! ! ;; 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. ! If, for instance, you want to subscribe to all newsgroups in the ! \"no\" and \"alt\" hierarchies, you'd put the following in your ! .newsrc file: ! ! options -n no.all alt.all ! ! Gnus will the subscribe all new newsgroups in these hierarchies with ! the subscription method in this variable.") ! ! (defvar gnus-subscribe-hierarchical-interactive nil ! "*If non-nil, Gnus will offer to subscribe hierarchically. ! When a new hierarchy appears, Gnus will ask the user: ! ! 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): ! ! If the user pressed `d', Gnus will descend the hierarchy, `y' will ! subscribe to all newsgroups in the hierarchy and `s' will skip this ! hierarchy in its entirety.") ! ! (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet ! "*Function used for sorting the group buffer. ! This function will be called with group info entries as the arguments ! 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', ! `gnus-group-sort-by-method', 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 ?! ! "*Mark used for ticked articles.") ! (defvar gnus-dormant-mark ?? ! "*Mark used for dormant articles.") ! (defvar gnus-del-mark ?r ! "*Mark used for del'd articles.") ! (defvar gnus-read-mark ?R ! "*Mark used for read articles.") ! (defvar gnus-expirable-mark ?E ! "*Mark used for expirable articles.") ! (defvar gnus-killed-mark ?K ! "*Mark used for killed articles.") ! (defvar gnus-souped-mark ?F ! "*Mark used for killed articles.") ! (defvar gnus-kill-file-mark ?X ! "*Mark used for articles killed by kill files.") ! (defvar gnus-low-score-mark ?Y ! "*Mark used for articles with a low score.") ! (defvar gnus-catchup-mark ?C ! "*Mark used for articles that are caught up.") ! (defvar gnus-replied-mark ?A ! "*Mark used for articles that have been replied to.") ! (defvar gnus-cached-mark ?* ! "*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 ?+ ! "*Score mark used for articles with high scores.") ! (defvar gnus-score-below-mark ?- ! "*Score mark used for articles with low scores.") ! (defvar gnus-empty-thread-mark ? ! "*There is no thread under the article.") ! (defvar gnus-not-empty-thread-mark ?= ! "*There is a thread under the article.") ! ! (defvar gnus-shell-command-separator ";" ! "String used to separate to shell commands.") ! ! (defvar gnus-view-pseudo-asynchronously nil ! "*If non-nil, Gnus will view pseudo-articles asynchronously.") ! ! (defvar gnus-view-pseudos nil ! "*If `automatic', pseudo-articles will be viewed automatically. ! If `not-confirm', pseudos will be viewed automatically, and the user ! will not be asked to confirm the command.") ! ! (defvar gnus-view-pseudos-separately t ! "*If non-nil, one pseudo-article will be created for each file to be viewed. ! If nil, all files that use the same viewing command will be given as a ! list of parameters to that command.") ! ! (defvar gnus-insert-pseudo-articles t ! "*If non-nil, insert pseudo-articles when decoding articles.") ! ! (defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" ! "*Format of group lines. ! It works along the same lines as a normal formatting string, ! with some simple extensions. ! ! %M Only marked articles (character, \"*\" or \" \") ! %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") ! %L Level of subscribedness (integer) ! %N Number of unread articles (integer) ! %I Number of dormant articles (integer) ! %i Number of ticked and dormant (integer) ! %T Number of ticked articles (integer) ! %R Number of read articles (integer) ! %t Total number of articles (integer) ! %y Number of unread, unticked articles (integer) ! %G Group name (string) ! %g Qualified group name (string) ! %D Group description (string) ! %s Select method (string) ! %o Moderated group (char, \"m\") ! %p Process mark (char) ! %O Moderated group (string, \"(m)\" or \"\") ! %P Topic indentation (string) ! %l Whether there are GroupLens predictions for this group (string) ! %n Select from where (string) ! %z A string that look like `<%s:%n>' if a foreign select method is used ! %u User defined specifier. The next character in the format string should ! be a letter. Gnus will call the function gnus-user-format-function-X, ! where X is the letter following %u. The function will be passed the ! current header as argument. The function should return a string, which ! will be inserted into the buffer just like information from any other ! group specifier. ! ! Text between %( and %) will be highlighted with `gnus-mouse-face' when ! the mouse point move inside the area. There can only be one such area. ! ! 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. ! ! If you use %o or %O, reading the active file will be slower and quite ! 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. ! ! It works along the same lines as a normal formatting string, ! with some simple extensions. ! ! %N Article number, left padded with spaces (string) ! %S Subject (string) ! %s Subject if it is at the root of a thread, and \"\" otherwise (string) ! %n Name of the poster (string) ! %a Extracted name of the poster (string) ! %A Extracted address of the poster (string) ! %F Contents of the From: header (string) ! %x Contents of the Xref: header (string) ! %D Date of the article (string) ! %d Date of the article (string) in DD-MMM format ! %M Message-id of the article (string) ! %r References of the article (string) ! %c Number of characters in the article (integer) ! %L Number of lines in the article (integer) ! %I Indentation based on thread level (a string of spaces) ! %T A string with two possible values: 80 spaces if the article ! is on thread level two or larger and 0 spaces on level one ! %R \"A\" if this article has been replied to, \" \" otherwise (character) ! %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") ! %[ Opening bracket (character, \"[\" or \"<\") ! %] Closing bracket (character, \"]\" or \">\") ! %> Spaces of length thread-level (string) ! %< Spaces of length (- 20 thread-level) (string) ! %i Article score (number) ! %z Article zcore (character) ! %t Number of articles under the current thread (number). ! %e Whether the thread is empty or not (character). ! %l GroupLens score (string). ! %u User defined specifier. The next character in the format string should ! be a letter. Gnus will call the function gnus-user-format-function-X, ! where X is the letter following %u. The function will be passed the ! current header as argument. The function should return a string, which ! will be inserted into the summary just like information from any other ! 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. ! ! %S The subject") ! ! (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" ! "*The format specification for the summary mode line. ! It works along the same lines as a normal formatting string, ! with some simple extensions: ! ! %G Group name ! %p Unprefixed group name ! %A Current article number ! %V Gnus version ! %U Number of unread articles in the group ! %e Number of unselected articles in the group ! %Z A string with unread/unselected article counts ! %g Shortish group name ! %S Subject of the current article ! %u User-defined spec ! %s Current score file name ! %d Number of dormant articles ! %r Number of articles that have been marked as read in this session ! %E Number of articles expunged by the score files") ! ! (defvar gnus-article-mode-line-format "Gnus: %%b %S" ! "*The format specification for the article mode line. ! See `gnus-summary-mode-line-format' for a closer description.") ! ! (defvar gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" ! "*The format specification for the group mode line. ! It works along the same lines as a normal formatting string, ! with some simple extensions: ! ! %S The native news server. ! %M The native select method. ! %: \":\" if %S isn't \"\".") ! ! (defvar gnus-valid-select-methods ! '(("nntp" post address prompt-address) ! ("nnspool" post address) ! ("nnvirtual" post-mail virtual prompt-address) ! ("nnmbox" mail respool address) ! ("nnml" mail respool address) ! ("nnmh" mail respool address) ! ("nndir" post-mail prompt-address address) ! ("nneething" none address prompt-address) ! ("nndoc" none address prompt-address) ! ("nnbabyl" mail address respool) ! ("nnkiboze" post virtual) ! ("nnsoup" post-mail address) ! ("nndraft" post-mail) ! ("nnfolder" mail respool address)) ! "An alist of valid select methods. ! The first element of each list lists should be a string with the name ! of the select method. The other elements may be the category of ! 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 . ! (defvar gnus-mode-non-string-length nil ! "*Max length of mode-line non-string contents. ! If this is nil, Gnus will take space as is needed, leaving the rest ! of the modeline intact.") ! ! ;see gnus-cus.el ! ;(defvar gnus-mouse-face 'highlight ! ; "*Face used for mouse highlighting in Gnus. ! ;No mouse highlights will be done if `gnus-visual' is nil.") ! ! (defvar gnus-summary-mark-below 0 ! "*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. ! By default, threads are sorted by article number. ! ! 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', ! `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and ! `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').") ! ! (defvar gnus-thread-score-function '+ ! "*Function used for calculating the total score of a thread. ! ! The function is called with the scores of the article and each ! subthread and should then return the score of the thread. ! ! Some functions you can use are `+', `max', or `min'.") ! ! (defvar gnus-summary-expunge-below nil ! "All articles that have a score less than this variable will be expunged.") ! ! (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 ! whatsoever on old groups. ! ! New groups that match this regexp will not be handled by ! `gnus-subscribe-newsgroup-method'. Instead, they will ! be subscribed using `gnus-subscribe-options-newsgroup-method'.") ! ! (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. ! ! New groups that match this regexp will not be handled by ! `gnus-subscribe-newsgroup-method'. Instead, they will ! be subscribed using `gnus-subscribe-options-newsgroup-method'.") ! ! (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 ! "*Groups in which to automatically mark read articles as expirable. ! If non-nil, this should be a regexp that should match all groups in ! which to perform auto-expiry. This only makes sense for mail groups.") ! ! (defvar gnus-total-expirable-newsgroups nil ! "*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-group-uncollapsed-levels 1 ! "Number of group name elements to leave alone when making a short group name.") ! ! (defvar gnus-hidden-properties '(invisible t intangible t) ! "Property list to use for hiding text.") ! ! (defvar gnus-modtime-botch nil ! "*Non-nil means .newsrc should be deleted prior to save. ! Its use is due to the bogus appearance that .newsrc was modified on ! disc.") ! ! ;; Hooks. ! ! (defvar gnus-group-mode-hook nil ! "*A hook for Gnus group mode.") ! ! (defvar gnus-summary-mode-hook nil ! "*A hook for Gnus summary mode. ! This hook is run before any variables are set in the summary buffer.") ! ! (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-check-bogus-groups-hook nil ! "A hook run after removing bogus groups.") ! ! (defvar gnus-group-catchup-group-hook nil ! "*A hook run when catching up a group from the group buffer.") ! ! (defvar gnus-group-update-group-hook nil ! "*A hook called when updating group lines.") ! ! (defvar gnus-open-server-hook nil ! "*A hook called just before opening connection to the news server.") ! ! (defvar gnus-load-hook nil ! "*A hook run while Gnus is loaded.") ! ! (defvar gnus-startup-hook nil ! "*A hook called at startup. ! This hook is called after Gnus is connected to the NNTP server.") ! ! (defvar gnus-get-new-news-hook nil ! "*A hook run just before Gnus checks for new news.") ! ! (defvar gnus-after-getting-new-news-hook nil ! "*A hook run after Gnus checks for new news.") ! ! (defvar gnus-group-prepare-function 'gnus-group-prepare-flat ! "*A function that is called to generate the group buffer. ! The function is called with three arguments: The first is a number; ! all group with a level less or equal to that number should be listed, ! if the second is non-nil, empty groups should also be displayed. If ! the third is non-nil, it is a number. No groups with a level lower ! than this number should be displayed. ! ! The only current function implemented is `gnus-group-prepare-flat'.") ! ! (defvar gnus-group-prepare-hook nil ! "*A hook called after the group buffer has been generated. ! If you want to modify the group buffer, you can use this hook.") ! ! (defvar gnus-summary-prepare-hook nil ! "*A hook called after the summary buffer has been generated. ! If you want to modify the summary buffer, you can use this hook.") ! ! (defvar gnus-summary-generate-hook nil ! "*A hook run just before generating the summary buffer. ! This hook is commonly used to customize threading variables and the ! like.") ! ! (defvar gnus-article-prepare-hook nil ! "*A hook called after an article has been prepared in the article buffer. ! If you want to run a special decoding program like nkf, use this hook.") ! ! ;(defvar gnus-article-display-hook nil ! ; "*A hook called after the article is displayed in the article buffer. ! ;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) ! ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike) ! ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) ! ! (defvar gnus-article-x-face-too-ugly nil ! "Regexp matching posters whose face shouldn't be shown automatically.") ! ! (defvar gnus-select-group-hook nil ! "*A hook called when a newsgroup is selected. ! ! If you'd like to simplify subjects like the ! `gnus-summary-next-same-subject' command does, you can use the ! following hook: ! ! (setq gnus-select-group-hook ! (list ! (lambda () ! (mapcar (lambda (header) ! (mail-header-set-subject ! header ! (gnus-simplify-subject ! (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. ! This hook is intended to apply a kill file to the selected newsgroup. ! The function `gnus-apply-kill-file' is called by default. ! ! Since a general kill file is too heavy to use only for a few ! newsgroups, I recommend you to use a lighter hook function. For ! example, if you'd like to apply a kill file to articles which contains ! a string `rmgroup' in subject in newsgroup `control', you can use the ! following hook: ! ! (setq gnus-apply-kill-hook ! (list ! (lambda () ! (cond ((string-match \"control\" gnus-newsgroup-name) ! (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.") ! (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522) ! ! (defvar gnus-exit-group-hook nil ! "*A hook called when exiting (not quitting) summary mode.") ! ! (defvar gnus-suspend-gnus-hook nil ! "*A hook called when suspending (not exiting) Gnus.") ! ! (defvar gnus-exit-gnus-hook nil ! "*A hook called when exiting Gnus.") ! ! (defvar gnus-after-exiting-gnus-hook nil ! "*A hook called after exiting Gnus.") ! ! (defvar gnus-save-newsrc-hook nil ! "*A hook called before saving any of the newsrc files.") ! ! (defvar gnus-save-quick-newsrc-hook nil ! "*A hook called just before saving the quick newsrc file. ! Can be used to turn version control on or off.") ! ! (defvar gnus-save-standard-newsrc-hook nil ! "*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. ! ! The default function `gnus-summary-highlight-line' will ! highlight the line according to the `gnus-summary-highlight' ! variable.") ! ! (defvar gnus-group-update-hook '(gnus-group-highlight-line) ! "*A hook called when a group line is changed. ! The hook will not be called if `gnus-visual' is nil. ! ! The default function `gnus-group-highlight-line' will ! highlight the line according to the `gnus-group-highlight' ! variable.") ! ! (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) ! "*A hook called when an article is selected for the first time. ! 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 () ! (remove-hook 'gnus-summary-prepare-hook ! 'hilit-rehighlight-buffer-quietly) ! (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks) ! (setq gnus-mark-article-hook ! '(gnus-summary-mark-read-and-unread-as-read)) ! (remove-hook 'gnus-article-prepare-hook ! 'hilit-rehighlight-buffer-quietly))) ! ! ;; Internal variables ! (defvar gnus-tree-buffer "*Tree*" ! "Buffer where Gnus thread trees are displayed.") ! ;; Dummy variable. ! (defvar gnus-use-generic-from nil) ! (defvar gnus-thread-indent-array nil) ! (defvar gnus-thread-indent-array-level gnus-thread-indent-level) ! ! (defvar gnus-newsrc-file-version nil) ! ! (defvar gnus-method-history nil) ! ;; Variable holding the user answers to all method prompts. ! ! (defvar gnus-group-history nil) ! ;; Variable holding the user answers to all group prompts. ! ! (defvar gnus-server-alist nil ! "List of available servers.") ! ! (defvar gnus-group-indentation-function nil) ! ! (defvar gnus-topic-indentation "") ;; Obsolete variable. ! ! (defvar gnus-goto-missing-group-function nil) ! ! (defvar gnus-override-subscribe-method nil) ! ! (defvar gnus-group-goto-next-group-function nil ! "Function to override finding the next group after listing groups.") ! ! (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) ! (defvar gnus-newsgroup-selected-overlay nil) ! ! (defvar gnus-inhibit-hiding nil) ! (defvar gnus-group-indentation "") ! (defvar gnus-inhibit-limiting nil) ! (defvar gnus-created-frames nil) ! ! (defvar gnus-article-mode-map nil) ! (defvar gnus-dribble-buffer nil) ! (defvar gnus-headers-retrieved-by nil) ! (defvar gnus-article-reply nil) ! (defvar gnus-override-method nil) ! (defvar gnus-article-check-size nil) ! ! (defvar gnus-current-score-file nil) ! (defvar gnus-newsgroup-adaptive-score-file nil) ! (defvar gnus-scores-exclude-files nil) ! ! (defvar gnus-opened-servers nil) ! ! (defvar gnus-current-move-group nil) ! (defvar gnus-current-copy-group nil) ! (defvar gnus-current-crosspost-group nil) ! ! (defvar gnus-newsgroup-dependencies nil) ! (defvar gnus-newsgroup-async nil) ! (defvar gnus-group-edit-buffer nil) ! ! (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) ! (?N (cond ((eq number t) "*" ) ! ((numberp number) ! (int-to-string ! (+ number ! (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ! (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) ! (t number)) ?s) ! (?R gnus-tmp-number-of-read ?s) ! (?t gnus-tmp-number-total ?d) ! (?y gnus-tmp-number-of-unread ?s) ! (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) ! (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) ! (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ! (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) ! (?g gnus-tmp-group ?s) ! (?G gnus-tmp-qualified-group ?s) ! (?c (gnus-short-group-name gnus-tmp-group) ?s) ! (?D gnus-tmp-newsgroup-description ?s) ! (?o gnus-tmp-moderated ?c) ! (?O gnus-tmp-moderated-string ?s) ! (?p gnus-tmp-process-marked ?c) ! (?s gnus-tmp-news-server ?s) ! (?n gnus-tmp-news-method ?s) ! (?P gnus-group-indentation ?s) ! (?l gnus-tmp-grouplens ?s) ! (?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) ! (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) ! (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) ! (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) ! (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) ! (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) ! (?L gnus-tmp-lines ?d) ! (?I gnus-tmp-indentation ?s) ! (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) ! (?R gnus-tmp-replied ?c) ! (?\[ gnus-tmp-opening-bracket ?c) ! (?\] gnus-tmp-closing-bracket ?c) ! (?\> (make-string gnus-tmp-level ? ) ?s) ! (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) ! (?i gnus-tmp-score ?d) ! (?z gnus-tmp-score-char ?c) ! (?l (bbb-grouplens-score gnus-tmp-header) ?s) ! (?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)) ! "An alist of format specifications that can appear in summary lines, ! 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) ! (?A gnus-tmp-article-number ?d) ! (?Z gnus-tmp-unread-and-unselected ?s) ! (?V gnus-version ?s) ! (?U gnus-tmp-unread-and-unticked ?d) ! (?S gnus-tmp-subject ?s) ! (?e gnus-tmp-unselected ?d) ! (?u gnus-tmp-user-defined ?s) ! (?d (length gnus-newsgroup-dormant) ?d) ! (?t (length gnus-newsgroup-marked) ?d) ! (?r (length gnus-newsgroup-reads) ?d) ! (?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) ! (?: gnus-tmp-colon ?s))) ! ! (defvar gnus-have-read-active-file nil) ! ! (defconst gnus-maintainer ! "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" ! "The mail address of the Gnus maintainers.") ! (defconst gnus-version-number "5.2.38" ! "Version number for this version of Gnus.") ! (defconst gnus-version (format "Gnus v%s" gnus-version-number) ! "Version string for this version of Gnus.") ! (defvar gnus-info-nodes ! '((gnus-group-mode "(gnus)The Group Buffer") ! (gnus-summary-mode "(gnus)The Summary Buffer") ! (gnus-article-mode "(gnus)The Article Buffer") ! (gnus-server-mode "(gnus)The Server Buffer") ! (gnus-browse-mode "(gnus)Browse Foreign Server") ! (gnus-tree-mode "(gnus)Tree Display") ! ) ! "Alist of major modes and related Info nodes.") ! (defvar gnus-group-buffer "*Group*") ! (defvar gnus-summary-buffer "*Summary*") ! (defvar gnus-article-buffer "*Article*") ! (defvar gnus-server-buffer "*Server*") ! ! (defvar gnus-work-buffer " *gnus work*") ! ! (defvar gnus-original-article-buffer " *Original Article*") ! (defvar gnus-original-article nil) ! ! (defvar gnus-buffer-list nil ! "Gnus buffers that should be killed on exit.") ! ! (defvar gnus-slave nil ! "Whether this Gnus is a slave or not.") ! ! (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 ! gnus-format-specs) ! "Gnus variables saved in the quick startup file.") ! ! (defvar gnus-newsrc-options nil ! "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.") ! ! (defvar gnus-topic-topology nil ! "The complete topic hierarchy.") ! ! (defvar gnus-topic-alist nil ! "The complete topic-group alist.") ! ! (defvar gnus-newsrc-alist nil ! "Assoc list of read articles. ! gnus-newsrc-hashtb should be kept so that both hold the same information.") ! ! (defvar gnus-newsrc-hashtb nil ! "Hashtable of gnus-newsrc-alist.") ! ! (defvar gnus-killed-list nil ! "List of killed newsgroups.") ! ! (defvar gnus-killed-hashtb nil ! "Hash table equivalent of gnus-killed-list.") ! ! (defvar gnus-zombie-list nil ! "List of almost dead newsgroups.") ! ! (defvar gnus-description-hashtb nil ! "Descriptions of newsgroups.") ! ! (defvar gnus-list-of-killed-groups nil ! "List of newsgroups that have recently been killed by the user.") ! ! (defvar gnus-active-hashtb nil ! "Hashtable of active articles.") ! ! (defvar gnus-moderated-list nil ! "List of moderated newsgroups.") ! ! (defvar gnus-group-marked nil) ! ! (defvar gnus-current-startup-file nil ! "Startup file for the current host.") ! ! (defvar gnus-last-search-regexp nil ! "Default regexp for article search command.") ! ! (defvar gnus-last-shell-command nil ! "Default shell command on article.") ! ! (defvar gnus-current-select-method nil ! "The current method for selecting a newsgroup.") ! ! (defvar gnus-group-list-mode nil) ! ! (defvar gnus-article-internal-prepare-hook nil) ! ! (defvar gnus-newsgroup-name nil) ! (defvar gnus-newsgroup-begin nil) ! (defvar gnus-newsgroup-end nil) ! (defvar gnus-newsgroup-last-rmail nil) ! (defvar gnus-newsgroup-last-mail nil) ! (defvar gnus-newsgroup-last-folder nil) ! (defvar gnus-newsgroup-last-file nil) ! (defvar gnus-newsgroup-auto-expire nil) ! (defvar gnus-newsgroup-active nil) ! ! (defvar gnus-newsgroup-data nil) ! (defvar gnus-newsgroup-data-reverse nil) ! (defvar gnus-newsgroup-limit nil) ! (defvar gnus-newsgroup-limits nil) ! ! (defvar gnus-newsgroup-unreads nil ! "List of unread articles in the current newsgroup.") ! ! (defvar gnus-newsgroup-unselected nil ! "List of unselected unread articles in the current newsgroup.") ! ! (defvar gnus-newsgroup-reads nil ! "Alist of read articles and article marks in the current newsgroup.") ! ! (defvar gnus-newsgroup-expunged-tally nil) ! ! (defvar gnus-newsgroup-marked nil ! "List of ticked articles in the current newsgroup (a subset of unread art).") ! ! (defvar gnus-newsgroup-killed nil ! "List of ranges of articles that have been through the scoring process.") ! ! (defvar gnus-newsgroup-cached nil ! "List of articles that come from the article cache.") ! ! (defvar gnus-newsgroup-saved nil ! "List of articles that have been saved.") ! ! (defvar gnus-newsgroup-kill-headers nil) ! ! (defvar gnus-newsgroup-replied nil ! "List of articles that have been replied to in the current newsgroup.") ! ! (defvar gnus-newsgroup-expirable nil ! "List of articles in the current newsgroup that can be expired.") ! ! (defvar gnus-newsgroup-processable nil ! "List of articles in the current newsgroup that can be processed.") ! ! (defvar gnus-newsgroup-bookmarks nil ! "List of articles in the current newsgroup that have bookmarks.") ! ! (defvar gnus-newsgroup-dormant nil ! "List of dormant articles in the current newsgroup.") ! ! (defvar gnus-newsgroup-scored nil ! "List of scored articles in the current newsgroup.") ! ! (defvar gnus-newsgroup-headers nil ! "List of article headers in the current newsgroup.") ! ! (defvar gnus-newsgroup-threads nil) ! ! (defvar gnus-newsgroup-prepared nil ! "Whether the current group has been prepared properly.") ! ! (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) ! (defvar gnus-have-all-headers nil) ! (defvar gnus-last-article nil) ! (defvar gnus-newsgroup-history nil) ! (defvar gnus-current-kill-article nil) ! ! ;; Save window configuration. ! (defvar gnus-prev-winconf nil) ! ! (defvar gnus-summary-mark-positions nil) ! (defvar gnus-group-mark-positions nil) ! ! (defvar gnus-reffed-article-number nil) ! ! ;;; Let the byte-compiler know that we know about this variable. ! (defvar rmail-default-rmail-file) ! ! (defvar gnus-cache-removable-articles nil) ! ! (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-thread-expunge-below ! gnus-score-alist gnus-current-score-file gnus-summary-expunge-below ! (gnus-summary-mark-below . global) ! 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-reffed-article-number . -1) ! (gnus-newsgroup-expunged-tally . 0) ! gnus-cache-removable-articles gnus-newsgroup-cached ! gnus-newsgroup-data gnus-newsgroup-data-reverse ! gnus-newsgroup-limit gnus-newsgroup-limits) ! "Variables that are buffer-local to the summary buffers.") ! ! (defconst gnus-bug-message ! "Sending a bug report to the Gnus Towers. ! ======================================== ! ! 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. ! ! Thank you for your help in stamping out bugs. ! ") ! ! ;;; End of variables. ! ! ;; Define some autoload functions Gnus might use. ! (eval-and-compile ! ! ;; 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) ! (setq keymap (car (memq 'keymap function))) ! (setq function (car function))) ! (autoload function (car package) nil interactive keymap))) ! (if (eq (nth 1 package) ':interactive) ! (cdddr package) ! (cdr package))))) ! '(("metamail" metamail-buffer) ! ("info" Info-goto-node) ! ("hexl" hexl-hex-string-to-integer) ! ("pp" pp pp-to-string pp-eval-expression) ! ("mail-extr" mail-extract-address-components) ! ("nnmail" nnmail-split-fancy nnmail-article-group) ! ("nnvirtual" nnvirtual-catchup-group) ! ("timezone" timezone-make-date-arpa-standard timezone-fix-time ! timezone-make-sortable-date timezone-make-time-string) ! ("rmailout" rmail-output) ! ("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) ! ("score-mode" :interactive t gnus-score-mode) ! ("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 ! gnus-server-make-menu-bar gnus-article-make-menu-bar ! gnus-browse-make-menu-bar gnus-highlight-selected-summary ! gnus-summary-highlight-line gnus-carpal-setup-buffer ! gnus-group-highlight-line ! 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-nocem-unwanted-article-p) ! ("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-article-hide-citation-in-followups) ! ("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 ! gnus-cache-retrieve-headers gnus-cache-possibly-alter-active ! gnus-cache-enter-remove-article gnus-cached-article-p ! gnus-cache-open gnus-cache-close gnus-cache-update-article) ! ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article ! 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-summary-raise-score ! gnus-summary-set-score gnus-summary-current-score) ! ("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-binary-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-buffer ! 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-article-mail gnus-new-mail gnus-mail-reply ! gnus-copy-article-buffer) ! ("gnus-msg" :interactive t ! gnus-group-post-news gnus-group-mail gnus-summary-post-news ! gnus-summary-followup gnus-summary-followup-with-original ! gnus-summary-cancel-article gnus-summary-supersede-article ! gnus-post-news gnus-inews-news ! gnus-summary-reply gnus-summary-reply-with-original ! gnus-summary-mail-forward gnus-summary-mail-other-window ! gnus-bug) ! ("gnus-picon" :interactive t gnus-article-display-picons ! gnus-group-display-picons gnus-picons-article-display-x-face ! gnus-picons-display-x-face) ! ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p ! gnus-grouplens-mode) ! ("smiley" :interactive t gnus-smiley-display) ! ("gnus-vm" gnus-vm-mail-setup) ! ("gnus-vm" :interactive t gnus-summary-save-in-vm ! gnus-summary-save-article-vm)))) --- 28,114 ---- (eval '(run-hooks 'gnus-load-hook)) ! (defconst gnus-version-number "0.1" ! "Version number for this version of Gnus.") ! (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) ! "Version string for this version of Gnus.") ! ;;; Splash screen. ! (defvar gnus-group-buffer "*Group*") ! (defvar gnus-inhibit-startup-message nil ! "*If non-nil, the startup message will not be displayed.") ! (defun gnus-splash () ! (switch-to-buffer gnus-group-buffer) ! (let ((buffer-read-only nil)) ! (erase-buffer) ! (unless gnus-inhibit-startup-message ! (gnus-group-startup-message) ! (sit-for 0)))) ! (defun gnus-indent-rigidly (start end arg) ! "Indent rigidly using only spaces and no tabs." ! (save-excursion ! (save-restriction ! (narrow-to-region start end) ! (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." ! ;; Insert the message. ! (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) ! (let* ((pheight (count-lines (point-min) (point-max))) ! (wheight (window-height)) ! (rest (- wheight pheight))) ! (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ! ;; Fontify some. ! (goto-char (point-min)) ! (and (search-forward "Praxis" nil t) ! (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) ! (goto-char (point-min)) ! (setq mode-line-buffer-identification gnus-version) ! (set-buffer-modified-p t)) ! ;(unless (string-match "xemacs" (emacs-version)) ! (gnus-splash) ! ;) ! ;;; Do the rest. ! (require 'gnus-load) *************** *** 2163,2188 **** (defun gnus-header-from (header) (mail-header-from header)) - (defmacro gnus-eval-in-buffer-window (buffer &rest forms) - "Pop to BUFFER, evaluate FORMS, and then return to the original window." - (let ((tempvar (make-symbol "GnusStartBufferWindow")) - (w (make-symbol "w")) - (buf (make-symbol "buf"))) - `(let* ((,tempvar (selected-window)) - (,buf ,buffer) - (,w (get-buffer-window ,buf 'visible))) - (unwind-protect - (progn - (if ,w - (select-window ,w) - (pop-to-buffer ,buf)) - ,@forms) - (select-window ,tempvar))))) - - (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) - (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) - (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) - (defmacro gnus-gethash (string hashtable) "Get hash value of STRING in HASHTABLE." `(symbol-value (intern-soft ,string ,hashtable))) --- 123,128 ---- *************** *** 2191,2203 **** "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(set (intern ,string ,hashtable) ,value)) - (defmacro gnus-intern-safe (string hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(let ((symbol (intern ,string ,hashtable))) - (or (boundp symbol) - (set symbol nil)) - symbol)) - (defmacro gnus-group-unread (group) "Get the currently computed number of unread articles in GROUP." `(car (gnus-gethash ,group gnus-newsrc-hashtb))) --- 131,136 ---- *************** *** 2214,2313 **** "Set GROUP's active info." `(gnus-sethash ,group ,active gnus-active-hashtb)) - ;; modified by MORIOKA Tomohiko - ;; function `substring' might cut on a middle of multi-octet - ;; character. - (defun gnus-truncate-string (str width) - (substring str 0 width)) - - ;; Added by Geoffrey T. Dairiki . A safe way - ;; to limit the length of a string. This function is necessary since - ;; `(substr "abc" 0 30)' pukes with "Args out of range". - (defsubst gnus-limit-string (str width) - (if (> (length str) width) - (substring str 0 width) - str)) - - (defsubst gnus-simplify-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) - (substring subject (match-end 0)) - subject)) - - (defsubst gnus-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)))) - - (defsubst gnus-goto-char (point) - (and point (goto-char point))) - - (defmacro gnus-buffer-exists-p (buffer) - `(let ((buffer ,buffer)) - (and buffer - (funcall (if (stringp buffer) 'get-buffer 'buffer-name) - buffer)))) - - (defmacro gnus-kill-buffer (buffer) - `(let ((buf ,buffer)) - (if (gnus-buffer-exists-p buf) - (kill-buffer buf)))) - - (defsubst gnus-point-at-bol () - "Return point at the beginning of the line." - (let ((p (point))) - (beginning-of-line) - (prog1 - (point) - (goto-char p)))) - - (defsubst gnus-point-at-eol () - "Return point at the end of the line." - (let ((p (point))) - (end-of-line) - (prog1 - (point) - (goto-char p)))) - (defun gnus-alive-p () "Say whether Gnus is running or not." (and gnus-group-buffer (get-buffer gnus-group-buffer))) - (defun gnus-delete-first (elt list) - "Delete by side effect the first occurrence of ELT as a member of LIST." - (if (equal (car list) elt) - (cdr list) - (let ((total list)) - (while (and (cdr list) - (not (equal (cadr list) elt))) - (setq list (cdr list))) - (when (cdr list) - (setcdr list (cddr list))) - total))) - - ;; Delete the current line (and the next N lines.); - (defmacro gnus-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - - ;; Suggested by Brian Edmonds . - (defvar gnus-init-inhibit nil) - (defun gnus-read-init-file (&optional inhibit-next) - (if gnus-init-inhibit - (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. (defmacro gnus-info-group (info) --- 147,157 ---- *************** *** 2359,2373 **** (defmacro gnus-get-info (group) `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) - (defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (symbol-function func))) - (if (byte-code-function-p fval) - (let ((flist (append fval nil))) - (setcar flist 'byte-code) - flist) - (cons 'progn (cddr fval))))) - ;; Find out whether the gnus-visual TYPE is wanted. (defun gnus-visual-p (&optional type class) (and gnus-visual ; Has to be non-nil, at least. --- 203,208 ---- *************** *** 2403,3612 **** (funcall (car entry)))))) - - ;; Format specs. The chunks below are the machine-generated forms - ;; 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. - - (defvar gnus-tmp-unread) - (defvar gnus-tmp-replied) - (defvar gnus-tmp-score-char) - (defvar gnus-tmp-indentation) - (defvar gnus-tmp-opening-bracket) - (defvar gnus-tmp-lines) - (defvar gnus-tmp-name) - (defvar gnus-tmp-closing-bracket) - (defvar gnus-tmp-subject-or-nil) - (defvar gnus-tmp-subject) - (defvar gnus-tmp-marked) - (defvar gnus-tmp-marked-mark) - (defvar gnus-tmp-subscribed) - (defvar gnus-tmp-process-marked) - (defvar gnus-tmp-number-of-unread) - (defvar gnus-tmp-group-name) - (defvar gnus-tmp-group) - (defvar gnus-tmp-article-number) - (defvar gnus-tmp-unread-and-unselected) - (defvar gnus-tmp-news-method) - (defvar gnus-tmp-news-server) - (defvar gnus-tmp-article-number) - (defvar gnus-mouse-face) - (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) - (gnus-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 () - (insert "* ") - (gnus-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-group-indentation - (format "%5s: " gnus-tmp-number-of-unread)) - (gnus-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 - ,gnus-summary-dummy-line-format-spec) - (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec))) - - (defvar gnus-article-mode-line-format-spec nil) - (defvar gnus-summary-mode-line-format-spec nil) - (defvar gnus-group-mode-line-format-spec nil) - - ;;; Phew. All that gruft is over, fortunately. - - ;;; ;;; Gnus Utility Functions ;;; - (defun gnus-extract-address-components (from) - (let (name address) - ;; First find the address - the thing with the @ in it. This may - ;; not be accurate in mail addresses, but does the trick most of - ;; the time in news messages. - (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (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)))) - - (defun gnus-fetch-field (field) - "Return the value of the header FIELD of current article." - (save-excursion - (save-restriction - (let ((case-fold-search t) - (inhibit-point-motion-hooks t)) - (nnheader-narrow-to-headers) - (message-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." - (interactive - (list - (save-excursion - (eval-defun nil) - ;; Find the end of the current word. - (re-search-forward "[ \t\n]" nil t) - ;; Search backward. - (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) - (match-string 1))))) - (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) - (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)) - (gnus-parse-format (setq value (symbol-value (intern var))) - (symbol-value (intern (format "%s-alist" var))) - (not (string-match "mode" var)))) - (setq spec (symbol-value (intern (format "%s-spec" var)))) - (push (list type value spec) gnus-format-specs) - - (pop-to-buffer "*Gnus Format*") - (erase-buffer) - (lisp-interaction-mode) - (insert (pp-to-string spec)))) - - (defun gnus-update-format-specifications (&optional force) - "Update all (necessary) format specifications." - ;; Make the indentation array. - (gnus-make-thread-indent-array) - - ;; See whether all the stored info needs to be flushed. - (when (or force - (not (equal emacs-version - (cdr (assq 'version gnus-format-specs))))) - (setq gnus-format-specs nil)) - - ;; Go through all the formats and see whether they need updating. - (let ((types '(summary summary-dummy group - summary-mode group-mode article-mode)) - new-format entry type val) - (while (setq type (pop types)) - ;; Jump to the proper buffer to find out the value of - ;; the variable, if possible. (It may be buffer-local.) - (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) - (when (and (boundp buffer) - (setq val (symbol-value buffer)) - (get-buffer val) - (buffer-name (get-buffer val))) - (set-buffer (get-buffer val))) - (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type)))))) - (setq entry (cdr (assq type gnus-format-specs))) - (if (and entry - (equal (car entry) new-format)) - ;; Use the old format. - (set (intern (format "gnus-%s-line-format-spec" type)) - (cadr entry)) - ;; This is a new format. - (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)))))) - ;; Enter the new format spec into the list. - (if entry - (progn - (setcar (cdr entry) val) - (setcar entry new-format)) - (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val)))) - - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs)) - - (gnus-update-group-mark-positions) - (gnus-update-summary-mark-positions)) - - (defun gnus-update-summary-mark-positions () - "Compute where the summary marks are to go." - (save-excursion - (when (and gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) - (set-buffer gnus-summary-buffer)) - (let ((gnus-replied-mark 129) - (gnus-score-below-mark 130) - (gnus-score-over-mark 130) - (thread nil) - (gnus-visual nil) - (spec gnus-summary-line-format-spec) - pos) - (save-excursion - (gnus-set-work-buffer) - (let ((gnus-summary-line-format-spec spec)) - (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) - (- (point) 2))))) - (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) - (- (point) 2))) - pos) - (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) - pos))) - (setq gnus-summary-mark-positions pos)))) - - (defun gnus-update-group-mark-positions () - (save-excursion - (let ((gnus-process-mark 128) - (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0))) - (gnus-set-active "dummy.group" '(0 . 0)) - (gnus-set-work-buffer) - (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) - (goto-char (point-min)) - (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward "\200" nil t) - (- (point) 2)))))))) - - (defvar gnus-mouse-face-0 'highlight) - (defvar gnus-mouse-face-1 'highlight) - (defvar gnus-mouse-face-2 'highlight) - (defvar gnus-mouse-face-3 'highlight) - (defvar gnus-mouse-face-4 'highlight) - - (defun gnus-mouse-face-function (form type) - `(gnus-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))))))) - - (defvar gnus-face-0 'bold) - (defvar gnus-face-1 'italic) - (defvar gnus-face-2 'bold-italic) - (defvar gnus-face-3 'bold) - (defvar gnus-face-4 'bold) - - (defun gnus-face-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) - - (defun gnus-max-width-function (el max-width) - (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) - (if (symbolp el) - `(if (> (length ,el) ,max-width) - (substring ,el 0 ,max-width) - ,el) - `(let ((val (eval ,el))) - (if (numberp val) - (setq val (int-to-string val))) - (if (> (length val) ,max-width) - (substring val 0 ,max-width) - val)))) - - (defun gnus-parse-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 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) - ;; This is a simple format. - (gnus-parse-simple-format format spec-alist insert))) - - (defun gnus-parse-complex-format (format spec-alist) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "\"" nil t) - (replace-match "\\\"" nil t)) - (goto-char (point-min)) - (insert "(\"") - (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) - (let ((number (if (match-beginning 1) - (match-string 1) "0")) - (delim (aref (match-string 2) 0))) - (if (or (= delim ?\() (= delim ?\{)) - (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") - " " number " \"")) - (replace-match "\")\"")))) - (goto-char (point-max)) - (insert "\")") - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) - - (defun gnus-complex-form-to-spec (form spec-alist) - (delq nil - (mapcar - (lambda (sform) - (if (stringp sform) - (gnus-parse-simple-format sform spec-alist t) - (funcall (intern (format "gnus-%s-face-function" (car sform))) - (gnus-complex-form-to-spec (cddr 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 - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" - nil t) - (if (= (setq spec (string-to-char (match-string 2))) ?%) - (setq newspec "%" - beg (1+ (match-beginning 0))) - ;; First check if there are any specs that look anything like - ;; "%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))) - ;; Find the specification from `spec-alist'. - (unless (setq elem (cdr (assq spec spec-alist))) - (setq elem '("*" ?s))) - ;; 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 ((= (cadr elem) ?c) - (setq el (list 'char-to-string el))) - ((= (cadr 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 (cadr elem))))) - ;; Remove the old specification (and possibly a ",12" string). - (delete-region beg (match-end 2)) - ;; Insert the new specification. - (goto-char beg) - (insert newspec)) - (setq fstring (buffer-substring 1 (point-max)))) - ;; Do some postprocessing to increase efficiency. - (setq - result - (cond - ;; Emptyness. - ((string= fstring "") - nil) - ;; Not a format string. - ((not (string-match "%" fstring)) - (list fstring)) - ;; A format string with just a single string spec. - ((string= fstring "%s") - (list (car flist))) - ;; A single character. - ((string= fstring "%c") - (list (car flist))) - ;; A single number. - ((string= fstring "%d") - (setq dontinsert) - (if insert - (list `(princ ,(car flist))) - (list `(int-to-string ,(car flist))))) - ;; Just lots of chars and strings. - ((string-match "\\`\\(%[cs]\\)+\\'" fstring) - (nreverse flist)) - ;; A single string spec at the beginning of the spec. - ((string-match "\\`%[sc][^%]+\\'" fstring) - (list (car flist) (substring fstring 2))) - ;; A single string spec in the middle of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) - (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) - ;; A single string spec in the end of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) - (list (match-string 1 fstring) (car flist))) - ;; A more complex spec. - (t - (list (cons 'format (cons fstring (nreverse flist))))))) - - (if insert - (when result - (if dontinsert - result - (cons 'insert result))) - (cond ((stringp result) - result) - ((consp result) - (cons 'concat result)) - (t ""))))) - - (defun gnus-eval-format (format &optional alist props) - "Eval the format variable FORMAT, using ALIST. - If PROPS, insert the result." - (let ((form (gnus-parse-format format alist props))) - (if props - (gnus-add-text-properties (point) (progn (eval form) (point)) props) - (eval form)))) - - (defun gnus-remove-text-with-property (prop) - "Delete all text in the current buffer with text property PROP." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (while (get-text-property (point) prop) - (delete-char 1)) - (goto-char (next-single-property-change (point) prop nil (point-max)))))) - - (defun gnus-set-work-buffer () - (if (get-buffer gnus-work-buffer) - (progn - (set-buffer gnus-work-buffer) - (erase-buffer)) - (set-buffer (get-buffer-create gnus-work-buffer)) - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)) - (gnus-add-current-to-buffer-list))) - - ;; Article file names when saving. - - (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 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) - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - - (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) - newsgroup - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - - (defun gnus-Plain-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. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - - (defun gnus-plain-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. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - newsgroup - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - - ;; For subscribing new newsgroup - - (defun gnus-subscribe-hierarchical-interactive (groups) - (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) - (while groups - (setq prefixes (list "^")) - (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) - (setq prefixes (cdr prefixes))) - (setq prefix (car prefixes)) - (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 (cadr groups))) - (progn - (setq prefixes (cons prefix prefixes)) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix)))) - (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q))) - (ding) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix))))) - (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)) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?q) - (while groups - (setq group (car groups)) - (setq gnus-killed-list (cons group gnus-killed-list)) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t nil))) - (message "Subscribe %s? ([n]yq)" (car groups)) - (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n))) - (ding) - (message "Subscribe %s? ([n]yq)" (car groups))) - (setq group (car groups)) - (cond ((= ans ?y) - (gnus-subscribe-alphabetically (car groups)) - (gnus-sethash group group gnus-killed-hashtb)) - ((= ans ?q) - (while groups - (setq group (car groups)) - (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))))))) - - (defun gnus-subscribe-randomly (newsgroup) - "Subscribe new NEWSGROUP by making it the first newsgroup." - (gnus-subscribe-newsgroup newsgroup)) - - (defun gnus-subscribe-alphabetically (newgroup) - "Subscribe new NEWSGROUP and insert it in alphabetical order." - (let ((groups (cdr gnus-newsrc-alist)) - before) - (while (and (not before) groups) - (if (string< newgroup (caar groups)) - (setq before (caar groups)) - (setq groups (cdr groups)))) - (gnus-subscribe-newsgroup newgroup before))) - - (defun gnus-subscribe-hierarchically (newgroup) - "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." - ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) - (save-excursion - (set-buffer (find-file-noselect gnus-current-startup-file)) - (let ((groupkey newgroup) - before) - (while (and (not before) groupkey) - (goto-char (point-min)) - (let ((groupkey-re - (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) - (while (and (re-search-forward groupkey-re nil t) - (progn - (setq before (match-string 1)) - (string< before newgroup))))) - ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) - (setq groupkey - (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) - (substring groupkey (match-beginning 1) (match-end 1))))) - (gnus-subscribe-newsgroup newgroup before)) - (kill-buffer (current-buffer)))) - - (defun gnus-subscribe-interactively (group) - "Subscribe the new GROUP interactively. - It is inserted in hierarchical newsgroup order if subscribed. If not, - it is killed." - (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) - (gnus-subscribe-hierarchically group) - (push group gnus-killed-list))) - - (defun gnus-subscribe-zombies (group) - "Make the new GROUP into a zombie group." - (push group gnus-zombie-list)) - - (defun gnus-subscribe-killed (group) - "Make the new GROUP a killed group." - (push group gnus-killed-list)) - - (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." - (save-excursion - (goto-char (point-min)) - ;; 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))) - - ;; For directories - - (defun gnus-newsgroup-directory-form (newsgroup) - "Make hierarchical directory name from NEWSGROUP name." - (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) - (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)) - ;; Replace all occurrences of `.' with `/'. - (while (< idx len) - (if (= (aref newsgroup idx) ?.) - (aset newsgroup idx ?/)) - (setq idx (1+ idx))) - newsgroup)) - - (defun gnus-newsgroup-savable-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." - (unless dir - (error "No directory to make")) - ;; 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) - (if (string-match "/$" dir) - (setq dir (substring dir 0 (match-beginning 0)))) - ;; First go down the path until we find a directory that exists. - (while (not (file-exists-p dir)) - (setq dirs (cons dir dirs)) - (string-match "/[^/]+$" dir) - (setq dir (substring dir 0 (match-beginning 0)))) - ;; Then create all the subdirs. - (while (and dirs (not err)) - (condition-case () - (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) - "Capitalize NEWSGROUP name." - (and (not (zerop (length newsgroup))) - (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)) - - ;; Remove any leading "re:"s, any trailing paren phrases, and simplify - ;; all whitespace. - ;; Written by Stainless Steel Rat . - (defun gnus-simplify-buffer-fuzzy () - (let ((case-fold-search t)) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " t t)) - (goto-char (point-min)) - (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t) - (goto-char (match-beginning 0)) - (while (or - (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") - (looking-at "^[[].*: .*[]]$")) - (goto-char (point-min)) - (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" - nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (re-search-forward "^[[].*: .*[]]$" nil t) - (goto-char (match-end 0)) - (delete-char -1) - (delete-region - (progn (goto-char (match-beginning 0))) - (re-search-forward ":")))) - (goto-char (point-min)) - (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (re-search-forward " +" nil t) - (replace-match " " t t)) - (goto-char (point-min)) - (while (re-search-forward " $" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (re-search-forward "^ +" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (when gnus-simplify-subject-fuzzy-regexp - (if (listp gnus-simplify-subject-fuzzy-regexp) - (let ((list gnus-simplify-subject-fuzzy-regexp)) - (while list - (goto-char (point-min)) - (while (re-search-forward (car list) nil t) - (replace-match "" t t)) - (setq list (cdr list)))) - (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) - (replace-match "" t t)))))) - - (defun gnus-simplify-subject-fuzzy (subject) - "Siplify a subject string fuzzily." - (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - (insert subject) - (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)))) - (defun gnus-string> (s1 s2) - (not (or (string< s1 s2) - (string= s1 s2)))) - - (defun gnus-read-active-file-p () - "Say whether the active file has been read from `gnus-select-method'." - (memq gnus-select-method gnus-have-read-active-file)) - - ;;; General various misc type functions. - - (defun gnus-clear-system () - "Clear all variables and buffers." - ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - ;; Clear other internal variables. - (setq gnus-list-of-killed-groups nil - gnus-have-read-active-file nil - gnus-newsrc-alist nil - gnus-newsrc-hashtb nil - gnus-killed-list nil - gnus-zombie-list nil - gnus-killed-hashtb nil - gnus-active-hashtb nil - gnus-moderated-list nil - gnus-description-hashtb nil - gnus-current-headers nil - gnus-thread-indent-array nil - gnus-newsgroup-headers nil - gnus-newsgroup-name nil - gnus-server-alist nil - gnus-group-list-mode nil - gnus-opened-servers nil - gnus-group-mark-positions nil - gnus-newsgroup-data nil - gnus-newsgroup-unreads nil - nnoo-state-alist nil - gnus-current-select-method nil) - (gnus-shutdown 'gnus) - ;; Kill the startup file. - (and gnus-current-startup-file - (get-file-buffer gnus-current-startup-file) - (kill-buffer (get-file-buffer gnus-current-startup-file))) - ;; Clear the dribble buffer. - (gnus-dribble-clear) - ;; Kill global KILL file buffer. - (when (get-file-buffer (gnus-newsgroup-kill-file nil)) - (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) - (gnus-kill-buffer nntp-server-buffer) - ;; Kill Gnus buffers. - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) - ;; Remove Gnus frames. - (gnus-kill-gnus-frames)) - - (defun gnus-kill-gnus-frames () - "Kill all frames Gnus has created." - (while gnus-created-frames - (when (frame-live-p (car gnus-created-frames)) - ;; We slap a condition-case around this `delete-frame' to ensure - ;; against errors if we try do delete the single frame that's left. - (condition-case () - (delete-frame (car gnus-created-frames)) - (error nil))) - (pop gnus-created-frames))) - - (defun gnus-windows-old-to-new (setting) - ;; First we take care of the really, really old Gnus 3 actions. - (when (symbolp setting) - (setq setting - ;; Take care of ooold GNUS 3.x values. - (cond ((eq setting 'SelectArticle) 'article) - ((memq setting '(SelectSubject ExpandSubject)) 'summary) - ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group) - (t setting)))) - (if (or (listp setting) - (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)) - (elem (cadr (assq setting gnus-window-configuration))) - (total (apply '+ elem)) - (types '(group summary article)) - (pbuf (if (eq setting 'newsgroups) 'group 'summary)) - (i 0) - perc - out) - (while (< i 3) - (or (not (numberp (nth i elem))) - (zerop (nth i elem)) - (progn - (setq perc (if (= i 2) - 1.0 - (/ (float (nth 0 elem)) total))) - (setq out (cons (if (eq pbuf (nth i types)) - (list (nth i types) perc 'point) - (list (nth i types) perc)) - out)))) - (setq i (1+ i))) - `(vertical 1.0 ,@(nreverse out))))) - - ;;;###autoload - (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 - (setq window (get-buffer-window (current-buffer)))) - (select-window window) - ;; This might be an old-stylee buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - (let* ((type (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) - (unless buffer - (error "Illegal buffer type: %s" type)) - (unless (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) buffer))) - (setq buf (get-buffer-create (if (symbolp buffer) - (symbol-value buffer) buffer)))) - (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)))) - (push frame gnus-created-frames)) - ;; 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) - ;; First we have to compute the sizes of all new windows. - (while subs - (setq sub (append (pop subs) nil)) - (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) - (setq sub (eval sub))) - (when sub - (push sub comp-subs) - (setq size (cadar comp-subs)) - (cond ((equal size 1.0) - (setq rest (car comp-subs)) - (setq s 0)) - ((floatp size) - (setq s (floor (* size len)))) - ((integerp size) - (setq s size)) - (t - (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. - (if rest - (setcar (cdr rest) (- len total)) - (error "No 1.0 specs in %s" split)) - ;; The we do the actual splitting in a nice recursive - ;; fashion. - (setq comp-subs (nreverse comp-subs)) - (while comp-subs - (if (null (cdr comp-subs)) - (setq new-win window) - (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) - (setq comp-subs (cdr comp-subs)))) - ;; Return the proper window, if any. - (when result - (select-window result)))))) - - (defvar gnus-frame-split-p nil) - - (defun gnus-configure-windows (setting &optional force) - (setq setting (gnus-windows-old-to-new setting)) - (let ((split (if (symbolp setting) - (cadr (assq setting gnus-buffer-configuration)) - setting)) - all-visible) - - (setq gnus-frame-split-p nil) - - (unless split - (error "No such setting: %s" setting)) - - (if (and (setq all-visible (gnus-all-windows-visible-p split)) - (not force)) - ;; 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. - (let ((frame (selected-frame))) - (unwind-protect - (if gnus-use-full-window - ;; We want to remove all other windows. - (if (not gnus-frame-split-p) - ;; This is not a `frame' split, so we ignore the - ;; other frames. - (delete-other-windows) - ;; This is a `frame' split, so we delete all windows - ;; on all frames. - (mapcar - (lambda (frame) - (unless (eq (cdr (assq 'minibuffer - (frame-parameters frame))) - 'only) - (select-frame frame) - (delete-other-windows))) - (frame-list))) - ;; Just remove some windows. - (gnus-remove-some-windows) - (switch-to-buffer nntp-server-buffer)) - (select-frame frame))) - - (switch-to-buffer nntp-server-buffer) - (gnus-configure-frame split (get-buffer-window (current-buffer)))))) - - (defun gnus-all-windows-visible-p (split) - "Say whether all buffers in SPLIT are currently visible. - In particular, the value returned will be the window that - should have point." - (let ((stack (list split)) - (all-visible t) - type buffer win buf) - (while (and (setq split (pop stack)) - all-visible) - ;; Be backwards compatible. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - - (setq type (elt split 0)) - (cond - ;; Nothing here. - ((null split) t) - ;; A buffer. - ((not (memq type '(horizontal vertical frame))) - (setq buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - (unless buffer - (error "Illegal buffer type: %s" type)) - (when (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) - buffer))) - (setq win (get-buffer-window buf t))) - (if win - (when (memq 'point split) - (setq all-visible win)) - (setq all-visible nil))) - (t - (when (eq type 'frame) - (setq gnus-frame-split-p t)) - (setq stack (append (cddr split) stack))))) - (unless (eq all-visible t) - all-visible))) - - (defun gnus-window-top-edge (&optional window) - (nth 1 (window-edges window))) - - (defun gnus-remove-some-windows () - (let ((buffers gnus-window-to-buffer) - buf bufs lowest-buf lowest) - (save-excursion - ;; Remove windows on all known Gnus buffers. - (while buffers - (setq buf (cdar buffers)) - (if (symbolp buf) - (setq buf (and (boundp buf) (symbol-value buf)))) - (and buf - (get-buffer-window buf) - (progn - (setq bufs (cons buf bufs)) - (pop-to-buffer buf) - (if (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (progn - (setq lowest (gnus-window-top-edge)) - (setq lowest-buf buf))))) - (setq buffers (cdr buffers))) - ;; Remove windows on *all* summary buffers. - (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) - (if (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (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))) - (while bufs - (and (not (eq (car bufs) lowest-buf)) - (delete-windows-on (car bufs))) - (setq bufs (cdr bufs)))))) - (defun gnus-version (&optional arg) "Version number of this version of Gnus. If ARG, insert string at point." --- 238,252 ---- *************** *** 3628,3633 **** --- 268,296 ---- (insert (message mess)) (message mess)))) + (defun gnus-continuum-version (version) + "Return VERSION as a floating point number." + (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) + (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) + (let* ((alpha (and (match-beginning 1) (match-string 1 version))) + (number (match-string 2 version)) + major minor least) + (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) + (setq major (string-to-number (match-string 1 number))) + (setq minor (string-to-number (match-string 2 number))) + (setq least (if (match-beginning 3) + (string-to-number (match-string 3 number)) + 0)) + (string-to-number + (if (zerop major) + (format "%s00%02d%02d" + (cond + ((member alpha '("(ding)" "d")) "4.99") + ((member alpha '("September" "s")) "5.01") + ((member alpha '("Red" "r")) "5.03")) + minor least) + (format "%d.%02d%02d" major minor least)))))) + (defun gnus-info-find-node () "Find Info documentation of Gnus." (interactive) *************** *** 3638,3706 **** (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) ! (defun gnus-days-between (date1 date2) ! ;; Return the number of days between date1 and date2. ! (- (gnus-day-number date1) (gnus-day-number date2))) ! ! (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)))) ! (or (> (car fdate) (car date)) ! (and (= (car fdate) (car date)) ! (> (nth 1 fdate) (nth 1 date)))))) ! ! (defmacro gnus-local-set-keys (&rest plist) ! "Set the keys in PLIST in the current keymap." ! `(gnus-define-keys-1 (current-local-map) ',plist)) ! ! (defmacro gnus-define-keys (keymap &rest plist) ! "Define all keys in PLIST in KEYMAP." ! `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) ! ! (put 'gnus-define-keys 'lisp-indent-function 1) ! (put 'gnus-define-keys 'lisp-indent-hook 1) ! (put 'gnus-define-keymap 'lisp-indent-function 1) ! (put 'gnus-define-keymap 'lisp-indent-hook 1) ! ! (defmacro gnus-define-keymap (keymap &rest plist) ! "Define all keys in PLIST in KEYMAP." ! `(gnus-define-keys-1 ,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))) ! ((keymapp 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. --- 301,307 ---- (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) ! ;;; More various functions. (defun gnus-group-read-only-p (&optional group) "Check whether GROUP supports editing or not. *************** *** 3736,3765 **** (and (gnus-member-of-valid 'post-mail group) ; Combined group. (eq (gnus-request-type group article) 'news)))) - (defsubst gnus-simplify-subject-fully (subject) - "Simplify a subject string according to the user's wishes." - (cond - ((null gnus-summary-gather-subject-limit) - (gnus-simplify-subject-re subject)) - ((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 - ((null simple-first) - (equal (gnus-simplify-subject-fully s1) - (gnus-simplify-subject-fully s2))) - (t - (equal s1 - (gnus-simplify-subject-fully s2))))) - ;; Returns a list of writable groups. (defun gnus-writable-groups () (let ((alist gnus-newsrc-alist) --- 337,342 ---- *************** *** 3769,3796 **** (push group groups))) (nreverse groups))) - (defun gnus-completing-read (default prompt &rest args) - ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (if default - (concat prompt " (default " default ") ") - (concat prompt " "))) - (answer (apply 'completing-read prompt args))) - (if (or (null answer) (zerop (length answer))) - default - answer))) - - ;; Two silly functions to ensure that all `y-or-n-p' questions clear - ;; the echo area. - (defun gnus-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message ""))) - - (defun gnus-yes-or-no-p (prompt) - (prog1 - (yes-or-no-p prompt) - (message ""))) - ;; Check whether to use long file names. (defun gnus-use-long-file-name (symbol) ;; The variable has to be set... --- 346,351 ---- *************** *** 3801,3872 **** ;; 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 - ;; it yet. -erik selberg@cs.washington.edu - (defun gnus-dd-mmm (messy-date) - "Return a string like DD-MMM from a big messy string" - (let ((datevec (condition-case () (timezone-parse-date messy-date) - (error nil)))) - (if (not datevec) - "??-???" - (format "%2s-%s" - (condition-case () - ;; Make sure leading zeroes are stripped. - (number-to-string (string-to-number (aref datevec 2))) - (error "??")) - (capitalize - (or (car - (nth (1- (string-to-number (aref datevec 1))) - timezone-months-assoc)) - "???")))))) - - (defun gnus-mode-string-quote (string) - "Quote all \"%\" in STRING." - (save-excursion - (gnus-set-work-buffer) - (insert string) - (goto-char (point-min)) - (while (search-forward "%" nil t) - (insert "%")) - (buffer-string))) - - ;; Make a hash table (default and minimum size is 255). - ;; Optional argument HASHSIZE specifies the table size. - (defun gnus-make-hashtable (&optional hashsize) - (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0)) - - ;; Make a number that is suitable for hashing; bigger than MIN and one - ;; less than 2^x. - (defun gnus-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (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. - (defun gnus-message (level &rest args) - (if (<= level gnus-verbose) - (apply 'message args) - ;; We have to do this format thingy here even if the result isn't - ;; shown - the return value has to be the same as the return value - ;; from `message'. - (apply 'format args))) - - (defun gnus-error (level &rest args) - "Beep an error if LEVEL is equal to or less than `gnus-verbose'." - (when (<= (floor level) gnus-verbose) - (apply 'message args) - (ding) - (let (duration) - (when (and (floatp level) - (not (zerop (setq duration (* 10 (- level (floor level))))))) - (sit-for duration)))) - nil) - ;; Generate a unique new group name. (defun gnus-generate-new-group-name (leaf) (let ((name leaf) --- 356,361 ---- *************** *** 3875,3932 **** (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) name)) - (defsubst gnus-hide-text (b e props) - "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (gnus-add-text-properties b e props) - (when (memq 'intangible props) - (gnus-put-text-property (max (1- b) (point-min)) - b 'intangible (cddr (memq 'intangible props))))) - - (defsubst gnus-unhide-text (b e) - "Remove hidden text properties from region between B and E." - (remove-text-properties b e gnus-hidden-properties) - (when (memq 'intangible gnus-hidden-properties) - (gnus-put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - - (defun gnus-hide-text-type (b e type) - "Hide text of TYPE between B and E." - (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties)))) - - (defun gnus-parent-headers (headers &optional generation) - "Return the headers of the GENERATIONeth parent of HEADERS." - (unless generation - (setq generation 1)) - (let (references parent) - (while (and headers (not (zerop generation))) - (setq references (mail-header-references headers)) - (when (and references - (setq parent (gnus-parent-id references)) - (setq headers (car (gnus-id-to-thread parent)))) - (decf generation))) - headers)) - - (defun gnus-parent-id (references) - "Return the last Message-ID in REFERENCES." - (when (and references - (string-match "\\(<[^\n<>]+>\\)[ \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-buffer-live-p (buffer) - "Say whether BUFFER is alive or not." - (and buffer - (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - (defun gnus-ephemeral-group-p (group) "Say whether GROUP is ephemeral or not." (gnus-group-get-parameter group 'quit-config)) --- 364,369 ---- *************** *** 3944,4740 **** (when (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) " ")))) ! ;;; List and range functions ! ! (defun gnus-last-element (list) ! "Return last element of LIST." ! (while (cdr list) ! (setq list (cdr list))) ! (car list)) ! ! (defun gnus-copy-sequence (list) ! "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))) ! elem)) ! list))) ! ! (defun gnus-set-difference (list1 list2) ! "Return a list of elements of LIST1 that do not appear in LIST2." ! (let ((list1 (copy-sequence list1))) ! (while list2 ! (setq list1 (delq (car list2) list1)) ! (setq list2 (cdr list2))) ! list1)) ! ! (defun gnus-sorted-complement (list1 list2) ! "Return a list of elements of LIST1 that do not appear in LIST2. ! Both lists have to be sorted over <." ! (let (out) ! (if (or (null list1) (null list2)) ! (or list1 list2) ! (while (and list1 list2) ! (cond ((= (car list1) (car list2)) ! (setq list1 (cdr list1) ! list2 (cdr list2))) ! ((< (car list1) (car list2)) ! (setq out (cons (car list1) out)) ! (setq list1 (cdr list1))) ! (t ! (setq out (cons (car list2) out)) ! (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) ! (setq result (cons (car list2) result))) ! (setq list2 (cdr list2))) ! result)) ! ! (defun gnus-sorted-intersection (list1 list2) ! ;; LIST1 and LIST2 have to be sorted over <. ! (let (out) ! (while (and list1 list2) ! (cond ((= (car list1) (car list2)) ! (setq out (cons (car list1) out) ! list1 (cdr list1) ! list2 (cdr list2))) ! ((< (car list1) (car list2)) ! (setq list1 (cdr list1))) ! (t ! (setq list2 (cdr list2))))) ! (nreverse out))) ! ! (defun gnus-set-sorted-intersection (list1 list2) ! ;; LIST1 and LIST2 have to be sorted over <. ! ;; This function modifies LIST1. ! (let* ((top (cons nil list1)) ! (prev top)) ! (while (and list1 list2) ! (cond ((= (car list1) (car list2)) ! (setq prev list1 ! list1 (cdr list1) ! list2 (cdr list2))) ! ((< (car list1) (car list2)) ! (setcdr prev (cdr list1)) ! (setq list1 (cdr list1))) ! (t ! (setq list2 (cdr list2))))) ! (setcdr prev nil) ! (cdr top))) ! ! (defun gnus-compress-sequence (numbers &optional always-list) ! "Convert list of numbers to a list of ranges or a single range. ! If ALWAYS-LIST is non-nil, this function will always release a list of ! ranges." ! (let* ((first (car numbers)) ! (last (car numbers)) ! result) ! (if (null numbers) ! nil ! (if (not (listp (cdr numbers))) ! numbers ! (while numbers ! (cond ((= last (car numbers)) nil) ;Omit duplicated number ! ((= (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)) ! (setq last (car numbers)))) ! (setq numbers (cdr numbers))) ! (if (and (not always-list) (null result)) ! (if (= first last) (list first) (cons first last)) ! (nreverse (cons (if (= first last) first (cons first last)) ! result))))))) ! ! (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) ! (defun gnus-uncompress-range (ranges) ! "Expand a list of ranges into a list of numbers. ! 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))) ! (setq first (car ranges)) ! (setq last (cdr ranges)) ! (while (<= first last) ! (setq result (cons first result)) ! (setq first (1+ first))) ! (nreverse result)) ! (t ! (while ranges ! (if (atom (car ranges)) ! (if (numberp (car ranges)) ! (setq result (cons (car ranges) result))) ! (setq first (caar ranges)) ! (setq last (cdar ranges)) ! (while (<= first last) ! (setq result (cons first result)) ! (setq first (1+ first)))) ! (setq ranges (cdr ranges))) ! (nreverse result))))) ! ! (defun gnus-add-to-range (ranges list) ! "Return a list of ranges that has all articles from both RANGES and LIST. ! Note: LIST has to be sorted over `<'." ! (if (not ranges) ! (gnus-compress-sequence list t) ! (setq list (copy-sequence list)) ! (or (listp (cdr ranges)) ! (setq ranges (list ranges))) ! (let ((out ranges) ! ilist lowest highest temp) ! (while (and ranges list) ! (setq ilist list) ! (setq lowest (or (and (atom (car ranges)) (car ranges)) ! (caar ranges))) ! (while (and list (cdr list) (< (cadr list) lowest)) ! (setq list (cdr list))) ! (if (< (car ilist) lowest) ! (progn ! (setq temp list) ! (setq list (cdr list)) ! (setcdr temp nil) ! (setq out (nconc (gnus-compress-sequence ilist t) out)))) ! (setq highest (or (and (atom (car ranges)) (car ranges)) ! (cdar ranges))) ! (while (and list (<= (car list) highest)) ! (setq list (cdr list))) ! (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) ! (while ranges ! (if (atom (car ranges)) ! (if (cdr ranges) ! (if (atom (cadr ranges)) ! (if (= (1+ (car ranges)) (cadr ranges)) ! (progn ! (setcar ranges (cons (car ranges) ! (cadr ranges))) ! (setcdr ranges (cddr ranges)))) ! (if (= (1+ (car ranges)) (caadr ranges)) ! (progn ! (setcar (cadr ranges) (car ranges)) ! (setcar ranges (cadr ranges)) ! (setcdr ranges (cddr ranges)))))) ! (if (cdr ranges) ! (if (atom (cadr ranges)) ! (if (= (1+ (cdar ranges)) (cadr ranges)) ! (progn ! (setcdr (car ranges) (cadr ranges)) ! (setcdr ranges (cddr ranges)))) ! (if (= (1+ (cdar ranges)) (caadr ranges)) ! (progn ! (setcdr (car ranges) (cdadr ranges)) ! (setcdr ranges (cddr ranges))))))) ! (setq ranges (cdr ranges))) ! out))) ! ! (defun gnus-remove-from-range (ranges list) ! "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 (caar ranges))) ! not-stop) ! (if (if (numberp (car ranges)) ! (= number (car ranges)) ! (and (>= number (caar ranges)) ! (<= number (cdar ranges)))) ! (setq not-stop nil)) ! (setq ranges (cdr ranges))) ! (not not-stop)))) ! ! (defun gnus-range-length (range) ! "Return the length RANGE would have if uncompressed." ! (length (gnus-uncompress-range range))) ! ! (defun gnus-sublist-p (list sublist) ! "Test whether all elements in SUBLIST are members of LIST." ! (let ((sublistp t)) ! (while sublist ! (unless (memq (pop sublist) list) ! (setq sublistp nil ! sublist nil))) ! sublistp)) ! ! ! ;;; ! ;;; Gnus group mode ! ;;; ! ! (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 ! "\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 ! [delete] 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 ! "m" gnus-group-mark-buffer ! "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 ! [delete] 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: ! ! \\{gnus-group-mode-map}" ! (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'group-menu 'menu)) ! (gnus-group-make-menu-bar)) ! (kill-all-local-variables) ! (gnus-simplify-mode-line) ! (setq major-mode 'gnus-group-mode) ! (setq mode-name "Group") ! (gnus-group-set-mode-line) ! (setq mode-line-process nil) ! (use-local-map gnus-group-mode-map) ! (buffer-disable-undo (current-buffer)) ! (setq truncate-lines t) ! (setq buffer-read-only t) ! (gnus-make-local-hook 'post-command-hook) ! (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) ! (run-hooks 'gnus-group-mode-hook)) ! ! (defun gnus-clear-inboxes-moved () ! (setq nnmail-moved-inboxes nil)) ! ! (defun gnus-mouse-pick-group (e) ! "Enter the group under the mouse pointer." ! (interactive "e") ! (mouse-set-point e) ! (gnus-group-read-group nil)) ! ! ;; Look at LEVEL and find out what the level is really supposed to be. ! ;; 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 ! (or (setq gnus-group-use-permanent-levels ! (or level (if (numberp gnus-group-use-permanent-levels) ! gnus-group-use-permanent-levels ! (or gnus-group-default-list-level ! gnus-level-subscribed)))) ! 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" ! (interactive "P") ! (gnus-no-server arg t)) ! ! ;;;###autoload ! (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." ! (interactive "P") ! (let ((val (or arg (1- gnus-level-default-subscribed)))) ! (gnus val t slave) ! (make-local-variable 'gnus-group-use-permanent-levels) ! (setq gnus-group-use-permanent-levels val))) ! ! ;;;###autoload ! (defun gnus-slave (&optional arg) ! "Read news as a slave." ! (interactive "P") ! (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) ! (progn ! (switch-to-buffer gnus-group-buffer) ! (gnus-group-get-new-news)) ! ! (gnus-clear-system) ! (nnheader-init-server-buffer) ! (gnus-read-init-file) ! (setq gnus-slave slave) ! ! (gnus-group-setup-buffer) ! (let ((buffer-read-only nil)) ! (erase-buffer) ! (if (not gnus-inhibit-startup-message) ! (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. ! (when (or gnus-slave gnus-use-dribble-file) ! (gnus-dribble-read-file)) ! ! ;; Allow using GroupLens predictions. ! (when gnus-use-grouplens ! (bbb-login) ! (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) ! ! (gnus-summary-make-display-table) ! ;; Do the actual startup. ! (gnus-setup-news nil level dont-connect) ! ;; Generate the group buffer. ! (gnus-group-list-groups level) ! (gnus-group-first-unread-group) ! (gnus-configure-windows 'group) ! (gnus-group-set-mode-line)))))) ! ! (defun gnus-unload () ! "Unload all Gnus features." ! (interactive) ! (or (boundp 'load-history) ! (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) ! (let ((history load-history) ! feature) ! (while history ! (and (string-match "^\\(gnus\\|nn\\)" (caar history)) ! (setq feature (cdr (assq 'provide (car history)))) ! (unload-feature feature 'force)) ! (setq history (cdr history))))) ! ! (defun gnus-compile () ! "Byte-compile the user-defined format specs." ! (interactive) ! (let ((entries gnus-format-specs) ! entry gnus-tmp-func) ! (save-excursion ! (gnus-message 7 "Compiling format specs...") ! ! (while entries ! (setq entry (pop entries)) ! (if (eq (car entry) 'version) ! (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))))) ! ! (push (cons 'version emacs-version) gnus-format-specs) ! ;; Mark the .newsrc.eld file as "dirty". ! (gnus-dribble-enter " ") ! (gnus-message 7 "Compiling user specs...done")))) ! ! (defun gnus-indent-rigidly (start end arg) ! "Indent rigidly using only spaces and no tabs." ! (save-excursion ! (save-restriction ! (narrow-to-region start end) ! (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." ! ;; Insert the message. ! (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) ! (let* ((pheight (count-lines (point-min) (point-max))) ! (wheight (window-height)) ! (rest (- wheight pheight))) ! (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ! ;; Fontify some. ! (goto-char (point-min)) ! (and (search-forward "Praxis" nil t) ! (gnus-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 ! (switch-to-buffer gnus-group-buffer) ! (gnus-add-current-to-buffer-list) ! (gnus-group-mode) ! (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) ! ! (defun gnus-group-list-groups (&optional level unread lowest) ! "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 ! (gnus-group-default-level nil t) ! gnus-group-default-list-level ! gnus-level-subscribed)))) ! (or level ! (setq level (car gnus-group-list-mode) ! unread (cdr gnus-group-list-mode))) ! (setq level (gnus-group-default-level level)) ! (gnus-group-setup-buffer) ;May call from out of group buffer ! (gnus-update-format-specifications) ! (let ((case-fold-search nil) ! (props (text-properties-at (gnus-point-at-bol))) ! (group (gnus-group-group-name))) ! (set-buffer gnus-group-buffer) ! (funcall gnus-group-prepare-function level unread lowest) ! (if (zerop (buffer-size)) ! (gnus-message 5 gnus-no-groups-message) ! (goto-char (point-max)) ! (when (or (not gnus-group-goto-next-group-function) ! (not (funcall gnus-group-goto-next-group-function ! group props))) ! (if (not group) ! ;; Go to the first group with unread articles. ! (gnus-group-search-forward t) ! ;; Find the right group to put point on. If the current group ! ;; has disappeared 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 (cdddr (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 ! (caar newsrc) gnus-active-hashtb))))) ! (setq newsrc (cdr newsrc))) ! (or newsrc (progn (goto-char (point-max)) ! (forward-line -1))))))) ! ;; Adjust cursor point. ! (gnus-group-position-point)))) ! ! (defun gnus-group-list-level (level &optional all) ! "List groups on LEVEL. ! If ALL (the prefix), also list groups that have no unread articles." ! (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. ! If REGEXP, only list groups matching REGEXP." ! (set-buffer gnus-group-buffer) ! (let ((buffer-read-only nil) ! (newsrc (cdr gnus-newsrc-alist)) ! (lowest (or lowest 1)) ! info clevel unread group params) ! (erase-buffer) ! (if (< lowest gnus-level-zombie) ! ;; List living groups. ! (while newsrc ! (setq info (car newsrc) ! group (gnus-info-group info) ! params (gnus-info-params info) ! newsrc (cdr newsrc) ! unread (car (gnus-gethash group gnus-newsrc-hashtb))) ! (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? ! (if (eq unread t) ; Unactivated? ! gnus-group-list-inactive-groups ; We list unactivated ! (> unread 0)) ; We list groups with unread articles ! (and gnus-list-groups-with-ticked-articles ! (cdr (assq 'tick (gnus-info-marks info)))) ! ; And groups with tickeds ! ;; Check for permanent visibility. ! (and gnus-permanently-visible-groups ! (string-match gnus-permanently-visible-groups ! 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) ! (setq gnus-group-list-mode (cons level all)) ! (run-hooks 'gnus-group-prepare-hook))) ! ! (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) ! ;; List zombies and killed lists somewhat faster, which was ! ;; suggested by Jack Vinson . It does ! ;; this by ignoring the group format specification altogether. ! (let (group) ! (if regexp ! ;; This loop is used when listing groups that match some ! ;; regexp. ! (while groups ! (setq group (pop groups)) ! (when (string-match regexp group) ! (gnus-add-text-properties ! (point) (prog1 (1+ (point)) ! (insert " " mark " *: " group "\n")) ! (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) ! 'gnus-unread t ! 'gnus-level level)))) ! ;; This loop is used when listing all groups. ! (while groups ! (gnus-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 ! 'gnus-level level)))))) ! ! (defmacro gnus-group-real-name (group) ! "Find the real name of a foreign newsgroup." ! `(let ((gname ,group)) ! (if (string-match ":[^:]+$" gname) ! (substring gname (1+ (match-beginning 0))) ! gname))) (defsubst gnus-server-add-address (method) (let ((method-name (symbol-name (car method)))) --- 381,387 ---- (when (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) " ")))) ! ;;; Servers and groups. (defsubst gnus-server-add-address (method) (let ((method-name (symbol-name (car method)))) *************** *** 4933,15004 **** (when info (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) ! (defun gnus-summary-bubble-group () ! "Increase the score of the current group. ! This is a handy function to add to `gnus-summary-exit-hook' to ! increase the score of each group you read." ! (gnus-group-add-score gnus-newsgroup-name)) ! ! (defun gnus-group-set-info (info &optional method-only-group part) ! (let* ((entry (gnus-gethash ! (or method-only-group (gnus-info-group info)) ! gnus-newsrc-hashtb)) ! (part-info info) ! (info (if method-only-group (nth 2 entry) info)) ! method) ! (when method-only-group ! (unless entry ! (error "Trying to change non-existent group %s" method-only-group)) ! ;; We have received 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))) ! (when (< len total) ! (setcdr (nthcdr (1- len) info) ! (make-list (- total len) nil))) ! ;; Then we enter the new info. ! (setcar (nthcdr (1- total) info) part-info))) ! (unless entry ! ;; This is a new group, so we just create it. ! (save-excursion ! (set-buffer gnus-group-buffer) ! (setq method (gnus-info-method info)) ! (when (gnus-server-equal method "native") ! (setq method nil)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (if method ! ;; It's a foreign group... ! (gnus-group-make-group ! (gnus-group-real-name (gnus-info-group info)) ! (if (stringp method) method ! (prin1-to-string (car method))) ! (and (consp method) ! (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)))) ! ;; Whether it was a new group or not, we now have the entry, so we ! ;; can do the update. ! (if entry ! (progn ! (setcar (nthcdr 2 entry) info) ! (when (and (not (eq (car entry) t)) ! (gnus-active (gnus-info-group info))) ! (setcar entry (length (gnus-list-of-unread-articles (car info)))))) ! (error "No such group: %s" (gnus-info-group info))))) ! ! (defun gnus-group-set-method-info (group select-method) ! (gnus-group-set-info select-method group 'method)) ! ! (defun gnus-group-set-params-info (group params) ! (gnus-group-set-info params group 'params)) ! ! (defun gnus-group-update-group-line () ! "Update the current line in the group buffer." ! (let* ((buffer-read-only nil) ! (group (gnus-group-group-name)) ! (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) ! gnus-group-indentation) ! (when group ! (and entry ! (not (gnus-ephemeral-group-p group)) ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" ! (prin1-to-string (nth 2 entry)) ")"))) ! (setq gnus-group-indentation (gnus-group-group-indentation)) ! (gnus-delete-line) ! (gnus-group-insert-group-line-info group) ! (forward-line -1) ! (gnus-group-position-point)))) ! ! (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)))) ! ! (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 ! (if (numberp number) ! (int-to-string (max 0 (- gnus-tmp-number-total number))) ! "*")) ! (gnus-tmp-subscribed ! (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) ! ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) ! ((= 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 (cadr 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) ! (cadr gnus-tmp-method)) "")) ! (gnus-tmp-marked-mark ! (if (and (numberp number) ! (zerop number) ! (cdr (assq 'tick gnus-tmp-marked))) ! ?* ? )) ! (gnus-tmp-process-marked ! (if (member gnus-tmp-group gnus-group-marked) ! gnus-process-mark ? )) ! (gnus-tmp-grouplens ! (or (and gnus-use-grouplens ! (bbb-grouplens-group-p gnus-tmp-group)) ! "")) ! (buffer-read-only nil) ! header gnus-tmp-header) ; passed as parameter to user-funcs. ! (beginning-of-line) ! (gnus-add-text-properties ! (point) ! (prog1 (1+ (point)) ! ;; Insert the text. ! (eval gnus-group-line-format-spec)) ! `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) ! gnus-unread ,(if (numberp number) ! (string-to-int gnus-tmp-number-of-unread) ! t) ! gnus-marked ,gnus-tmp-marked-mark ! gnus-indentation ,gnus-group-indentation ! gnus-level ,gnus-tmp-level)) ! (when (inline (gnus-visual-p 'group-highlight 'highlight)) ! (forward-line -1) ! (run-hooks 'gnus-group-update-hook) ! (forward-line)) ! ;; Allow XEmacs to remove front-sticky text properties. ! (gnus-group-remove-excess-properties))) ! ! (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. ! (save-restriction ! (widen) ! (let ((ident (gnus-intern-safe group gnus-active-hashtb)) ! (loc (point-min)) ! found buffer-read-only) ! ;; 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) ! (let ((gnus-group-indentation (gnus-group-group-indentation))) ! (gnus-delete-line) ! (gnus-group-insert-group-line-info group) ! (save-excursion ! (forward-line -1) ! (run-hooks 'gnus-group-update-group-hook))) ! (setq loc (1+ loc))) ! (unless (or found visible-only) ! ;; No such line in the buffer, find out where it's supposed to ! ;; go, and insert it there (or at the end of the buffer). ! (if gnus-goto-missing-group-function ! (funcall gnus-goto-missing-group-function group) ! (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) ! (while (and entry (car entry) ! (not ! (gnus-goto-char ! (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe ! (caar entry) gnus-active-hashtb))))) ! (setq entry (cdr entry))) ! (or entry (goto-char (point-max))))) ! ;; Finally insert the line. ! (let ((gnus-group-indentation (gnus-group-group-indentation))) ! (gnus-group-insert-group-line-info group) ! (save-excursion ! (forward-line -1) ! (run-hooks 'gnus-group-update-group-hook)))) ! (gnus-group-set-mode-line))))) ! ! (defun gnus-group-set-mode-line () ! "Update the mode line in the group buffer." ! (when (memq 'group gnus-updated-mode-lines) ! ;; Yes, we want to keep this mode line updated. ! (save-excursion ! (set-buffer gnus-group-buffer) ! (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 (cadr gnus-select-method)) ! (gnus-tmp-news-method (car gnus-select-method)) ! (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) ! (max-len 60) ! gnus-tmp-header ;Dummy binding for user-defined formats ! ;; Get the resulting string. ! (modified ! (and gnus-dribble-buffer ! (buffer-name gnus-dribble-buffer) ! (buffer-modified-p gnus-dribble-buffer) ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (not (zerop (buffer-size)))))) ! (mode-string (eval gformat))) ! ;; Say whether the dribble buffer has been modified. ! (setq mode-line-modified ! (if modified "---*- " "----- ")) ! ;; 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 ! (gnus-mode-line-buffer-identification ! (list mode-string))) ! (set-buffer-modified-p modified)))))) ! ! (defun gnus-group-group-name () ! "Get the name of the newsgroup on the current line." ! (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) ! (and group (symbol-name group)))) ! ! (defun gnus-group-group-level () ! "Get the level of the newsgroup on the current line." ! (get-text-property (gnus-point-at-bol) 'gnus-level)) ! ! (defun gnus-group-group-indentation () ! "Get the indentation of the newsgroup on the current line." ! (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) ! (and gnus-group-indentation-function ! (funcall gnus-group-indentation-function)) ! "")) ! ! (defun gnus-group-group-unread () ! "Get the number of unread articles of the newsgroup on the current line." ! (get-text-property (gnus-point-at-bol) 'gnus-unread)) ! ! (defun gnus-group-search-forward (&optional backward all level first-too) ! "Find the next newsgroup with unread articles. ! If BACKWARD is non-nil, find the previous newsgroup instead. ! If ALL is non-nil, just find any newsgroup. ! If LEVEL is non-nil, find group with level LEVEL, or higher if no such ! group exists. ! If FIRST-TOO, the current line is also eligible as a target." ! (let ((way (if backward -1 1)) ! (low gnus-level-killed) ! (beg (point)) ! pos found lev) ! (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) ! 'gnus-level)) ! (<= lev gnus-level-subscribed))) ! (or (not level) ! (and (setq lev (get-text-property (point) ! 'gnus-level)) ! (or (= lev level) ! (and (< lev low) ! (< level lev) ! (progn ! (setq low lev) ! (setq pos (point)) ! nil)))))))) ! (zerop (forward-line way))))) ! (if found ! (progn (gnus-group-position-point) t) ! (goto-char (or pos beg)) ! (and pos t)))) ! ! ;;; Gnus group mode commands ! ! ;; Group marking. ! ! (defun gnus-group-mark-group (n &optional unmark no-advance) ! "Mark the current group." ! (interactive "p") ! (let ((buffer-read-only nil) ! group) ! (while (and (> n 0) ! (not (eobp))) ! (when (setq group (gnus-group-group-name)) ! ;; Update the mark. ! (beginning-of-line) ! (forward-char ! (or (cdr (assq 'process gnus-group-mark-positions)) 2)) ! (delete-char 1) ! (if unmark ! (progn ! (insert " ") ! (setq gnus-group-marked (delete group gnus-group-marked))) ! (insert "#") ! (setq gnus-group-marked ! (cons group (delete group gnus-group-marked))))) ! (or no-advance (gnus-group-next-group 1)) ! (decf n)) ! (gnus-summary-position-point) ! n)) ! ! (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." ! (interactive) ! (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. ! If UNMARK, remove the mark instead." ! (interactive "P\nr") ! (let ((num (count-lines beg end))) ! (save-excursion ! (goto-char beg) ! (- num (gnus-group-mark-group num unmark))))) ! ! (defun gnus-group-mark-buffer (&optional unmark) ! "Mark all groups in the buffer. ! If UNMARK, remove the mark instead." ! (interactive "P") ! (gnus-group-mark-region unmark (point-min) (point-max))) ! ! (defun gnus-group-mark-regexp (regexp) ! "Mark all groups that match some regexp." ! (interactive "sMark (regexp): ") ! (let ((alist (cdr gnus-newsrc-alist)) ! 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) ! "Remove the process mark from GROUP and move point there. ! Return nil if the group isn't displayed." ! (if (gnus-group-goto-group group) ! (save-excursion ! (gnus-group-mark-group 1 'unmark t) ! t) ! (setq gnus-group-marked ! (delete group gnus-group-marked)) ! nil)) ! ! (defun gnus-group-set-mark (group) ! "Set the process mark on GROUP." ! (if (gnus-group-goto-group group) ! (save-excursion ! (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) ! (gnus-error 1 "Undefined key") ! (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) ! (save-excursion ! (while (and (> n 0) ! (setq group (gnus-group-group-name))) ! (setq groups (cons group groups)) ! (setq n (1- n)) ! (gnus-group-next-group way))) ! (nreverse groups))) ! ((and (boundp 'transient-mark-mode) ! transient-mark-mode ! (boundp 'mark-active) ! mark-active) ! ;; Work on the region between point and mark. ! (let ((max (max (point) (mark))) ! groups) ! (save-excursion ! (goto-char (min (point) (mark))) ! (while ! (and ! (push (gnus-group-group-name) groups) ! (zerop (gnus-group-next-group 1)) ! (< (point) max))) ! (nreverse groups)))) ! (gnus-group-marked ! ;; No prefix, but a list of marked articles. ! (reverse gnus-group-marked)) ! (t ! ;; Neither marked articles or a prefix, so we return the ! ;; current group. ! (let ((group (gnus-group-group-name))) ! (and group (list group)))))) ! ! ;; Selecting groups. ! ! (defun gnus-group-read-group (&optional all no-article group) ! "Read news in this newsgroup. ! 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))) ! number active marked entry) ! (or group (error "No group on current line")) ! (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash ! group gnus-newsrc-hashtb))))) ! ;; This group might be a dead group. In that case we have to get ! ;; the number of unread articles from `gnus-active-hashtb'. ! (setq number ! (cond ((numberp all) all) ! (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))) ! ! (defun gnus-group-select-group (&optional all) ! "Select this newsgroup. ! No article is selected automatically. ! If ALL is non-nil, already read articles become readable. ! If ALL is a number, fetch this number of articles." ! (interactive "P") ! (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 ! gnus-score-find-score-files-function ! gnus-apply-kill-hook ! gnus-summary-expunge-below) ! (gnus-group-read-group all t))) ! ! (defun gnus-group-visible-select-group (&optional all) ! "Select the current group without hiding any articles." ! (interactive "P") ! (let ((gnus-inhibit-limiting t)) ! (gnus-group-read-group all t))) ! ! ;;;###autoload ! (defun gnus-fetch-group (group) ! "Start Gnus if necessary and enter GROUP. ! Returns whether the fetching was successful or not." ! (interactive "sGroup name: ") ! (or (get-buffer gnus-group-buffer) ! (gnus)) ! (gnus-group-read-group nil nil group)) ! ! ;; 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 ! `(t nil (,group ,gnus-level-default-subscribed nil nil ,method ! ((quit-config . ,(if quit-config quit-config ! (cons (current-buffer) 'summary)))))) ! gnus-newsrc-hashtb) ! (set-buffer gnus-group-buffer) ! (or (gnus-check-server method) ! (error "Unable to contact server: %s" (gnus-status-message method))) ! (if activate (or (gnus-request-group group) ! (error "Couldn't request group"))) ! (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 ! (gnus-read-active-file-p) ! nil ! 'gnus-group-history))) ! ! (when (equal group "") ! (error "Empty group name")) ! ! (when (string-match "[\000-\032]" group) ! (error "Control characters in group: %s" group)) ! ! (let ((b (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) ! (unless (gnus-ephemeral-group-p group) ! (if b ! ;; Either go to the line in the group buffer... ! (goto-char b) ! ;; ... or insert the line. ! (or ! t ;; Don't activate group. ! (gnus-active group) ! (gnus-activate-group group) ! (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. ! (gnus-group-position-point))) ! ! (defun gnus-group-goto-group (group) ! "Goto to newsgroup GROUP." ! (when group ! ;; It's quite likely that we are on the right line, so ! ;; we check the current line first. ! (beginning-of-line) ! (if (eq (get-text-property (point) 'gnus-group) ! (gnus-intern-safe group gnus-active-hashtb)) ! (point) ! ;; Search through the entire buffer. ! (let ((b (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) ! (when b ! (goto-char b)))))) ! ! (defun gnus-group-next-group (n &optional silent) ! "Go to next N'th newsgroup. ! If N is negative, search backward instead. ! Returns the difference between N and the number of skips actually ! done." ! (interactive "p") ! (gnus-group-next-unread-group n t nil silent)) ! ! (defun gnus-group-next-unread-group (n &optional all level silent) ! "Go to next N'th unread newsgroup. ! If N is negative, search backward instead. ! If ALL is non-nil, choose any newsgroup, unread or not. ! If LEVEL is non-nil, choose the next group with level LEVEL, or, if no ! such group can be found, the next group with a level higher than ! LEVEL. ! Returns the difference between N and the number of skips actually ! made." ! (interactive "p") ! (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))) ! (when (and (/= 0 n) ! (not silent)) ! (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") ! (if level " on this level or higher" ""))) ! n)) ! ! (defun gnus-group-prev-group (n) ! "Go to previous N'th newsgroup. ! Returns the difference between N and the number of skips actually ! done." ! (interactive "p") ! (gnus-group-next-unread-group (- n) t)) ! ! (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))) ! ! (defun gnus-group-next-unread-group-same-level (n) ! "Go to next N'th unread newsgroup on the same level. ! If N is negative, search backward instead. ! Returns the difference between N and the number of skips actually ! done." ! (interactive "p") ! (gnus-group-next-unread-group n t (gnus-group-group-level)) ! (gnus-group-position-point)) ! ! (defun gnus-group-prev-unread-group-same-level (n) ! "Go to next N'th unread newsgroup on the same level. ! Returns the difference between N and the number of skips actually ! done." ! (interactive "p") ! (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) ! (gnus-group-position-point)) ! ! (defun gnus-group-best-unread-group (&optional exclude-group) ! "Go to the group with the highest level. ! If EXCLUDE-GROUP, do not go to that group." ! (interactive) ! (goto-char (point-min)) ! (let ((best 100000) ! unread best-point) ! (while (not (eobp)) ! (setq unread (get-text-property (point) 'gnus-unread)) ! (if (and (numberp unread) (> unread 0)) ! (progn ! (if (and (get-text-property (point) 'gnus-level) ! (< (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)) ! (if best-point (goto-char best-point)) ! (gnus-summary-position-point) ! (and best-point (gnus-group-group-name)))) ! ! (defun gnus-group-first-unread-group () ! "Go to the first group with unread articles." ! (interactive) ! (prog1 ! (let ((opoint (point)) ! unread) ! (goto-char (point-min)) ! (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. ! (and (numberp unread) ; Not a topic. ! (not (zerop unread))) ; Has unread articles. ! (zerop (gnus-group-next-unread-group 1))) ; Next unread group. ! (point) ; Success. ! (goto-char opoint) ! nil)) ; Not success. ! (gnus-group-position-point))) ! ! (defun gnus-group-enter-server-mode () ! "Jump to the server buffer." ! (interactive) ! (gnus-enter-server-buffer)) ! ! (defun gnus-group-make-group (name &optional method address) ! "Add a new newsgroup. ! 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 nil 'gnus-method-history))) ! (cond ! ((equal method "") ! (setq method gnus-select-method)) ! ((assoc method gnus-valid-select-methods) ! (list method ! (if (memq 'prompt-address ! (assoc method gnus-valid-select-methods)) ! (read-string "Address: ") ! ""))) ! ((assoc method gnus-server-alist) ! (list method)) ! (t ! (list method "")))))) ! ! (let* ((meth (when (and method ! (not (gnus-server-equal method gnus-select-method))) ! (if address (list (intern method) address) ! method))) ! (nname (if method (gnus-group-prefixed-name name meth) name)) ! backend info) ! (when (gnus-gethash nname gnus-newsrc-hashtb) ! (error "Group %s already exists" nname)) ! ;; Subscribe to the new group. ! (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) ! ;; Make it active. ! (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)) ")"))) ! ;; Insert the line. ! (gnus-group-insert-group-line-info nname) ! (forward-line -1) ! (gnus-group-position-point) ! ! ;; Load the backend and try to make the backend create ! ;; the group as well. ! (when (assoc (symbol-name (setq backend (car (gnus-server-get-method ! nil meth)))) ! gnus-valid-select-methods) ! (require backend)) ! (gnus-check-server meth) ! (and (gnus-check-backend-function 'request-create-group nname) ! (gnus-request-create-group nname)) ! t)) ! ! (defun gnus-group-delete-group (group &optional force) ! "Delete the current group. Only meaningful with mail groups. ! 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. The user will be prompted before ! doing the deletion." ! (interactive ! (list (gnus-group-group-name) ! current-prefix-arg)) ! (or group (error "No group to rename")) ! (or (gnus-check-backend-function 'request-delete-group group) ! (error "This backend does not support group deletion")) ! (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) ! (if (not (gnus-request-delete-group group force)) ! (gnus-error 3 "Couldn't delete group %s" group) ! (gnus-message 6 "Deleting group %s...done" group) ! (gnus-group-goto-group group) ! (gnus-group-kill-group 1 t) ! (gnus-sethash group nil gnus-active-hashtb) ! t)) ! (gnus-group-position-point))) ! ! (defun gnus-group-rename-group (group new-name) ! (interactive ! (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: ")))) ! ! (or (gnus-check-backend-function 'request-rename-group group) ! (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 ! (if (equal (gnus-group-real-name new-name) new-name) ! ;; Native group. ! new-name ! ;; Foreign group. ! (gnus-group-prefixed-name ! (gnus-group-real-name new-name) ! (gnus-info-method (gnus-get-info group))))) ! ! (gnus-message 6 "Renaming group %s to %s..." group new-name) ! (prog1 ! (if (not (gnus-request-rename-group group new-name)) ! (gnus-error 3 "Couldn't rename group %s to %s" group new-name) ! ;; We rename the group internally by killing it... ! (gnus-group-goto-group group) ! (gnus-group-kill-group) ! ;; ... changing its name ... ! (setcar (cdar 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) ! (gnus-group-position-point))) ! ! (defun gnus-group-edit-group (group &optional part) ! "Edit the group on the current line." ! (interactive (list (gnus-group-group-name))) ! (let* ((part (or part 'info)) ! (done-func `(lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-group-edit-group-done ',part ,group))) ! (winconf (current-window-configuration)) ! info) ! (or group (error "No group on current line")) ! (or (setq info (gnus-get-info group)) ! (error "Killed group; can't be edited")) ! (set-buffer (setq gnus-group-edit-buffer ! (get-buffer-create ! (format "*Gnus edit %s*" group)))) ! (gnus-configure-windows 'edit-group) ! (gnus-add-current-to-buffer-list) ! (emacs-lisp-mode) ! ;; Suggested by Hallvard B Furuseth . ! (use-local-map (copy-keymap emacs-lisp-mode-map)) ! (local-set-key "\C-c\C-c" done-func) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf) ! (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")) ! ((eq part 'params) ! (gnus-info-params info)) ! (t info))) ! "\n"))) ! ! (defun gnus-group-edit-group-method (group) ! "Edit the select method of GROUP." ! (interactive (list (gnus-group-group-name))) ! (gnus-group-edit-group group 'method)) ! ! (defun gnus-group-edit-group-parameters (group) ! "Edit the group parameters of GROUP." ! (interactive (list (gnus-group-group-name))) ! (gnus-group-edit-group group 'params)) ! ! (defun gnus-group-edit-group-done (part group) ! "Get info from buffer, update variables and jump to the group buffer." ! (when (and gnus-group-edit-buffer ! (buffer-name gnus-group-edit-buffer)) ! (set-buffer gnus-group-edit-buffer) ! (goto-char (point-min)) ! (let* ((form (read (current-buffer))) ! (winconf gnus-prev-winconf) ! (method (cond ((eq part 'info) (nth 4 form)) ! ((eq part 'method) form) ! (t nil))) ! (info (cond ((eq part 'info) form) ! ((eq part 'method) (gnus-get-info group)) ! (t nil))) ! (new-group (if info ! (if (or (not method) ! (gnus-server-equal ! gnus-select-method method)) ! (gnus-group-real-name (car info)) ! (gnus-group-prefixed-name ! (gnus-group-real-name (car info)) method)) ! nil))) ! (when (and new-group ! (not (equal new-group group))) ! (when (gnus-group-goto-group group) ! (gnus-group-kill-group 1)) ! (gnus-activate-group new-group)) ! ;; Set the info. ! (if (and info new-group) ! (progn ! (setq info (gnus-copy-sequence info)) ! (setcar info new-group) ! (unless (gnus-server-equal method "native") ! (unless (nthcdr 3 info) ! (nconc info (list nil nil))) ! (unless (nthcdr 4 info) ! (nconc info (list nil))) ! (gnus-info-set-method info method)) ! (gnus-group-set-info info)) ! (gnus-group-set-info form (or new-group group) part)) ! (kill-buffer (current-buffer)) ! (and winconf (set-window-configuration winconf)) ! (set-buffer gnus-group-buffer) ! (gnus-group-update-group (or new-group group)) ! (gnus-group-position-point)))) ! ! (defun gnus-group-make-help-group () ! "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) ! (gnus-message 1 "Couldn't find doc group") ! (gnus-group-make-group ! (gnus-group-real-name name) ! (list 'nndoc "gnus-help" ! (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) ! ((= char ?b) 'babyl) ! ((= char ?d) 'digest) ! ((= char ?f) 'forward) ! ((= char ?a) 'mmfd) ! (t (setq err (format "%c unknown. " char)) ! nil)))) ! (setq type found))) ! (let* ((file (expand-file-name file)) ! (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 (file-name-nondirectory file) ! (list 'nndoc-address file) ! (list 'nndoc-article-type (or type 'guess)))))) ! ! (defun gnus-group-make-archive-group (&optional all) ! "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 "")))) ! (when (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)))) ! (gnus-group-add-parameter group (cons 'to-address "ding@ifi.uio.no")))) ! ! (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: "))) ! (or (file-exists-p dir) (error "No such directory")) ! (or (file-directory-p dir) (error "Not a directory")) ! (let ((ext "") ! (i 0) ! 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 (gnus-group-real-name group) (list 'nndir-directory dir))))) ! ! (defun gnus-group-make-kiboze-group (group address scores) ! "Create an nnkiboze group. ! The user will be prompted for a name, a regexp to match groups, and ! score file entries for articles to include in the group." ! (interactive ! (list ! (read-string "nnkiboze group name: ") ! (read-string "Source groups (regexp): ") ! (let ((headers (mapcar (lambda (group) (list group)) ! '("subject" "from" "number" "date" "message-id" ! "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))) ! (setq scores (cons (cons header regexps) scores))) ! scores))) ! (gnus-group-make-group group "nnkiboze" address) ! (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) ! (let (emacs-lisp-mode-hook) ! (pp scores (current-buffer))))) ! ! (defun gnus-group-add-to-virtual (n vgroup) ! "Add the current group to a virtual group." ! (interactive ! (list current-prefix-arg ! (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t ! "nnvirtual:"))) ! (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) ! (error "%s is not an nnvirtual group" vgroup)) ! (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 "\\|")))) ! (gnus-group-position-point)) ! ! (defun gnus-group-make-empty-virtual (group) ! "Create a new, fresh, empty virtual group." ! (interactive "sCreate new, empty virtual group: ") ! (let* ((method (list 'nnvirtual "^$")) ! (pgroup (gnus-group-prefixed-name group method))) ! ;; Check whether it exists already. ! (and (gnus-gethash pgroup gnus-newsrc-hashtb) ! (error "Group %s already exists." pgroup)) ! ;; Subscribe the new group after the group on the current line. ! (gnus-subscribe-group pgroup (gnus-group-group-name) method) ! (gnus-group-update-group pgroup) ! (forward-line -1) ! (gnus-group-position-point))) ! ! (defun gnus-group-enter-directory (dir) ! "Enter an ephemeral nneething group." ! (interactive "DDirectory to read: ") ! (let* ((method (list 'nneething dir)) ! (leaf (gnus-group-prefixed-name ! (file-name-nondirectory (directory-file-name dir)) ! 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))) ! (error "Couldn't enter %s" dir))))) ! ! ;; Group sorting commands ! ;; Suggested by Joe Hildebrand . ! ! (defun gnus-group-sort-groups (func &optional reverse) ! "Sort the group buffer according to FUNC. ! If REVERSE, reverse the sorting order." ! (interactive (list gnus-group-sort-function ! current-prefix-arg)) ! (let ((func (cond ! ((not (listp func)) func) ! ((null 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 func ! (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. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) ! ! (defun gnus-group-sort-groups-by-unread (&optional reverse) ! "Sort the group buffer by number of unread articles. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) ! ! (defun gnus-group-sort-groups-by-level (&optional reverse) ! "Sort the group buffer by group level. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) ! ! (defun gnus-group-sort-groups-by-score (&optional reverse) ! "Sort the group buffer by group score. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) ! ! (defun gnus-group-sort-groups-by-rank (&optional reverse) ! "Sort the group buffer by group rank. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) ! ! (defun gnus-group-sort-groups-by-method (&optional reverse) ! "Sort the group buffer alphabetically by backend name. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) ! ! (defun gnus-group-sort-by-alphabet (info1 info2) ! "Sort alphabetically." ! (string< (gnus-info-group info1) (gnus-info-group info2))) ! ! (defun gnus-group-sort-by-unread (info1 info2) ! "Sort by number of unread articles." ! (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) ! (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) ! (< (or (and (numberp n1) n1) 0) ! (or (and (numberp n2) n2) 0)))) ! ! (defun gnus-group-sort-by-level (info1 info2) ! "Sort by level." ! (< (gnus-info-level info1) (gnus-info-level info2))) ! ! (defun gnus-group-sort-by-method (info1 info2) ! "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) ! "Sort by group score." ! (< (gnus-info-score info1) (gnus-info-score info2))) ! ! (defun gnus-group-sort-by-rank (info1 info2) ! "Sort by level and score." ! (let ((level1 (gnus-info-level info1)) ! (level2 (gnus-info-level info2))) ! (or (< level1 level2) ! (and (= level1 level2) ! (> (gnus-info-score info1) (gnus-info-score info2)))))) ! ! ;; Group catching up. ! ! (defun gnus-group-clear-data (n) ! "Clear all marks and read ranges from the current group." ! (interactive "P") ! (let ((groups (gnus-group-process-prefix n)) ! group info) ! (while (setq group (pop groups)) ! (setq info (gnus-get-info group)) ! (gnus-info-set-read info nil) ! (when (gnus-info-marks info) ! (gnus-info-set-marks info nil)) ! (gnus-get-unread-articles-in-group info (gnus-active group) t) ! (when (gnus-group-goto-group group) ! (gnus-group-remove-mark group) ! (gnus-group-update-group-line))))) ! ! (defun gnus-group-catchup-current (&optional n all) ! "Mark all articles not marked as unread in current newsgroup as read. ! If prefix argument N is numeric, the ARG next newsgroups will be ! caught up. If ALL is non-nil, marked articles will also be marked as ! read. Cross references (Xref: header) of articles are ignored. ! The difference between N and actual number of newsgroups that were ! caught up is returned." ! (interactive "P") ! (unless (gnus-group-group-name) ! (error "No group on the current line")) ! (if (not (or (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (if all ! "Do you really want to mark all articles as read? " ! "Mark all unread articles as read? ")))) ! n ! (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 ! (gnus-group-real-name (car groups)) (nth 1 method) all))) ! (gnus-group-remove-mark (car groups)) ! (if (>= (gnus-group-group-level) gnus-level-zombie) ! (gnus-message 2 "Dead groups can't be caught up") ! (if (prog1 ! (gnus-group-goto-group (car groups)) ! (gnus-group-catchup (car groups) all)) ! (gnus-group-update-group-line) ! (setq ret (1+ ret)))) ! (setq groups (cdr groups))) ! (gnus-group-next-unread-group 1) ! ret))) ! ! (defun gnus-group-catchup-current-all (&optional n) ! "Mark all articles in current newsgroup as read. ! Cross references (Xref: header) of articles are ignored." ! (interactive "P") ! (gnus-group-catchup-current n 'all)) ! ! (defun gnus-group-catchup (group &optional all) ! "Mark all articles in GROUP as read. ! If ALL is non-nil, all articles are marked as read. ! The return value is the number of articles that were marked as read, ! or nil if no action could be taken." ! (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) ! (num (car entry))) ! ;; Do the updating only if the newsgroup isn't killed. ! (if (not (numberp (car entry))) ! (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)) ! (run-hooks 'gnus-group-catchup-group-hook) ! num)))) ! ! (defun gnus-group-expire-articles (&optional n) ! "Expire all expirable articles in the current newsgroup." ! (interactive "P") ! (let ((groups (gnus-group-process-prefix n)) ! 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) ! (let* ((info (gnus-get-info group)) ! (expirable (if (gnus-group-total-expirable-p group) ! (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 ! ;; We set the expiry variables to the groupp ! ;; parameter. ! (let ((nnmail-expiry-wait-function nil) ! (nnmail-expiry-wait expiry-wait)) ! (gnus-request-expire-articles ! (gnus-uncompress-sequence (cdr expirable)) group)) ! ;; Just expire using the normal expiry values. ! (gnus-request-expire-articles ! (gnus-uncompress-sequence (cdr expirable)) group)))) ! (gnus-close-group group)) ! (gnus-message 6 "Expiring articles in %s...done" group))) ! (gnus-group-position-point)))) ! ! (defun gnus-group-expire-all-groups () ! "Expire all expirable articles in all newsgroups." ! (interactive) ! (save-excursion ! (gnus-message 5 "Expiring...") ! (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) ! (cdr gnus-newsrc-alist)))) ! (gnus-group-expire-articles nil))) ! (gnus-group-position-point) ! (gnus-message 5 "Expiring...done")) ! ! (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): " ! (or (gnus-group-group-level) ! gnus-level-default-subscribed))))) ! (if (string-match "^\\s-*$" s) ! (int-to-string (or (gnus-group-group-level) ! gnus-level-default-subscribed)) ! s))))) ! (or (and (>= level 1) (<= level gnus-level-killed)) ! (error "Illegal level: %d" level)) ! (let ((groups (gnus-group-process-prefix n)) ! group) ! (while (setq group (pop 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)) ! ! (defun gnus-group-unsubscribe-current-group (&optional n) ! "Toggle subscription of the current group. ! If given numerical prefix, toggle the N next groups." ! (interactive "P") ! (let ((groups (gnus-group-process-prefix n)) ! group) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (gnus-group-remove-mark group) ! (gnus-group-unsubscribe-group ! group (if (<= (gnus-group-group-level) gnus-level-subscribed) ! gnus-level-default-unsubscribed ! gnus-level-default-subscribed) t) ! (gnus-group-update-group-line)) ! (gnus-group-next-group 1))) ! ! (defun gnus-group-unsubscribe-group (group &optional level silent) ! "Toggle subscription to GROUP. ! Killed newsgroups are subscribed. If SILENT, don't try to update the ! group line." ! (interactive ! (list (completing-read ! "Group: " gnus-active-hashtb nil ! (gnus-read-active-file-p) ! nil ! 'gnus-group-history))) ! (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) ! (cond ! ((string-match "^[ \t]$" group) ! (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 ! (gnus-group-update-group group))) ! ((and (stringp group) ! (or (not (gnus-read-active-file-p)) ! (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))) ! (unless silent ! (gnus-group-update-group group))) ! (t (error "No such newsgroup: %s" group))) ! (gnus-group-position-point))) ! ! (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")) ! (gnus-group-kill-group 1) ! (prog1 ! (forward-line (- n)) ! (gnus-group-yank-group) ! (gnus-group-position-point))) ! ! (defun gnus-group-kill-all-zombies () ! "Kill all zombie newsgroups." ! (interactive) ! (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) ! (setq gnus-zombie-list nil) ! (gnus-group-list-groups)) ! ! (defun gnus-group-kill-region (begin end) ! "Kill newsgroups in current region (excluding current point). ! The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." ! (interactive "r") ! (let ((lines ! ;; Count lines. ! (save-excursion ! (count-lines ! (progn ! (goto-char begin) ! (beginning-of-line) ! (point)) ! (progn ! (goto-char end) ! (beginning-of-line) ! (point)))))) ! (goto-char begin) ! (beginning-of-line) ;Important when LINES < 1 ! (gnus-group-kill-group lines))) ! ! (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." ! (interactive "P") ! (let ((buffer-read-only nil) ! (groups (gnus-group-process-prefix n)) ! group entry level out) ! (if (< (length groups) 10) ! ;; This is faster when there are few groups. ! (while groups ! (push (setq group (pop groups)) out) ! (gnus-group-remove-mark group) ! (setq level (gnus-group-group-level)) ! (gnus-delete-line) ! (when (and (not discard) ! (setq entry (gnus-gethash group gnus-newsrc-hashtb))) ! (push (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. ! (let (entry) ! (setq groups (nreverse groups)) ! (while groups ! (gnus-group-remove-mark (setq group (pop groups))) ! (gnus-delete-line) ! (push group gnus-killed-list) ! (setq gnus-newsrc-alist ! (delq (assoc group gnus-newsrc-alist) ! gnus-newsrc-alist)) ! (when gnus-group-change-level-function ! (funcall gnus-group-change-level-function group 9 3)) ! (cond ! ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) ! (push (cons (car entry) (nth 2 entry)) ! gnus-list-of-killed-groups) ! (setcdr (cdr entry) (cdddr entry))) ! ((member group gnus-zombie-list) ! (setq gnus-zombie-list (delete group gnus-zombie-list))))) ! (gnus-make-hashtable-from-newsrc-alist))) ! ! (gnus-group-position-point) ! (if (< (length out) 2) (car out) (nreverse out)))) ! ! (defun gnus-group-yank-group (&optional arg) ! "Yank the last newsgroups killed with \\[gnus-group-kill-group], ! inserting it before the current newsgroup. The numeric ARG specifies ! how many newsgroups are to be yanked. The name of the newsgroup yanked ! is returned, or (if several groups are yanked) a list of yanked groups ! is returned." ! (interactive "p") ! (setq arg (or arg 1)) ! (let (info group prev out) ! (while (>= (decf arg) 0) ! (if (not (setq info (pop gnus-list-of-killed-groups))) ! (error "No more newsgroups to yank")) ! (push (setq group (nth 1 info)) out) ! ;; Find which newsgroup to insert this one before - search ! ;; backward until something suitable is found. If there are no ! ;; other newsgroups in this buffer, just make this newsgroup the ! ;; first newsgroup. ! (setq prev (gnus-group-group-name)) ! (gnus-group-change-level ! info (gnus-info-level (cdr info)) gnus-level-killed ! (and prev (gnus-gethash prev gnus-newsrc-hashtb)) ! t) ! (gnus-group-insert-group-line-info group)) ! (forward-line -1) ! (gnus-group-position-point) ! (if (< (length out) 2) (car out) (nreverse out)))) ! ! (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)) ! (setq gnus-zombie-list nil)) ! ((and (< level gnus-level-zombie) ! (> 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) ! (alist (cdr prev))) ! (while alist ! (if (= (gnus-info-level (car alist)) level) ! (progn ! (push (gnus-info-group (car alist)) gnus-killed-list) ! (setcdr prev (cdr alist))) ! (setq prev alist)) ! (setq alist (cdr alist))) ! (gnus-make-hashtable-from-newsrc-alist) ! (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 ! unsubscribed groups." ! (interactive "P") ! (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) ! ! ;; Redefine this to list ALL killed groups if prefix arg used. ! ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). ! (defun gnus-group-list-killed (&optional arg) ! "List all killed newsgroups in the group buffer. ! If ARG is non-nil, list ALL killed groups known to Gnus. This may ! entail asking the server for the groups." ! (interactive "P") ! ;; Find all possible killed newsgroups if arg. ! (when arg ! (gnus-get-killed-groups)) ! (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)) ! ! (defun gnus-group-list-zombies () ! "List all zombie newsgroups in the group buffer." ! (interactive) ! (if (not gnus-zombie-list) ! (gnus-message 6 "No zombie groups") ! (let (gnus-group-list-mode) ! (funcall gnus-group-prepare-function ! gnus-level-zombie t gnus-level-zombie)) ! (goto-char (point-min))) ! (gnus-group-position-point)) ! ! (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-read-active-file-p) ! (let ((gnus-read-active-file t)) ! (gnus-read-active-file))) ! ;; Find all groups and sort them. ! (let ((groups ! (sort ! (let (list) ! (mapatoms ! (lambda (sym) ! (and (boundp sym) ! (symbol-value sym) ! (setq list (cons (symbol-name sym) list)))) ! gnus-active-hashtb) ! list) ! 'string<)) ! (buffer-read-only nil)) ! (erase-buffer) ! (while groups ! (gnus-group-insert-group-line-info (pop groups))) ! (goto-char (point-min)))) ! ! (defun gnus-activate-all-groups (level) ! "Activate absolutely all groups." ! (interactive (list 7)) ! (let ((gnus-activate-level level) ! (gnus-activate-foreign-newsgroups level)) ! (gnus-group-get-new-news))) ! ! (defun gnus-group-get-new-news (&optional arg) ! "Get newly arrived articles. ! If ARG is a number, it specifies which levels you are interested in ! re-scanning. If ARG is non-nil and not a number, this will force ! \"hard\" re-reading of the active files from all servers." ! (interactive "P") ! (run-hooks 'gnus-get-new-news-hook) ! ;; We might read in new NoCeM messages here. ! (when (and gnus-use-nocem ! (null arg)) ! (gnus-nocem-scan-groups)) ! ;; If ARG is not a number, then we read the active file. ! (when (and arg (not (numberp arg))) ! (let ((gnus-read-active-file t)) ! (gnus-read-active-file)) ! (setq arg nil)) ! ! (setq arg (gnus-group-default-level arg t)) ! (if (and gnus-read-active-file (not arg)) ! (progn ! (gnus-read-active-file) ! (gnus-get-unread-articles arg)) ! (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) ! (gnus-get-unread-articles arg))) ! (run-hooks 'gnus-after-getting-new-news-hook) ! (gnus-group-list-groups)) ! ! (defun gnus-group-get-new-news-this-group (&optional n) ! "Check for newly arrived news in the current group (and the N-1 next groups). ! The difference between N and the number of newsgroup checked is returned. ! If N is negative, this group and the N-1 previous groups will be checked." ! (interactive "P") ! (let* ((groups (gnus-group-process-prefix n)) ! (ret (if (numberp n) (- n (length groups)) 0)) ! (beg (unless n (point))) ! group) ! (while (setq group (pop groups)) ! (gnus-group-remove-mark group) ! (if (gnus-activate-group group 'scan) ! (progn ! (gnus-get-unread-articles-in-group ! (gnus-get-info group) (gnus-active group) t) ! (unless (gnus-virtual-group-p group) ! (gnus-close-group group)) ! (gnus-group-update-group group)) ! (if (eq (gnus-server-status (gnus-find-method-for-group group)) ! 'denied) ! (gnus-error "Server denied access") ! (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) ! (when beg (goto-char beg)) ! (when gnus-goto-next-group-when-activating ! (gnus-group-next-unread-group 1 t)) ! (gnus-summary-position-point) ! ret)) ! ! (defun gnus-group-fetch-faq (group &optional faq-dir) ! "Fetch the FAQ for the current group." ! (interactive ! (list ! (and (gnus-group-group-name) ! (gnus-group-real-name (gnus-group-group-name))) ! (cond (current-prefix-arg ! (completing-read ! "Faq dir: " (and (listp gnus-group-faq-directory) ! (mapcar (lambda (file) (list file)) ! 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))) ! (let* ((method (gnus-find-method-for-group group)) ! (mname (gnus-group-prefixed-name "" method)) ! desc) ! (when (and force ! gnus-description-hashtb) ! (gnus-sethash mname nil gnus-description-hashtb)) ! (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 mname gnus-description-hashtb)) ! (setq desc (gnus-group-get-description group)) ! (gnus-read-descriptions-file method)) ! (gnus-message 1 ! (or desc (gnus-gethash group gnus-description-hashtb) ! "No description available"))))) ! ! ;; Suggested by Per Abrahamsen . ! (defun gnus-group-describe-all-groups (&optional force) ! "Pop up a buffer with descriptions of all newsgroups." ! (interactive "P") ! (and force (setq gnus-description-hashtb nil)) ! (if (not (or gnus-description-hashtb ! (gnus-read-all-descriptions-files))) ! (error "Couldn't request descriptions file")) ! (let ((buffer-read-only nil) ! b) ! (erase-buffer) ! (mapatoms ! (lambda (group) ! (setq b (point)) ! (insert (format " *: %-20s %s\n" (symbol-name group) ! (symbol-value group))) ! (gnus-add-text-properties ! b (1+ b) (list 'gnus-group group ! 'gnus-unread t 'gnus-marked nil ! 'gnus-level (1+ gnus-level-subscribed)))) ! gnus-description-hashtb) ! (goto-char (point-min)) ! (gnus-group-position-point))) ! ! ;; Suggested by Daniel Quinlan . ! (defun gnus-group-apropos (regexp &optional search-description) ! "List all newsgroups that have names that match a regexp." ! (interactive "sGnus apropos (regexp): ") ! (let ((prev "") ! (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) ! ;; Also go through all descriptions that are known to Gnus. ! (when search-description ! (mapatoms ! (lambda (group) ! (and (string-match regexp (symbol-value group)) ! (gnus-active (symbol-name group)) ! (setq groups (cons (symbol-name group) groups)))) ! gnus-description-hashtb)) ! (if (not groups) ! (gnus-message 3 "No groups matched \"%s\"." regexp) ! ;; Print out all the groups. ! (save-excursion ! (pop-to-buffer "*Gnus Help*") ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (setq groups (sort groups 'string<)) ! (while groups ! ;; Groups may be entered twice into the list of groups. ! (if (not (string= (car groups) prev)) ! (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))) ! (goto-char (point-min)))) ! (pop-to-buffer obuf))) ! ! (defun gnus-group-description-apropos (regexp) ! "List all newsgroups that have names or descriptions that match a regexp." ! (interactive "sGnus description apropos (regexp): ") ! (if (not (or gnus-description-hashtb ! (gnus-read-all-descriptions-files))) ! (error "Couldn't request descriptions file")) ! (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. ! ! This command may read the active file." ! (interactive "P\nsList newsgroups matching: ") ! ;; First make sure active file has been read. ! (when (and level ! (> (prefix-numeric-value level) gnus-level-killed)) ! (gnus-get-killed-groups)) ! (gnus-group-prepare-flat (or level gnus-level-subscribed) ! all (or lowest 1) regexp) ! (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)) ! ! ;; Suggested by Jack Vinson . ! (defun gnus-group-save-newsrc (&optional force) ! "Save the Gnus startup files. ! If FORCE, force saving whether it is necessary or not." ! (interactive "P") ! (gnus-save-newsrc-file force)) ! ! (defun gnus-group-restart (&optional arg) ! "Force Gnus to read the .newsrc file." ! (interactive "P") ! (when (gnus-yes-or-no-p ! (format "Are you sure you want to read %s? " ! gnus-current-startup-file)) ! (gnus-save-newsrc-file) ! (gnus-setup-news 'force) ! (gnus-group-list-groups arg))) ! ! (defun gnus-group-read-init-file () ! "Read the Gnus elisp init file." ! (interactive) ! (gnus-read-init-file)) ! ! (defun gnus-group-check-bogus-groups (&optional silent) ! "Check bogus newsgroups. ! If given a prefix, don't ask for confirmation before removing a bogus ! group." ! (interactive "P") ! (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) ! (gnus-group-list-groups)) ! ! (defun gnus-group-edit-global-kill (&optional article group) ! "Edit the global kill file. ! If GROUP, edit that local kill file instead." ! (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)" ! (if group "local" "global"))))) ! ! (defun gnus-group-edit-local-kill (article group) ! "Edit a local kill file." ! (interactive (list nil (gnus-group-group-name))) ! (gnus-group-edit-global-kill article group)) ! ! (defun gnus-group-force-update () ! "Update `.newsrc' file." ! (interactive) ! (gnus-save-newsrc-file)) ! ! (defun gnus-group-suspend () ! "Suspend the current Gnus session. ! In fact, cleanup buffers except for group mode buffer. ! The hook gnus-suspend-gnus-hook is called before actually suspending." ! (interactive) ! (run-hooks 'gnus-suspend-gnus-hook) ! ;; Kill Gnus buffers except for group mode buffer. ! (let* ((group-buf (get-buffer gnus-group-buffer)) ! ;; Do this on a separate list in case the user does a ^G before we finish ! (gnus-buffer-list ! (delete group-buf (delete gnus-dribble-buffer ! (append gnus-buffer-list nil))))) ! (while gnus-buffer-list ! (gnus-kill-buffer (pop gnus-buffer-list))) ! (gnus-kill-gnus-frames) ! (when group-buf ! (setq gnus-buffer-list (list group-buf)) ! (bury-buffer group-buf) ! (delete-windows-on group-buf t)))) ! ! (defun gnus-group-clear-dribble () ! "Clear all information from the dribble buffer." ! (interactive) ! (gnus-dribble-clear) ! (gnus-message 7 "Cleared dribble buffer")) ! ! (defun gnus-group-exit () ! "Quit reading news after updating .newsrc.eld and .newsrc. ! The hook `gnus-exit-gnus-hook' is called before actually exiting." ! (interactive) ! (when ! (or noninteractive ;For gnus-batch-kill ! (not gnus-interactive-exit) ;Without confirmation ! gnus-expert-user ! (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) ! (run-hooks 'gnus-exit-gnus-hook) ! ;; Offer to save data from non-quitted summary buffers. ! (gnus-offer-save-summaries) ! ;; Save the newsrc file(s). ! (gnus-save-newsrc-file) ! ;; Kill-em-all. ! (gnus-close-backends) ! ;; Reset everything. ! (gnus-clear-system) ! ;; Allow the user to do things after cleaning up. ! (run-hooks 'gnus-after-exiting-gnus-hook))) ! ! (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 ! (if (fboundp (setq func (intern (concat (caar methods) ! "-request-close")))) ! (funcall func)) ! (setq methods (cdr methods))))) ! ! (defun gnus-group-quit () ! "Quit reading news without updating .newsrc.eld or .newsrc. ! The hook `gnus-exit-gnus-hook' is called before actually exiting." ! (interactive) ! (when (or noninteractive ;For gnus-batch-kill ! (zerop (buffer-size)) ! (not (gnus-server-opened gnus-select-method)) ! gnus-expert-user ! (not gnus-current-startup-file) ! (gnus-yes-or-no-p ! (format "Quit reading news without saving %s? " ! (file-name-nondirectory gnus-current-startup-file)))) ! (run-hooks 'gnus-exit-gnus-hook) ! (if gnus-use-full-window ! (delete-other-windows) ! (gnus-remove-some-windows)) ! (gnus-dribble-save) ! (gnus-close-backends) ! (gnus-clear-system) ! ;; Allow the user to do things after cleaning up. ! (run-hooks 'gnus-after-exiting-gnus-hook))) ! ! (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 ! (and (setq bufname (buffer-name (car buflist))) ! (string-match "Summary" bufname) ! (save-excursion ! (set-buffer bufname) ! ;; We check that this is, indeed, a summary buffer. ! (and (eq major-mode 'gnus-summary-mode) ! ;; Also make sure this isn't bogus. ! gnus-newsgroup-prepared)) ! (push bufname buffers)) ! (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))))) ! ! (defun gnus-group-describe-briefly () ! "Give a one line description of the group mode commands." ! (interactive) ! (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) ! ! (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) 'gnus-method-history))) ! ;; 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. ! (gnus-server-to-method how))))) ! (gnus-browse-foreign-server method)) ! ! ! ;;; ! ;;; 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 ! [delete] 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-article-hide-headers ! "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 ! "\C-c\C-b" gnus-bug ! "*" gnus-cache-enter-article ! "\M-*" gnus-cache-remove-article ! "\M-&" gnus-summary-universal-argument ! "\C-l" gnus-recenter ! "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 ! "j" gnus-summary-goto-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 ! "^" gnus-summary-reparent-thread ! "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 ! [delete] 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-article-hide-headers ! "v" gnus-summary-verbose-headers ! "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 ! "P" gnus-article-hide-pem ! "\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 ! [delete] 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) ! ) ! ! ! ! (defun gnus-summary-mode (&optional group) ! "Major mode for reading articles. ! ! All normal editing commands are switched off. ! \\ ! 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: ! ! \\{gnus-summary-mode-map}" ! (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'summary-menu 'menu)) ! (gnus-summary-make-menu-bar)) ! (kill-all-local-variables) ! (gnus-summary-make-local-variables) ! (gnus-make-thread-indent-array) ! (gnus-simplify-mode-line) ! (setq major-mode 'gnus-summary-mode) ! (setq mode-name "Summary") ! (make-local-variable 'minor-mode-alist) ! (use-local-map gnus-summary-mode-map) ! (buffer-disable-undo (current-buffer)) ! (setq buffer-read-only t) ;Disable modification ! (setq truncate-lines t) ! (setq selective-display t) ! (setq selective-display-ellipses t) ;Display `...' ! (setq buffer-display-table gnus-summary-display-table) ! (setq gnus-newsgroup-name group) ! (make-local-variable 'gnus-summary-line-format) ! (make-local-variable 'gnus-summary-line-format-spec) ! (make-local-variable 'gnus-summary-mark-positions) ! (gnus-make-local-hook 'post-command-hook) ! (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) ! (run-hooks 'gnus-summary-mode-hook)) ! ! (defun gnus-summary-make-local-variables () ! "Make all the local summary buffer variables." ! (let ((locals gnus-summary-local-variables) ! global local) ! (while (setq local (pop locals)) ! (if (consp local) ! (progn ! (if (eq (cdr local) 'global) ! ;; Copy the global value of the variable. ! (setq global (symbol-value (car local))) ! ;; Use the value from the list. ! (setq global (eval (cdr local)))) ! (make-local-variable (car local)) ! (set (car local) global)) ! ;; Simple nil-valued local variable. ! (make-local-variable local) ! (set local nil))))) ! ! (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... ! (let ((i 32)) ! (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 () ! (let ((locals gnus-summary-local-variables)) ! (while locals ! (if (consp (car locals)) ! (and (vectorp (caar locals)) ! (set (caar locals) nil)) ! (and (vectorp (car locals)) ! (set (car locals) nil))) ! (setq locals (cdr locals))))) ! ! ;; Summary data functions. ! ! (defmacro gnus-data-number (data) ! `(car ,data)) ! ! (defmacro gnus-data-set-number (data number) ! `(setcar ,data ,number)) ! ! (defmacro gnus-data-mark (data) ! `(nth 1 ,data)) ! ! (defmacro gnus-data-set-mark (data mark) ! `(setcar (nthcdr 1 ,data) ,mark)) ! ! (defmacro gnus-data-pos (data) ! `(nth 2 ,data)) ! ! (defmacro gnus-data-set-pos (data pos) ! `(setcar (nthcdr 2 ,data) ,pos)) ! ! (defmacro gnus-data-header (data) ! `(nth 3 ,data)) ! ! (defmacro gnus-data-level (data) ! `(nth 4 ,data)) ! ! (defmacro gnus-data-unread-p (data) ! `(= (nth 1 ,data) gnus-unread-mark)) ! ! (defmacro gnus-data-pseudo-p (data) ! `(consp (nth 3 ,data))) ! ! (defmacro gnus-data-find (number) ! `(assq ,number gnus-newsgroup-data)) ! ! (defmacro gnus-data-find-list (number &optional data) ! `(let ((bdata ,(or data 'gnus-newsgroup-data))) ! (memq (assq ,number bdata) ! bdata))) ! ! (defmacro gnus-data-make (number mark pos header level) ! `(list ,number ,mark ,pos ,header ,level)) ! ! (defun gnus-data-enter (after-article number mark pos header level offset) ! (let ((data (gnus-data-find-list after-article))) ! (or data (error "No such article: %d" after-article)) ! (setcdr data (cons (gnus-data-make number mark pos header level) ! (cdr data))) ! (setq gnus-newsgroup-data-reverse nil) ! (gnus-data-update-list (cddr data) offset))) ! ! (defun gnus-data-enter-list (after-article list &optional offset) ! (when list ! (let ((data (and after-article (gnus-data-find-list after-article))) ! (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) ! (progn ! (setcdr list gnus-newsgroup-data) ! (setq gnus-newsgroup-data ilist) ! (and offset (gnus-data-update-list (cdr list) offset))) ! (setcdr list (cdr data)) ! (setcdr data ilist) ! (and offset (gnus-data-update-list (cdr data) offset))) ! (setq gnus-newsgroup-data-reverse nil)))) ! ! (defun gnus-data-remove (article &optional offset) ! (let ((data gnus-newsgroup-data)) ! (if (= (gnus-data-number (car data)) article) ! (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) ! gnus-newsgroup-data-reverse nil) ! (while (cdr data) ! (and (= (gnus-data-number (cadr data)) article) ! (progn ! (setcdr data (cddr data)) ! (and offset (gnus-data-update-list (cdr data) offset)) ! (setq data nil ! gnus-newsgroup-data-reverse nil))) ! (setq data (cdr data)))))) ! ! (defmacro gnus-data-list (backward) ! `(if ,backward ! (or gnus-newsgroup-data-reverse ! (setq gnus-newsgroup-data-reverse ! (reverse gnus-newsgroup-data))) ! gnus-newsgroup-data)) ! ! (defun gnus-data-update-list (data offset) ! "Add OFFSET to the POS of all data entries in DATA." ! (while data ! (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) ! (setq data (cdr data)))) ! ! (defun gnus-data-compute-positions () ! "Compute the positions of all articles." ! (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))) ! (setq data (cdr data))))) ! ! (defun gnus-summary-article-pseudo-p (article) ! "Say whether this article is a pseudo article or not." ! (not (vectorp (gnus-data-header (gnus-data-find article))))) ! ! (defun gnus-article-parent-p (number) ! "Say whether this article is a parent or not." ! (let ((data (gnus-data-find-list number))) ! (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)))))) ! ! (defun gnus-article-children (number) ! "Return a list of all children to NUMBER." ! (let* ((data (gnus-data-find-list number)) ! (level (gnus-data-level (car data))) ! children) ! (setq data (cdr data)) ! (while (and data ! (= (gnus-data-level (car data)) (1+ level))) ! (push (gnus-data-number (car data)) children) ! (setq data (cdr data))) ! children)) ! ! (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))) ! (and to (gnus-summary-goto-subject to)))) ! ! (defmacro gnus-summary-article-intangible-p () ! "Say whether this article is intangible or not." ! '(get-text-property (point) 'gnus-intangible)) ! ! ;; Some summary mode macros. ! ! (defmacro gnus-summary-article-number () ! "The article number of the article on the current line. ! If there isn's an article number here, then we return the current ! 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) ! `(gnus-data-header (gnus-data-find ! ,(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 ! ,(or number '(gnus-summary-article-number))))) ! ! (defmacro gnus-summary-article-pos (&optional number) ! `(gnus-data-pos (gnus-data-find ! ,(or number '(gnus-summary-article-number))))) ! ! (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) ! (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) ! gnus-newsgroup-data))))) ! (and headers ! (vectorp headers) ! (mail-header-subject headers)))) ! ! (defmacro gnus-summary-article-score (&optional number) ! "Return current article score." ! `(or (cdr (assq ,(or number '(gnus-summary-article-number)) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0)) ! ! (defun gnus-summary-article-children (&optional number) ! (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) ! (level (gnus-data-level (car data))) ! l children) ! (while (and (setq data (cdr data)) ! (> (setq l (gnus-data-level (car data))) level)) ! (and (= (1+ level) l) ! (setq children (cons (gnus-data-number (car data)) ! children)))) ! (nreverse children))) ! ! (defun gnus-summary-article-parent (&optional number) ! (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) ! (gnus-data-list t))) ! (level (gnus-data-level (car data)))) ! (if (zerop level) ! () ; This is a root. ! ;; We search until we find an article with a level less than ! ;; this one. That function has to be the parent. ! (while (and (setq data (cdr data)) ! (not (< (gnus-data-level (car data)) level)))) ! (and data (gnus-data-number (car data)))))) ! ! (defun gnus-unread-mark-p (mark) ! "Say whether MARK is the unread mark." ! (= mark gnus-unread-mark)) ! ! (defun gnus-read-mark-p (mark) ! "Say whether MARK is one of the marks that mark as read. ! This is all marks except unread, ticked, dormant, and expirable." ! (not (or (= mark gnus-unread-mark) ! (= mark gnus-ticked-mark) ! (= mark gnus-dormant-mark) ! (= mark gnus-expirable-mark)))) ! ! ;; Saving hidden threads. ! ! (put 'gnus-save-hidden-threads 'lisp-indent-function 0) ! (put 'gnus-save-hidden-threads 'lisp-indent-hook 0) ! (put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) ! ! (defmacro gnus-save-hidden-threads (&rest forms) ! "Save hidden threads, eval FORMS, and restore the hidden threads." ! (let ((config (make-symbol "config"))) ! `(let ((,config (gnus-hidden-threads-configuration))) ! (unwind-protect ! (progn ! ,@forms) ! (gnus-restore-hidden-threads-configuration ,config))))) ! ! (defun gnus-hidden-threads-configuration () ! "Return the current hidden threads configuration." ! (save-excursion ! (let (config) ! (goto-char (point-min)) ! (while (search-forward "\r" nil t) ! (push (1- (point)) config)) ! config))) ! ! (defun gnus-restore-hidden-threads-configuration (config) ! "Restore hidden threads configuration from CONFIG." ! (let (point buffer-read-only) ! (while (setq point (pop config)) ! (when (and (< point (point-max)) ! (goto-char point) ! (= (following-char) ?\n)) ! (subst-char-in-region point (1+ point) ?\n ?\r))))) ! ! ;; Various summary mode internalish functions. ! ! (defun gnus-mouse-pick-article (e) ! (interactive "e") ! (mouse-set-point e) ! (gnus-summary-next-page nil t)) ! ! (defun gnus-summary-setup-buffer (group) ! "Initialize summary buffer." ! (let ((buffer (concat "*Summary " group "*"))) ! (if (get-buffer buffer) ! (progn ! (set-buffer buffer) ! (setq gnus-summary-buffer (current-buffer)) ! (not gnus-newsgroup-prepared)) ! ;; Fix by Sudish Joseph ! (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-article-current) ! (make-local-variable 'gnus-original-article-buffer)) ! (setq gnus-newsgroup-name group) ! t))) ! ! (defun gnus-set-global-variables () ! ;; 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) ! (unread gnus-newsgroup-unreads) ! (headers gnus-current-headers) ! (data gnus-newsgroup-data) ! (summary gnus-summary-buffer) ! (article-buffer gnus-article-buffer) ! (original gnus-original-article-buffer) ! (gac gnus-article-current) ! (reffed gnus-reffed-article-number) ! (score-file gnus-current-score-file)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (setq gnus-newsgroup-name name) ! (setq gnus-newsgroup-marked marked) ! (setq gnus-newsgroup-unreads unread) ! (setq gnus-current-headers headers) ! (setq gnus-newsgroup-data data) ! (setq gnus-article-current gac) ! (setq gnus-summary-buffer summary) ! (setq gnus-article-buffer article-buffer) ! (setq gnus-original-article-buffer original) ! (setq gnus-reffed-article-number reffed) ! (setq gnus-current-score-file score-file))))) ! ! (defun gnus-summary-last-article-p (&optional article) ! "Return whether ARTICLE is the last article in the buffer." ! (if (not (setq article (or article (gnus-summary-article-number)))) ! t ; All non-existant numbers are the last article. :-) ! (not (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) ! (gnus-add-text-properties ! (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) ! (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) ! ! (defun gnus-make-thread-indent-array () ! (let ((n 200)) ! (unless (and gnus-thread-indent-array ! (= gnus-thread-indent-level gnus-thread-indent-array-level)) ! (setq gnus-thread-indent-array (make-vector 201 "") ! gnus-thread-indent-array-level gnus-thread-indent-level) ! (while (>= n 0) ! (aset gnus-thread-indent-array n ! (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)) ! (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) ! (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) ! (gnus-tmp-score-char ! (if (or (null gnus-summary-default-score) ! (<= (abs (- gnus-tmp-score gnus-summary-default-score)) ! gnus-summary-zcore-fuzz)) ? ! (if (< gnus-tmp-score gnus-summary-default-score) ! gnus-score-below-mark gnus-score-over-mark))) ! (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) ! ((memq gnus-tmp-current gnus-newsgroup-cached) ! gnus-cached-mark) ! (gnus-tmp-replied gnus-replied-mark) ! ((memq gnus-tmp-current gnus-newsgroup-saved) ! 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))) ! (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)))) ! (t gnus-tmp-from))) ! (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) ! (gnus-tmp-number (mail-header-number gnus-tmp-header)) ! (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) ! (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) ! (buffer-read-only nil)) ! (when (string= gnus-tmp-name "") ! (setq gnus-tmp-name gnus-tmp-from)) ! (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) ! (gnus-put-text-property ! (point) ! (progn (eval gnus-summary-line-format-spec) (point)) ! 'gnus-number gnus-tmp-number) ! (when (gnus-visual-p 'summary-highlight 'highlight) ! (forward-line -1) ! (run-hooks 'gnus-summary-update-hook) ! (forward-line 1)))) ! ! (defun gnus-summary-update-line (&optional dont-update) ! ;; Update summary line after change. ! (when (and gnus-summary-default-score ! (not gnus-summary-inhibit-highlight)) ! (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. ! (article (gnus-summary-article-number)) ! (score (gnus-summary-article-score article))) ! (unless dont-update ! (if (and gnus-summary-mark-below ! (< (gnus-summary-article-score) ! gnus-summary-mark-below)) ! ;; This article has a low score, so we mark it as read. ! (when (memq article gnus-newsgroup-unreads) ! (gnus-summary-mark-article-as-read gnus-low-score-mark)) ! (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) ! (<= (abs (- score gnus-summary-default-score)) ! gnus-summary-zcore-fuzz)) ? ! (if (< score gnus-summary-default-score) ! gnus-score-below-mark gnus-score-over-mark)) 'score)) ! ;; Do visual highlighting. ! (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 0)))) ! (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))) ! ! (defun gnus-summary-set-local-parameters (group) ! "Go through the local params of GROUP and set all variable specs in that list." ! (let ((params (gnus-info-params (gnus-get-info group))) ! elem) ! (while params ! (setq elem (car params) ! params (cdr params)) ! (and (consp elem) ; Has to be a cons. ! (consp (cdr elem)) ; The cdr has to be a list. ! (symbolp (car elem)) ; Has to be a symbol in there. ! (not (memq (car elem) ! '(quit-config to-address to-list to-group))) ! (progn ; So we set it. ! (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. ! If NO-ARTICLE is non-nil, no article is selected initially. ! If NO-DISPLAY, don't generate a summary buffer." ! (gnus-message 5 "Retrieving newsgroup: %s..." group) ! (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)) ! (if (not quit-config) ! (progn ! (set-buffer gnus-group-buffer) ! (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))))) ! (gnus-message 3 "Can't select group") ! nil) ! ;; The user did a `C-g' while prompting for number of articles, ! ;; so we exit this group. ! ((eq did-select 'quit) ! (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) ! (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)))) ! ;; 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. ! (run-hooks 'gnus-select-group-hook) ! ;; Set any local variables in the group parameters. ! (gnus-summary-set-local-parameters gnus-newsgroup-name) ! (gnus-update-format-specifications) ! ;; Do score processing. ! (when gnus-use-scoring ! (gnus-possibly-score-headers)) ! ;; Check whether to fill in the gaps in the threads. ! (when gnus-build-sparse-threads ! (gnus-build-sparse-threads)) ! ;; Find the initial limit. ! (if gnus-show-threads ! (if show-all ! (let ((gnus-newsgroup-dormant nil)) ! (gnus-summary-initial-limit show-all)) ! (gnus-summary-initial-limit show-all)) ! (setq gnus-newsgroup-limit ! (mapcar ! (lambda (header) (mail-header-number header)) ! gnus-newsgroup-headers))) ! ;; 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 (and (zerop (buffer-size)) ! (not no-display)) ! (cond (gnus-newsgroup-dormant ! (gnus-summary-limit-include-dormant)) ! ((and gnus-newsgroup-scored show-all) ! (gnus-summary-limit-include-expunged t)))) ! ;; Function `gnus-apply-kill-file' must be called in this hook. ! (run-hooks 'gnus-apply-kill-hook) ! (if (and (zerop (buffer-size)) ! (not no-display)) ! (progn ! ;; 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 ! ;; gnus-summary-prepare-hook since kill processing may not ! ;; work with hidden articles. ! (and gnus-show-threads ! gnus-thread-hide-subtree ! (gnus-summary-hide-all-threads)) ! ;; Show first unread article if requested. ! (if (and (not no-article) ! (not no-display) ! gnus-newsgroup-unreads ! gnus-auto-select-first) ! (unless (if (eq gnus-auto-select-first 'best) ! (gnus-summary-best-unread-article) ! (gnus-summary-first-unread-article)) ! (gnus-configure-windows 'summary)) ! ;; Don't select any articles, just move point to the first ! ;; article in the group. ! (goto-char (point-min)) ! (gnus-summary-position-point) ! (gnus-set-mode-line 'summary) ! (gnus-configure-windows 'summary 'force)) ! ;; 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 t) ! ;; 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 t)) ! (when (gnus-group-goto-group group) ! (recenter)) ! (select-window owin)))) ! ;; Mark this buffer as "prepared". ! (setq gnus-newsgroup-prepared t) ! t)))) ! ! (defun gnus-summary-prepare () ! "Generate the summary buffer." ! (let ((buffer-read-only nil)) ! (erase-buffer) ! (setq gnus-newsgroup-data nil ! 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 (caar threads))) ! (setq subject ! (cond ! ;; Truncate the subject. ! ((numberp gnus-summary-gather-subject-limit) ! (setq subject (gnus-simplify-subject-re whole-subject)) ! (if (> (length subject) gnus-summary-gather-subject-limit) ! (substring subject 0 gnus-summary-gather-subject-limit) ! subject)) ! ;; Fuzzily simplify it. ! ((eq 'fuzzy gnus-summary-gather-subject-limit) ! (gnus-simplify-subject-fuzzy whole-subject)) ! ;; Just remove the leading "Re:". ! (t ! (gnus-simplify-subject-re whole-subject)))) ! ! (if (and gnus-summary-gather-exclude-subject ! (string-match gnus-summary-gather-exclude-subject ! subject)) ! () ; We don't want to do anything with this article. ! ;; We simplify the subject before looking it up in the ! ;; hash table. ! ! (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 (caar hthread)) ! (setcar hthread (list whole-subject (car hthread)))) ! ;; We add this new gathered thread to this gathered ! ;; thread. ! (setcdr (car hthread) ! (nconc (cdar 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-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 (caar threads)) ! (setcdr (car threads) ! (sort (cdar 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 (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 (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 ! ;; build complete threads - if the roots haven't been expired by the ! ;; server, that is. ! (let (id heads) ! (mapatoms ! (lambda (refs) ! (when (not (car (symbol-value refs))) ! (setq heads (cdr (symbol-value refs))) ! (while heads ! (if (memq (mail-header-number (caar heads)) ! gnus-newsgroup-dormant) ! (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))) ! ! (defun gnus-build-get-header (id) ! ;; Look through the buffer of NOV lines and find the header to ! ;; ID. Enter this line into the dependencies hash table, and return ! ;; the id of the parent article (if any). ! (let ((deps gnus-newsgroup-dependencies) ! found header) ! (prog1 ! (save-excursion ! (set-buffer nntp-server-buffer) ! (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))) ! (when found ! (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 &optional iheader) ! "Update ARTICLE in the summary buffer." ! (set-buffer gnus-summary-buffer) ! (let* ((header (or iheader (gnus-summary-article-header article))) ! (id (mail-header-id header)) ! (data (gnus-data-find article)) ! (thread (gnus-id-to-thread id)) ! (references (mail-header-references header)) ! (parent ! (gnus-id-to-thread ! (or (gnus-parent-id ! (if (and references ! (not (equal "" references))) ! references)) ! "none"))) ! (buffer-read-only nil) ! (old (car thread)) ! (number (mail-header-number header)) ! pos) ! (when thread ! ;; !!! Should this be in or not? ! (unless iheader ! (setcar thread nil)) ! (when parent ! (delq thread parent)) ! (if (gnus-summary-insert-subject id header iheader) ! ;; Set the (possibly) new article number in the data structure. ! (gnus-data-set-number data (gnus-id-to-article id)) ! (setcar thread old) ! nil)))) ! ! (defun gnus-rebuild-thread (id) ! "Rebuild the thread containing ID." ! (let ((buffer-read-only nil) ! current thread 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 ! (and (zerop (forward-line -1)) ! (gnus-summary-article-number)))) ! ;; If this is a gathered thread, we have to go some re-gathering. ! (when (stringp (car thread)) ! (let ((subject (car thread)) ! roots thr) ! (setq thread (cdr thread)) ! (while thread ! (unless (memq (setq thr (gnus-id-to-thread ! (gnus-root-id ! (mail-header-id (caar thread))))) ! roots) ! (push thr roots)) ! (setq thread (cdr thread))) ! ;; We now have all (unique) roots. ! (if (= (length roots) 1) ! ;; All the loose roots are now one solid root. ! (setq thread (car roots)) ! (setq thread (cons subject (gnus-sort-threads roots)))))) ! (let (threads) ! ;; We then insert this thread into the summary buffer. ! (let (gnus-newsgroup-data gnus-newsgroup-threads) ! (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) ! (setq data (nreverse gnus-newsgroup-data)) ! (setq threads gnus-newsgroup-threads)) ! ;; We splice the new data into the data structure. ! (gnus-data-enter-list current data) ! (gnus-data-compute-positions) ! (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) ! ! (defun gnus-number-to-header (number) ! "Return the header for article NUMBER." ! (let ((headers gnus-newsgroup-headers)) ! (while (and headers ! (not (= number (mail-header-number (car headers))))) ! (pop headers)) ! (when headers ! (car headers)))) ! ! (defun gnus-id-to-thread (id) ! "Return the (sub-)thread where ID appears." ! (gnus-gethash id gnus-newsgroup-dependencies)) ! ! (defun gnus-id-to-article (id) ! "Return the article number of ID." ! (let ((thread (gnus-id-to-thread id))) ! (when (and thread ! (car 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)) ! (refs (mail-header-references (gnus-summary-article-header article))) ! particle) ! (cond ! ((null level) nil) ! ((zerop level) t) ! ((null refs) t) ! ((null (gnus-parent-id refs)) t) ! ((and (= 1 level) ! (null (setq particle (gnus-id-to-article ! (gnus-parent-id refs)))) ! (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 ! 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 last-id) ! ;; First go up in this thread until we find the root. ! (setq last-id (gnus-root-id id)) ! (setq headers (list (car (gnus-id-to-thread last-id)) ! (caadr (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) ! sub) ! (while threads ! (setq sub (car threads)) ! (if (stringp (car sub)) ! ;; This is a gathered thread, so we look at the roots ! ;; below it to find whether this article is in this ! ;; gathered root. ! (progn ! (setq sub (cdr sub)) ! (while sub ! (when (member (caar sub) headers) ! (setq thread (car threads) ! threads nil ! sub nil)) ! (setq sub (cdr sub)))) ! ;; It's an ordinary thread, so we check it. ! (when (eq (car sub) (car headers)) ! (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 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) ! (gnus-data-remove number)) ! (setq thread (cdr thread)) ! (while thread ! (gnus-remove-thread-1 (pop thread))))) ! ! (defun gnus-sort-threads (threads) ! "Sort THREADS." ! (if (not gnus-thread-sort-functions) ! threads ! (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 ! (setq gnus-newsgroup-headers (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. ! ;; Note that THREAD must never, ever be anything else than a variable - ! ;; 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) ! "Sort articles by article number." ! (< (mail-header-number h1) ! (mail-header-number h2))) ! ! (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))))) ! ! (defun gnus-thread-sort-by-author (h1 h2) ! "Sort threads by root author." ! (gnus-article-sort-by-author ! (gnus-thread-header h1) (gnus-thread-header h2))) ! ! (defsubst gnus-article-sort-by-subject (h1 h2) ! "Sort articles by root subject." ! (string-lessp ! (downcase (gnus-simplify-subject-re (mail-header-subject h1))) ! (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) ! ! (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) ! "Sort articles by root article date." ! (string-lessp ! (inline (gnus-sortable-date (mail-header-date h1))) ! (inline (gnus-sortable-date (mail-header-date h2))))) ! ! (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) ! "Sort articles by root article score. ! Unscored articles will be counted as having a score of zero." ! (> (or (cdr (assq (mail-header-number h1) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! (or (cdr (assq (mail-header-number h2) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0))) ! ! (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) ! "Sort threads by the sum of all scores in the thread. ! Unscored articles will be counted as having a score of zero." ! (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) ! ! (defun gnus-thread-total-score (thread) ! ;; This function find the total score of THREAD. ! (cond ((null thread) ! 0) ! ((consp thread) ! (if (stringp (car thread)) ! (apply gnus-thread-score-function 0 ! (mapcar 'gnus-thread-total-score-1 (cdr thread))) ! (gnus-thread-total-score-1 thread))) ! (t ! (gnus-thread-total-score-1 (list thread))))) ! ! (defun gnus-thread-total-score-1 (root) ! ;; This function find the total score of the thread below ROOT. ! (setq root (car root)) ! (apply gnus-thread-score-function ! (or (append ! (mapcar 'gnus-thread-total-score ! (cdr (gnus-gethash (mail-header-id root) ! gnus-newsgroup-dependencies))) ! (if (> (mail-header-number root) 0) ! (list (or (cdr (assq (mail-header-number root) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0)))) ! (list gnus-summary-default-score) ! '(0)))) ! ! ;; Added by Per Abrahamsen . ! (defvar gnus-tmp-prev-subject nil) ! (defvar gnus-tmp-false-parent nil) ! (defvar gnus-tmp-root-expunged nil) ! (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...") ! ! (setq gnus-newsgroup-threads threads) ! (beginning-of-line) ! ! (let ((gnus-tmp-level 0) ! (default-score (or gnus-summary-default-score 0)) ! (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) ! thread number subject stack state gnus-tmp-gathered beg-match ! new-roots gnus-tmp-new-adopts thread-end ! gnus-tmp-header gnus-tmp-unread ! gnus-tmp-replied gnus-tmp-subject-or-nil ! gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score ! gnus-tmp-score-char gnus-tmp-from gnus-tmp-name ! gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) ! ! (setq gnus-tmp-prev-subject nil) ! ! (if (vectorp (car threads)) ! ;; If this is a straight (sic) list of headers, then a ! ;; threaded summary display isn't required, so we just create ! ;; an unthreaded one. ! (gnus-summary-prepare-unthreaded threads) ! ! ;; Do the threaded display. ! ! (while (or threads stack gnus-tmp-new-adopts new-roots) ! ! (if (and (= gnus-tmp-level 0) ! (not (setq gnus-tmp-dummy-line nil)) ! (or (not stack) ! (= (caar stack) 0)) ! (not gnus-tmp-false-parent) ! (or gnus-tmp-new-adopts new-roots)) ! (if gnus-tmp-new-adopts ! (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) ! thread (list (car gnus-tmp-new-adopts)) ! gnus-tmp-header (caar thread) ! gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) ! (if new-roots ! (setq thread (list (car new-roots)) ! gnus-tmp-header (caar thread) ! new-roots (cdr new-roots)))) ! ! (if threads ! ;; If there are some threads, we do them before the ! ;; threads on the stack. ! (setq thread threads ! gnus-tmp-header (caar 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) ! stack (cdr stack) ! gnus-tmp-header (caar thread)))) ! ! (setq gnus-tmp-false-parent nil) ! (setq gnus-tmp-root-expunged nil) ! (setq thread-end nil) ! ! (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 ! (cddar thread))) ! (setq gnus-tmp-gathered ! (nconc (mapcar ! (lambda (h) (mail-header-number (car h))) ! (cddar thread)) ! gnus-tmp-gathered)) ! (setq thread (cons (list (caar thread) ! (cadar thread)) ! (cdr thread))) ! (setq gnus-tmp-level -1 ! 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))) ! (cddar thread)) ! gnus-tmp-gathered)) ! (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)) ! gnus-tmp-prev-subject ! (not (inline ! (gnus-subject-equal gnus-tmp-prev-subject subject)))) ! (setq new-roots (nconc new-roots (list (car thread))) ! thread-end t ! gnus-tmp-header nil)) ! ;; If the article lies outside the current limit, ! ;; then we do not display it. ! ((and (not (memq number gnus-newsgroup-limit)) ! (not gnus-tmp-dummy-line)) ! (setq gnus-tmp-gathered ! (nconc (mapcar ! (lambda (h) (mail-header-number (car h))) ! (cdar thread)) ! gnus-tmp-gathered)) ! (setq gnus-tmp-new-adopts (if (cdar thread) ! (append gnus-tmp-new-adopts ! (cdar thread)) ! gnus-tmp-new-adopts) ! thread-end t ! gnus-tmp-header nil) ! (when (zerop gnus-tmp-level) ! (setq gnus-tmp-root-expunged t))) ! ;; Perhaps this article is to be marked as read? ! ((and gnus-summary-mark-below ! (< (or (cdr (assq number gnus-newsgroup-scored)) ! default-score) ! gnus-summary-mark-below) ! ;; Don't touch sparse articles. ! (not (memq number gnus-newsgroup-sparse)) ! (not (memq number gnus-newsgroup-ancient))) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (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) ! ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) ! (t (or (cdr (assq number gnus-newsgroup-reads)) ! gnus-ancient-mark)))) ! ! (push (gnus-data-make number gnus-tmp-unread (1+ (point)) ! gnus-tmp-header gnus-tmp-level) ! 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) ! (if (and (eq gnus-summary-make-false-root 'empty) ! (memq number gnus-tmp-gathered) ! gnus-tmp-prev-subject ! (inline (gnus-subject-equal ! gnus-tmp-prev-subject subject))) ! gnus-summary-same-subject ! subject)) ! (t gnus-summary-same-subject))) ! (if (and (eq gnus-summary-make-false-root 'adopt) ! (= gnus-tmp-level 1) ! (memq number gnus-tmp-gathered)) ! (setq gnus-tmp-opening-bracket ?\< ! 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)) ! gnus-summary-default-score 0) ! gnus-tmp-score-char ! (if (or (null gnus-summary-default-score) ! (<= (abs (- gnus-tmp-score gnus-summary-default-score)) ! gnus-summary-zcore-fuzz)) ? ! (if (< gnus-tmp-score gnus-summary-default-score) ! gnus-score-below-mark gnus-score-over-mark)) ! gnus-tmp-replied ! (cond ((memq number gnus-newsgroup-processable) ! gnus-process-mark) ! ((memq number gnus-newsgroup-cached) ! gnus-cached-mark) ! ((memq number gnus-newsgroup-replied) ! gnus-replied-mark) ! ((memq number gnus-newsgroup-saved) ! 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) ! (setq beg-match (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-match))) ! (t gnus-tmp-from))) ! (when (string= gnus-tmp-name "") ! (setq gnus-tmp-name gnus-tmp-from)) ! (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) ! (gnus-put-text-property ! (point) ! (progn (eval gnus-summary-line-format-spec) (point)) ! 'gnus-number number) ! (when gnus-visual-p ! (forward-line -1) ! (run-hooks 'gnus-summary-update-hook) ! (forward-line 1)) ! ! (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 (cdar thread))) ! (unless threads ! (setq gnus-tmp-level 0))))) ! (gnus-message 7 "Generating summary...done")) ! ! (defun gnus-summary-prepare-unthreaded (headers) ! "Generate an unthreaded summary buffer based on HEADERS." ! (let (header number mark) ! ! (while headers ! ;; We may have to root out some bad articles... ! (when (memq (setq number (mail-header-number ! (setq header (pop headers)))) ! gnus-newsgroup-limit) ! ;; Mark article as read when it has a low score. ! (when (and gnus-summary-mark-below ! (< (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-summary-mark-below) ! (not (memq number gnus-newsgroup-ancient))) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (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 ! header 0 nil mark (memq number gnus-newsgroup-replied) ! (memq number gnus-newsgroup-expirable) ! (mail-header-subject header) nil ! (cdr (assq number gnus-newsgroup-scored)) ! (memq number gnus-newsgroup-processable)))))) ! ! (defun gnus-select-newsgroup (group &optional read-all) ! "Select newsgroup GROUP. ! 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. ! (when (equal major-mode 'gnus-summary-mode) ! (kill-buffer (current-buffer))) ! (error "Couldn't request group %s: %s" ! group (gnus-status-message group)))) ! ! (unless (gnus-request-group group t) ! (when (equal major-mode 'gnus-summary-mode) ! (kill-buffer (current-buffer))) ! (error "Couldn't request group %s: %s" ! group (gnus-status-message group))) ! ! (setq gnus-newsgroup-name group) ! (setq gnus-newsgroup-unselected nil) ! (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))) ! ! ;; Adjust and set lists of article marks. ! (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 for %s..." gnus-newsgroup-name) ! (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 for %s...done" gnus-newsgroup-name) ! ! ;; 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 ! (eq gnus-headers-retrieved-by 'nov) ! (gnus-build-old-threads)) ! ;; Check whether auto-expire is to be done in this group. ! (setq gnus-newsgroup-auto-expire ! (gnus-group-auto-expirable-p group)) ! ;; Set up the article buffer now, if necessary. ! (unless gnus-single-article-buffer ! (gnus-article-setup-buffer)) ! ;; First and last article in this newsgroup. ! (when gnus-newsgroup-headers ! (setq gnus-newsgroup-begin ! (mail-header-number (car gnus-newsgroup-headers)) ! gnus-newsgroup-end ! (mail-header-number ! (gnus-last-element gnus-newsgroup-headers)))) ! ;; GROUP is successfully selected. ! (or gnus-newsgroup-headers t))))) ! ! (defun gnus-articles-to-read (group read-all) ! ;; Find out what articles the user wants to read. ! (let* ((articles ! ;; Select all articles if `read-all' is non-nil, or if there ! ;; are no unread articles. ! (if (or read-all ! (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)) ! (scored (length scored-list)) ! (number (length articles)) ! (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)) ! (let ((input ! (read-string ! (format ! "How many articles from %s (default %d): " ! gnus-newsgroup-name number)))) ! (if (string-match "^[ \t]*$" input) number input))) ! ((and (> scored marked) (< scored number) ! (> (- scored number) 20)) ! (let ((input ! (read-string ! (format "%s %s (%d scored, %d total): " ! "How many articles from" ! group scored number)))) ! (if (string-match "^[ \t]*$" input) ! number input))) ! (t number)) ! (quit nil)))))) ! (setq select (if (stringp select) (string-to-number select) select)) ! (if (or (null select) (zerop select)) ! select ! (if (and (not (zerop scored)) (<= (abs select) scored)) ! (progn ! (setq articles (sort scored-list '<)) ! (setq number (length articles))) ! (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. ! (setq articles (nthcdr (- number select) articles)))) ! (setq gnus-newsgroup-unselected ! (gnus-sorted-intersection ! gnus-newsgroup-unreads ! (gnus-sorted-complement gnus-newsgroup-unreads articles))) ! articles))) ! ! (defun gnus-killed-articles (killed articles) ! (let (out) ! (while articles ! (if (inline (gnus-member-of-range (car articles) killed)) ! (setq out (cons (car articles) out))) ! (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)) ! (active (gnus-active (gnus-info-group info))) ! (min (car active)) ! (max (cdr active)) ! (types gnus-article-mark-lists) ! (uncompressed '(score bookmark killed)) ! marks var articles article mark) ! ! (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 save)) ! (while articles ! (when (or (< (setq article (pop articles)) min) (> article max)) ! (set var (delq article (symbol-value var)))))) ! ;; Adjust assocs. ! ((memq mark uncompressed) ! (while articles ! (when (or (not (consp (setq article (pop articles)))) ! (< (car article) min) ! (> (car article) max)) ! (set var (delq article (symbol-value var)))))))))) ! ! (defun gnus-update-missing-marks (missing) ! "Go through the list of MISSING articles and remove them mark lists." ! (when missing ! (let ((types gnus-article-mark-lists) ! var m) ! ;; Go through all types. ! (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 ! (set var (delq (pop m) (symbol-value var))))))))) ! ! (defun gnus-update-marks () ! "Enter the various lists of marked articles into the newsgroup info list." ! (let ((types gnus-article-mark-lists) ! (info (gnus-get-info gnus-newsgroup-name)) ! (uncompressed '(score bookmark killed)) ! type list newmarked symbol) ! (when info ! ;; 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))) ! ! ;; Enter these new marks into the info of the group. ! (if (nthcdr 3 info) ! (setcar (nthcdr 3 info) newmarked) ! ;; Add the marks lists to the end of the info. ! (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))) ! (when (nthcdr (decf i) info) ! (setcdr (nthcdr i info) nil))))))) ! ! (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)) ! marked m) ! (or (not info) ! (and (not (setq marked (nthcdr 3 info))) ! (or (null articles) ! (setcdr (nthcdr 2 info) ! (list (list (cons type (gnus-compress-sequence ! articles t))))))) ! (and (not (setq m (assq type (car marked)))) ! (or (null articles) ! (setcar marked ! (cons (cons type (gnus-compress-sequence articles t) ) ! (car marked))))) ! (if force ! (if (null articles) ! (setcar (nthcdr 3 info) ! (delq (assq type (car marked)) (car marked))) ! (setcdr m (gnus-compress-sequence articles t))) ! (setcdr m (gnus-compress-sequence ! (sort (nconc (gnus-uncompress-range (cdr 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." ! ;; Is this mode line one we keep updated? ! (when (memq where gnus-updated-mode-lines) ! (let (mode-string) ! (save-excursion ! ;; We evaluate this in the summary buffer since these ! ;; 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) ! (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) ! (gnus-tmp-unselected (length gnus-newsgroup-unselected)) ! (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 ! gnus-tmp-unselected)))) ! (gnus-tmp-subject ! (if (and gnus-current-headers ! (vectorp gnus-current-headers)) ! (gnus-mode-string-quote ! (mail-header-subject gnus-current-headers)) "")) ! max-len ! gnus-tmp-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 ! (- (window-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. ! (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) ! ;; Update the mode line. ! (setq mode-line-buffer-identification ! (gnus-mode-line-buffer-identification ! (list mode-string))) ! (set-buffer-modified-p t)))) ! ! (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) ! "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* ((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) ! (while headers ! (setq header (pop headers)) ! (when (and (setq xrefs (mail-header-xref header)) ! (not (memq (setq number (mail-header-number header)) ! unreads))) ! (setq start 0) ! (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) ! (setq start (match-end 0)) ! (setq group (if prefix ! (concat prefix (substring xrefs (match-beginning 1) ! (match-end 1))) ! (substring xrefs (match-beginning 1) (match-end 1)))) ! (setq number ! (string-to-int (substring xrefs (match-beginning 2) ! (match-end 2)))) ! (if (setq entry (gnus-gethash group xref-hashtb)) ! (setcdr entry (cons number (cdr entry))) ! (gnus-sethash group (cons number nil) xref-hashtb))))) ! (and start xref-hashtb))) ! ! (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)))) ! gnus-use-cross-reference ! (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))))) ! ! (defun gnus-group-make-articles-read (group articles) ! (let* ((num 0) ! (entry (gnus-gethash group gnus-newsrc-hashtb)) ! (info (nth 2 entry)) ! (active (gnus-active group)) ! range) ! ;; First peel off all illegal article numbers. ! (when active ! (let ((ids articles) ! id first) ! (while (setq id (pop ids)) ! (when (and first (> id (cdr active))) ! ;; 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 ! ;; Gnus believes possible. So we re-activate this ! ;; group as well. This might mean doing the ! ;; crossposting thingy will *increase* the number ! ;; of articles in some groups. Tsk, tsk. ! (setq active (or (gnus-activate-group group) active))) ! (when (or (> id (cdr active)) ! (< id (car active))) ! (setq articles (delq id articles)))))) ! ;; If the read list is nil, we init it. ! (and active ! (null (gnus-info-read info)) ! (> (car active) 1) ! (gnus-info-set-read info (cons 1 (1- (car active))))) ! ;; Then we add the read articles to the range. ! (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 ! (if (numberp (car range)) ! (setq num (1+ num)) ! (setq num (+ num (- (1+ (cdar range)) (caar range))))) ! (setq range (cdr range))) ! (setq num (- (cdr active) num)))) ! ;; Update the number of unread articles. ! (setcar entry num) ! ;; Update the group buffer. ! (gnus-group-update-group group t))))) ! ! (defun gnus-methods-equal-p (m1 m2) ! (let ((m1 (or m1 gnus-select-method)) ! (m2 (or m2 gnus-select-method))) ! (or (equal m1 m2) ! (and (eq (car m1) (car m2)) ! (or (not (memq 'address (assoc (symbol-name (car m1)) ! gnus-valid-select-methods))) ! (equal (nth 1 m1) (nth 1 m2))))))) ! ! (defsubst gnus-header-value () ! (buffer-substring (match-end 0) (gnus-point-at-eol))) ! ! (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))) ! headers id id-dep ref-dep end ref) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (run-hooks 'gnus-parse-headers-hook) ! (let ((case-fold-search t) ! in-reply-to header 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 ! ref nil) ! ;; 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. ! (prog1 ! (read cur) ! (end-of-line) ! (setq p (point)) ! (narrow-to-region (point) ! (or (and (search-forward "\n.\n" nil t) ! (- (point) 2)) ! (point)))) ! ;; Subject. ! (progn ! (goto-char p) ! (if (search-forward "\nsubject: " nil t) ! (gnus-header-value) "(none)")) ! ;; From. ! (progn ! (goto-char p) ! (if (search-forward "\nfrom: " nil t) ! (gnus-header-value) "(nobody)")) ! ;; Date. ! (progn ! (goto-char p) ! (if (search-forward "\ndate: " nil t) ! (gnus-header-value) "")) ! ;; Message-ID. ! (progn ! (goto-char p) ! (if (search-forward "\nmessage-id: " nil t) ! (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 ! (goto-char p) ! (if (search-forward "\nreferences: " nil t) ! (progn ! (setq end (point)) ! (prog1 ! (gnus-header-value) ! (setq ref ! (buffer-substring ! (progn ! (end-of-line) ! (search-backward ">" end t) ! (1+ (point))) ! (progn ! (search-backward "<" end t) ! (point)))))) ! ;; Get the references from the in-reply-to header if there ! ;; were no references and the in-reply-to header looks ! ;; promising. ! (if (and (search-forward "\nin-reply-to: " nil t) ! (setq in-reply-to (gnus-header-value)) ! (string-match "<[^>]+>" in-reply-to)) ! (setq ref (substring in-reply-to (match-beginning 0) ! (match-end 0))) ! (setq ref "")))) ! ;; Chars. ! 0 ! ;; Lines. ! (progn ! (goto-char p) ! (if (search-forward "\nlines: " nil t) ! (if (numberp (setq lines (read cur))) ! lines 0) ! 0)) ! ;; Xref. ! (progn ! (goto-char p) ! (and (search-forward "\nxref: " nil t) ! (gnus-header-value))))) ! ;; We do the threading while we read the headers. The ! ;; message-id and the last reference are both entered into ! ;; the same hash table. Some tippy-toeing around has to be ! ;; done in case an article has arrived before the article ! ;; which it refers to. ! (if (boundp (setq id-dep (intern 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 ! (if (= (following-char) ?\t) ! 0 ! (let ((num (condition-case nil (read buffer) (error nil)))) ! (if (numberp num) num 0))) ! (or (eobp) (forward-char 1)))) ! ! (defmacro gnus-nov-skip-field () ! '(search-forward "\t" eol 'move)) ! ! (defmacro gnus-nov-field () ! '(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 dependencies) ! "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 ! ;; NNTP servers do not include Xrefs when using XOVER. ! (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) ! (let ((cur nntp-server-buffer) ! (dependencies (or dependencies gnus-newsgroup-dependencies)) ! number headers header) ! (save-excursion ! (set-buffer nntp-server-buffer) ! ;; Allow the user to mangle the headers before parsing them. ! (run-hooks 'gnus-parse-headers-hook) ! (goto-char (point-min)) ! (while (and sequence (not (eobp))) ! (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))) ! headers)) ! ! ;; 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) ! ! ;; overview: [num subject from date id refs chars lines misc] ! (narrow-to-region (point) eol) ! (or (eobp) (forward-char)) ! ! (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 ! (buffer-substring ! (1+ (point)) ! (search-backward "<" beg t))) ! (setq ref nil)))) ! (gnus-nov-field)) ; refs ! (gnus-nov-read-integer) ; chars ! (gnus-nov-read-integer) ; lines ! (if (= (following-char) ?\n) ! nil ! (gnus-nov-field)) ; misc ! )) ! (error (progn ! (gnus-error 4 "Strange nov line") ! (setq header nil) ! (goto-char eol)))) ! ! (widen) ! ! ;; We build the thread tree. ! (when header ! (if (boundp (setq id-dep (intern id dependencies))) ! (if (and (car (symbol-value id-dep)) ! (not force-new)) ! ;; An article with this Message-ID has already been seen, ! ;; 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 (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))))) ! header)) ! ! (defun gnus-article-get-xrefs () ! "Fill in the Xref value in `gnus-current-headers', if necessary. ! This is meant to be called in `gnus-article-internal-prepare-hook'." ! (let ((headers (save-excursion (set-buffer gnus-summary-buffer) ! gnus-current-headers))) ! (or (not gnus-use-cross-reference) ! (not headers) ! (and (mail-header-xref headers) ! (not (string= (mail-header-xref headers) ""))) ! (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 &optional old-header use-old-header) ! "Find article ID and insert the summary line for that article." ! (let ((header (if (and old-header use-old-header) ! old-header (gnus-read-header id))) ! (number (and (numberp id) id)) ! pos) ! (when header ! ;; Rebuild the thread that this article is part of and go to the ! ;; article we have fetched. ! (when (and (not gnus-show-threads) ! old-header) ! (when (setq pos (text-property-any ! (point-min) (point-max) 'gnus-number ! (mail-header-number old-header))) ! (goto-char pos) ! (gnus-delete-line) ! (gnus-data-remove (mail-header-number old-header)))) ! (when old-header ! (mail-header-set-number header (mail-header-number old-header))) ! (setq gnus-newsgroup-sparse ! (delq (setq number (mail-header-number header)) ! gnus-newsgroup-sparse)) ! (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) ! (gnus-rebuild-thread (mail-header-id header)) ! (gnus-summary-goto-subject number nil t)) ! (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 (mail-header-number header)))) ! ! (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 ! (n ! ;; A numerical prefix has been given. ! (let ((backward (< n 0)) ! (n (abs (prefix-numeric-value n))) ! articles article) ! (save-excursion ! (while ! (and (> n 0) ! (push (setq article (gnus-summary-article-number)) ! articles) ! (if backward ! (gnus-summary-find-prev nil article) ! (gnus-summary-find-next nil article))) ! (decf n))) ! (nreverse articles))) ! ((and (boundp 'transient-mark-mode) ! transient-mark-mode ! mark-active) ! ;; Work on the region between point and mark. ! (let ((max (max (point) (mark))) ! 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))) ! (nreverse articles)))) ! (gnus-newsgroup-processable ! ;; There are process-marked articles present. ! (reverse gnus-newsgroup-processable)) ! (t ! ;; Just return the current article. ! (list (gnus-summary-article-number))))) ! ! (defun gnus-summary-search-group (&optional backward use-level) ! "Search for next unread newsgroup. ! 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)))) ! ! (defun gnus-summary-best-group (&optional exclude-group) ! "Find the name of the best unread group. ! If EXCLUDE-GROUP, do not go to this group." ! (save-excursion ! (set-buffer gnus-group-buffer) ! (save-excursion ! (gnus-group-best-unread-group exclude-group)))) ! ! (defun gnus-summary-find-next (&optional unread article backward) ! (if backward (gnus-summary-find-prev) ! (let* ((dummy (gnus-summary-article-intangible-p)) ! (article (or article (gnus-summary-article-number))) ! (arts (gnus-data-find-list article)) ! result) ! (when (and (not dummy) ! (or (not gnus-summary-check-current) ! (not unread) ! (not (gnus-data-unread-p (car arts))))) ! (setq arts (cdr arts))) ! (when (setq result ! (if unread ! (progn ! (while arts ! (when (gnus-data-unread-p (car arts)) ! (setq result (car arts) ! arts nil)) ! (setq arts (cdr arts))) ! result) ! (car arts))) ! (goto-char (gnus-data-pos result)) ! (gnus-data-number result))))) ! ! (defun gnus-summary-find-prev (&optional unread article) ! (let* ((eobp (eobp)) ! (article (or article (gnus-summary-article-number))) ! (arts (gnus-data-find-list article (gnus-data-list 'rev))) ! result) ! (when (and (not eobp) ! (or (not gnus-summary-check-current) ! (not unread) ! (not (gnus-data-unread-p (car arts))))) ! (setq arts (cdr arts))) ! (if (setq result ! (if unread ! (progn ! (while arts ! (and (gnus-data-unread-p (car arts)) ! (setq result (car arts) ! arts nil)) ! (setq arts (cdr arts))) ! result) ! (car arts))) ! (progn ! (goto-char (gnus-data-pos result)) ! (gnus-data-number result))))) ! ! (defun gnus-summary-find-subject (subject &optional unread backward article) ! (let* ((simp-subject (gnus-simplify-subject-fully subject)) ! (article (or article (gnus-summary-article-number))) ! (articles (gnus-data-list backward)) ! (arts (gnus-data-find-list article articles)) ! result) ! (when (or (not gnus-summary-check-current) ! (not unread) ! (not (gnus-data-unread-p (car arts)))) ! (setq arts (cdr arts))) ! (while arts ! (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)) ! (setq arts (cdr arts))) ! (and result ! (goto-char (gnus-data-pos result)) ! (gnus-data-number result)))) ! ! (defun gnus-summary-search-forward (&optional unread subject backward) ! "Search forward for an article. ! If UNREAD, look for unread articles. If SUBJECT, look for ! articles with that subject. If BACKWARD, search backward instead." ! (cond (subject (gnus-summary-find-subject subject unread backward)) ! (backward (gnus-summary-find-prev unread)) ! (t (gnus-summary-find-next unread)))) ! ! (defun gnus-recenter (&optional n) ! "Center point in window and redisplay frame. ! Also do horizontal recentering." ! (interactive "P") ! (when (and gnus-auto-center-summary ! (not (eq gnus-auto-center-summary 'vertical))) ! (gnus-horizontal-recenter)) ! (recenter n)) ! ! (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) ! ((< (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)))) ! ;; 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. ! (when (and (get-buffer-window (current-buffer) t) ! (not (eq gnus-auto-center-summary 'vertical))) ! (let ((selected (selected-window))) ! (select-window (get-buffer-window (current-buffer) t)) ! (gnus-summary-position-point) ! (gnus-horizontal-recenter) ! (select-window selected)))))) ! ! (defun gnus-horizontal-recenter () ! "Recenter the current buffer horizontally." ! (if (< (current-column) (/ (window-width) 2)) ! (set-window-hscroll (get-buffer-window (current-buffer) t) 0) ! (let* ((orig (point)) ! (end (window-end (get-buffer-window (current-buffer) t))) ! (max 0)) ! ;; Find the longest line currently displayed in the window. ! (goto-char (window-start)) ! (while (and (not (eobp)) ! (< (point) 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) t) ! (min (- (current-column) (/ (window-width) 3)) ! (+ 2 (- max (window-width))))) ! (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) ! max))) ! ! ;; 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) ! (setq skip (match-end 0) ! depth (+ depth 1))) ! depth)))) ! (if (string-match ":" group) ! (setq foreign (substring group 0 (match-end 0)) ! group (substring group (match-end 0)))) ! (while group ! (if (and (string-match "\\." group) ! (> levels (- gnus-group-uncollapsed-levels 1))) ! (setq name (concat name (substring group 0 1)) ! group (substring group (match-end 0)) ! levels (- levels 1) ! name (concat name ".")) ! (setq name (concat foreign name group) ! group nil))) ! name)) ! ! (defun gnus-summary-jump-to-group (newsgroup) ! "Move point to NEWSGROUP in group mode buffer." ! ;; Keep update point of group mode buffer if visible. ! (if (eq (current-buffer) (get-buffer gnus-group-buffer)) ! (save-window-excursion ! ;; Take care of tree window mode. ! (if (get-buffer-window gnus-group-buffer) ! (pop-to-buffer gnus-group-buffer)) ! (gnus-group-jump-to-group newsgroup)) ! (save-excursion ! ;; Take care of tree window mode. ! (if (get-buffer-window gnus-group-buffer) ! (pop-to-buffer gnus-group-buffer) ! (set-buffer gnus-group-buffer)) ! (gnus-group-jump-to-group newsgroup)))) ! ! ;; This function returns a list of article numbers based on the ! ;; difference between the ranges of read articles in this group and ! ;; the range of active articles. ! (defun gnus-list-of-unread-articles (group) ! (let* ((read (gnus-info-read (gnus-get-info group))) ! (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 ! ;; first unread article is the article after the last read ! ;; article. Sounds logical, doesn't it? ! (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)) ! (caar 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) (cdar read)))) ! (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) ! (setq read (cdr read))))) ! ;; And add the last unread articles. ! (while (<= first last) ! (setq unread (cons first unread)) ! (setq first (1+ first))) ! ;; Return the list of unread articles. ! (nreverse unread))) ! ! (defun gnus-list-of-read-articles (group) ! "Return a list of unread, unticked and non-dormant articles." ! (let* ((info (gnus-get-info group)) ! (marked (gnus-info-marks info)) ! (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) ! (gnus-error 1 "Undefined key") ! (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. ! With arg, turn line truncation on iff arg is positive." ! (interactive "P") ! (setq truncate-lines ! (if (null arg) (not truncate-lines) ! (> (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) ! (when (gnus-ephemeral-group-p gnus-newsgroup-name) ! (error "Ephemeral groups can't be reselected")) ! (let ((current-subject (gnus-summary-article-number)) ! (group gnus-newsgroup-name)) ! (setq gnus-newsgroup-begin nil) ! (gnus-summary-exit) ! ;; We have to adjust the point of group mode buffer because the ! ;; 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 nil t))) ! ! (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)) ! (when gnus-newsgroup-kill-headers ! (setq gnus-newsgroup-killed ! (gnus-compress-sequence ! (nconc ! (gnus-set-sorted-intersection ! (gnus-uncompress-range gnus-newsgroup-killed) ! (setq gnus-newsgroup-unselected ! (sort gnus-newsgroup-unselected '<))) ! (setq gnus-newsgroup-unreads ! (sort gnus-newsgroup-unreads '<))) t))) ! (unless (listp (cdr gnus-newsgroup-killed)) ! (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) ! (let ((headers gnus-newsgroup-headers)) ! (run-hooks 'gnus-exit-group-hook) ! (unless gnus-save-score ! (setq gnus-newsgroup-scored nil)) ! ;; Set the new ranges of read articles. ! (gnus-update-read-articles ! group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) ! ;; Set the current article marks. ! (gnus-update-marks) ! ;; Do the cross-ref thing. ! (when gnus-use-cross-reference ! (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) ! ;; 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." ! (interactive) ! (gnus-set-global-variables) ! (gnus-kill-save-kill-buffer) ! (let* ((group gnus-newsgroup-name) ! (quit-config (gnus-group-quit-config gnus-newsgroup-name)) ! (mode major-mode) ! (buf (current-buffer))) ! (run-hooks 'gnus-summary-prepare-exit-hook) ! ;; If we have several article buffers, we kill them at exit. ! (unless gnus-single-article-buffer ! (gnus-kill-buffer gnus-original-article-buffer) ! (setq gnus-article-current nil)) ! (when gnus-use-cache ! (gnus-cache-possibly-remove-articles) ! (gnus-cache-save-buffers)) ! (when gnus-use-trees ! (gnus-tree-close group)) ! ;; Make all changes in this group permanent. ! (unless quit-config ! (gnus-summary-update-info)) ! (gnus-close-group group) ! ;; Make sure where I was, and go to next newsgroup. ! (set-buffer gnus-group-buffer) ! (unless quit-config ! (gnus-group-jump-to-group group)) ! (run-hooks 'gnus-summary-exit-hook) ! (unless quit-config ! (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) ! (gnus-kill-buffer gnus-original-article-buffer) ! (setq gnus-article-current nil)) ! (set-buffer buf) ! (if (not gnus-kill-summary-on-exit) ! (gnus-deaden-summary) ! ;; 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) ! (when (get-buffer gnus-article-buffer) ! (bury-buffer gnus-article-buffer)) ! ;; 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) ! (pop-to-buffer gnus-group-buffer) ! ;; Clear the current group name. ! (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))))) ! ! (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) ! (defun gnus-summary-exit-no-update (&optional no-questions) ! "Quit reading current newsgroup without updating read article info." ! (interactive) ! (gnus-set-global-variables) ! (let* ((group gnus-newsgroup-name) ! (quit-config (gnus-group-quit-config group))) ! (when (or no-questions ! gnus-expert-user ! (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) ! (setq gnus-article-current nil)) ! (if (not gnus-kill-summary-on-exit) ! (gnus-deaden-summary) ! (gnus-close-group group) ! (gnus-summary-clear-local-variables) ! (set-buffer gnus-group-buffer) ! (gnus-summary-clear-local-variables) ! (when (get-buffer gnus-summary-buffer) ! (kill-buffer gnus-summary-buffer))) ! (unless gnus-single-article-buffer ! (setq gnus-article-current nil)) ! (when gnus-use-trees ! (gnus-tree-close group)) ! (when (get-buffer gnus-article-buffer) ! (bury-buffer gnus-article-buffer)) ! ;; Return to the group buffer. ! (gnus-configure-windows 'group 'force) ! ;; Clear the current group name. ! (setq gnus-newsgroup-name nil) ! (when (equal (gnus-group-group-name) group) ! (gnus-group-next-unread-group 1)) ! (when quit-config ! (if (not (buffer-name (car quit-config))) ! (gnus-configure-windows 'group 'force) ! (set-buffer (car quit-config)) ! (when (eq major-mode 'gnus-summary-mode) ! (gnus-set-global-variables)) ! (gnus-configure-windows (cdr quit-config))))))) ! ! ;;; Dead summaries. ! ! (defvar gnus-dead-summary-mode-map nil) ! ! (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.") ! ! (defun gnus-dead-summary-mode (&optional arg) ! "Minor mode for Gnus summary buffers." ! (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 ! (unless (assq 'gnus-dead-summary-mode minor-mode-alist) ! (push '(gnus-dead-summary-mode " Dead") minor-mode-alist)) ! (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist) ! (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map) ! minor-mode-map-alist))))) ! ! (defun gnus-deaden-summary () ! "Make the current summary buffer into a dead summary buffer." ! ;; Kill any previous dead summary buffer. ! (when (and gnus-dead-summary ! (buffer-name gnus-dead-summary)) ! (save-excursion ! (set-buffer gnus-dead-summary) ! (when gnus-dead-summary-mode ! (kill-buffer (current-buffer))))) ! ;; Make this the current dead summary. ! (setq gnus-dead-summary (current-buffer)) ! (gnus-dead-summary-mode 1) ! (let ((name (buffer-name))) ! (when (string-match "Summary" name) ! (rename-buffer ! (concat (substring name 0 (match-beginning 0)) "Dead " ! (substring name (match-beginning 0))) t)))) ! ! (defun gnus-kill-or-deaden-summary (buffer) ! "Kill or deaden the summary BUFFER." ! (when (and (buffer-name buffer) ! (not gnus-single-article-buffer)) ! (save-excursion ! (set-buffer buffer) ! (gnus-kill-buffer gnus-article-buffer) ! (gnus-kill-buffer gnus-original-article-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))) ! (save-excursion ! (set-buffer buffer) ! (gnus-deaden-summary))))) ! ! (defun gnus-summary-wake-up-the-dead (&rest args) ! "Wake up the dead summary buffer." ! (interactive) ! (gnus-dead-summary-mode -1) ! (let ((name (buffer-name))) ! (when (string-match "Dead " name) ! (rename-buffer ! (concat (substring name 0 (match-beginning 0)) ! (substring name (match-end 0))) t))) ! (gnus-message 3 "This dead summary is now alive again")) ! ! ;; Suggested by Andrew Eskilsson . ! (defun gnus-summary-fetch-faq (&optional faq-dir) ! "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)))) ! ! ;; Suggested by Per Abrahamsen . ! (defun gnus-summary-describe-group (&optional force) ! "Describe the current newsgroup." ! (interactive "P") ! (gnus-group-describe-group force gnus-newsgroup-name)) ! ! (defun gnus-summary-describe-briefly () ! "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. ! ! (defun gnus-summary-next-group (&optional no-article target-group backward) ! "Exit current newsgroup and then select next unread newsgroup. ! If prefix argument NO-ARTICLE is non-nil, no article is selected ! initially. If NEXT-GROUP, go to this group. If BACKWARD, go to ! previous group instead." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((current-group gnus-newsgroup-name) ! (current-buffer (current-buffer)) ! entered) ! ;; First we semi-exit this group to update Xrefs and all variables. ! ;; We can't do a real exit, because the window conf must remain ! ;; the same in case the user is prompted for info, and we don't ! ;; want the window conf to change before that... ! (gnus-summary-exit t) ! (while (not entered) ! ;; 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) ! ;; There are no further groups, so we return to the group ! ;; buffer. ! (progn ! (gnus-message 5 "Returning to the group buffer") ! (setq entered t) ! (set-buffer current-buffer) ! (gnus-summary-exit)) ! ;; We try to enter the target group. ! (gnus-group-jump-to-group target-group) ! (let ((unreads (gnus-group-group-unread))) ! (if (and (or (eq t unreads) ! (and unreads (not (zerop unreads)))) ! (gnus-summary-read-group ! target-group nil no-article current-buffer)) ! (setq entered t) ! (setq current-group target-group ! target-group nil))))))) ! ! (defun gnus-summary-prev-group (&optional no-article) ! "Exit current newsgroup and then select previous unread newsgroup. ! If prefix argument NO-ARTICLE is non-nil, no article is selected initially." ! (interactive "P") ! (gnus-summary-next-group no-article nil t)) ! ! ;; Walking around summary lines. ! ! (defun gnus-summary-first-subject (&optional unread) ! "Go to the first unread subject. ! If UNREAD is non-nil, go to the first unread article. ! 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") ! nil) ! ;; Pick the first article. ! ((not unread) ! (goto-char (gnus-data-pos (car gnus-newsgroup-data))) ! (gnus-data-number (car gnus-newsgroup-data))) ! ;; No unread articles. ! ((null gnus-newsgroup-unreads) ! (gnus-message 3 "No more unread articles") ! nil) ! ;; Find the first unread article. ! (t ! (let ((data gnus-newsgroup-data)) ! (while (and data ! (not (gnus-data-unread-p (car data)))) ! (setq data (cdr data))) ! (if data ! (progn ! (goto-char (gnus-data-pos (car data))) ! (gnus-data-number (car data))))))) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-next-subject (n &optional unread dont-display) ! "Go to next N'th summary line. ! If N is negative, go to the previous N'th subject line. ! If UNREAD is non-nil, only unread articles are selected. ! The difference between N and the actual number of steps taken is ! returned." ! (interactive "p") ! (let ((backward (< n 0)) ! (n (abs n))) ! (while (and (> n 0) ! (if backward ! (gnus-summary-find-prev unread) ! (gnus-summary-find-next unread))) ! (setq n (1- n))) ! (if (/= 0 n) (gnus-message 7 "No more%s articles" ! (if unread " unread" ""))) ! (unless dont-display ! (gnus-summary-recenter) ! (gnus-summary-position-point)) ! n)) ! ! (defun gnus-summary-next-unread-subject (n) ! "Go to next N'th unread summary line." ! (interactive "p") ! (gnus-summary-next-subject n t)) ! ! (defun gnus-summary-prev-subject (n &optional unread) ! "Go to previous N'th summary line. ! If optional argument UNREAD is non-nil, only unread article is selected." ! (interactive "p") ! (gnus-summary-next-subject (- n) unread)) ! ! (defun gnus-summary-prev-unread-subject (n) ! "Go to previous N'th unread summary line." ! (interactive "p") ! (gnus-summary-next-subject (- n) t)) ! ! (defun gnus-summary-goto-subject (article &optional force silent) ! "Go the subject line of ARTICLE. ! If FORCE, also allow jumping to articles not currently shown." ! (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 (and (vectorp force) force) t) ! (setq data (gnus-data-find article))) ! (goto-char b) ! (if (not data) ! (progn ! (unless silent ! (gnus-message 3 "Can't find article %d" article)) ! nil) ! (goto-char (gnus-data-pos data)) ! article))) ! ! ;; Walking around summary lines with displaying articles. ! ! (defun gnus-summary-expand-window (&optional arg) ! "Make the summary buffer take up the entire Emacs frame. ! Given a prefix, will force an `article' buffer configuration." ! (interactive "P") ! (gnus-set-global-variables) ! (if arg ! (gnus-configure-windows 'article 'force) ! (gnus-configure-windows 'summary 'force))) ! ! (defun gnus-summary-display-article (article &optional all-header) ! "Display ARTICLE in article buffer." ! (gnus-set-global-variables) ! (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) ! (unless (zerop gnus-current-article) ! (gnus-summary-goto-subject gnus-current-article)) ! (gnus-summary-recenter) ! (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)))))) ! ! (defun gnus-summary-select-article (&optional all-headers force pseudo article) ! "Select the current article. ! If ALL-HEADERS is non-nil, show all header fields. If FORCE is ! non-nil, the article will be re-fetched even if it already present in ! the article buffer. If PSEUDO is non-nil, pseudo-articles will also ! be displayed." ! ;; Make sure we are in the summary buffer to work around bbdb bug. ! (unless (eq major-mode 'gnus-summary-mode) ! (set-buffer gnus-summary-buffer)) ! (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 ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (if (or (and gnus-single-article-buffer ! (or (null gnus-current-article) ! (null gnus-article-current) ! (null (get-buffer gnus-article-buffer)) ! (not (eq article (cdr gnus-article-current))) ! (not (equal (car gnus-article-current) ! gnus-newsgroup-name)))) ! (and (not gnus-single-article-buffer) ! (or (null gnus-current-article) ! (not (eq gnus-current-article article)))) ! force) ! ;; The requested article is different from the current article. ! (prog1 ! (gnus-summary-display-article article all-headers) ! (setq did article)) ! (if (or all-headers gnus-show-all-headers) ! (gnus-article-show-all-headers)) ! 'old)) ! (if did ! (gnus-article-set-window-start ! (cdr (assq article gnus-newsgroup-bookmarks))))))) ! ! (defun gnus-summary-set-current-mark (&optional current-mark) ! "Obsolete function." ! nil) ! ! (defun gnus-summary-next-article (&optional unread subject backward push) ! "Select the next article. ! If UNREAD, only unread articles are selected. ! If SUBJECT, only articles with SUBJECT are selected. ! If BACKWARD, the previous article is selected instead of the next." ! (interactive "P") ! (gnus-set-global-variables) ! (cond ! ;; Is there such an article? ! ((and (gnus-summary-search-forward unread subject backward) ! (or (gnus-summary-display-article (gnus-summary-article-number)) ! (eq (gnus-summary-article-mark) gnus-canceled-mark))) ! (gnus-summary-position-point)) ! ;; If not, we try the first unread, if that is wanted. ! ((and subject ! gnus-auto-select-same ! (gnus-summary-first-unread-article)) ! (gnus-summary-position-point) ! (gnus-message 6 "Wrapped")) ! ;; 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. ! (t ! (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 ! ((or (not gnus-auto-select-next) ! (not cmd)) ! (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ! ((or (eq gnus-auto-select-next 'quietly) ! (and (eq gnus-auto-select-next 'slightly-quietly) ! push) ! (and (eq gnus-auto-select-next 'almost-quietly) ! (gnus-summary-last-article-p))) ! ;; Select quietly. ! (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) ! (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) ! (?\C-p (gnus-group-prev-unread-group 1)))) ! keve key group ended) ! (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 ! 5 "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 ! (car (gnus-gethash group gnus-newsrc-hashtb))) ! (format " (Type %s to exit %s)" ! (single-key-description cmd) ! gnus-newsgroup-name))) ! ;; 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) ! (and group ! (gnus-group-jump-to-group group)) ! (eval (cadr (assq key keystrokes))) ! (setq group (gnus-group-group-name)) ! (switch-to-buffer obuf)) ! (setq ended nil)) ! ((equal key cmd) ! (if (or (not group) ! (gnus-ephemeral-group-p gnus-newsgroup-name)) ! (gnus-summary-exit) ! (gnus-summary-next-group nil group backward))) ! (t ! (push (cdr keve) unread-command-events)))))) ! ! (defun gnus-read-event-char () ! "Get the next event." ! (let ((event (read-event))) ! (cons (and (numberp event) event) event))) ! ! (defun gnus-summary-next-unread-article () ! "Select unread article after current one." ! (interactive) ! (gnus-summary-next-article t (and gnus-auto-select-same ! (gnus-summary-article-subject)))) ! ! (defun gnus-summary-prev-article (&optional unread subject) ! "Select the article after the current one. ! If UNREAD is non-nil, only unread articles are selected." ! (interactive "P") ! (gnus-summary-next-article unread subject t)) ! ! (defun gnus-summary-prev-unread-article () ! "Select unred article before current one." ! (interactive) ! (gnus-summary-prev-article t (and gnus-auto-select-same ! (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) ! (let ((article (gnus-summary-article-number)) ! (endp nil)) ! (gnus-configure-windows 'article) ! (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) ! (if (and (eq gnus-summary-goto-unread 'never) ! (not (gnus-summary-last-article-p article))) ! (gnus-summary-next-article) ! (gnus-summary-next-unread-article)) ! (if (or (null gnus-current-article) ! (null gnus-article-current) ! (/= article (cdr gnus-article-current)) ! (not (equal (car gnus-article-current) gnus-newsgroup-name))) ! ;; Selected subject is different from current article's. ! (gnus-summary-display-article article) ! (gnus-eval-in-buffer-window 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 (and (eq gnus-summary-goto-unread 'never) ! (not (gnus-summary-last-article-p article))) ! (gnus-summary-next-article) ! (gnus-summary-next-unread-article))))))) ! (gnus-summary-recenter) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-prev-page (&optional lines) ! "Show previous page of selected article. ! Argument LINES specifies lines to be scrolled down." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((article (gnus-summary-article-number))) ! (gnus-configure-windows 'article) ! (if (or (null gnus-current-article) ! (null gnus-article-current) ! (/= article (cdr gnus-article-current)) ! (not (equal (car gnus-article-current) gnus-newsgroup-name))) ! ;; Selected subject is different from current article's. ! (gnus-summary-display-article article) ! (gnus-summary-recenter) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (gnus-article-prev-page lines)))) ! (gnus-summary-position-point)) ! ! (defun gnus-summary-scroll-up (lines) ! "Scroll up (or down) one line current article. ! Argument LINES specifies lines to be scrolled up (or down if negative)." ! (interactive "p") ! (gnus-set-global-variables) ! (gnus-configure-windows 'article) ! (gnus-summary-show-thread) ! (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (cond ((> lines 0) ! (if (gnus-article-next-page lines) ! (gnus-message 3 "End of message"))) ! ((< lines 0) ! (gnus-article-prev-page (- lines)))))) ! (gnus-summary-recenter) ! (gnus-summary-position-point)) ! ! (defun gnus-summary-next-same-subject () ! "Select next article which has the same subject as current one." ! (interactive) ! (gnus-set-global-variables) ! (gnus-summary-next-article nil (gnus-summary-article-subject))) ! ! (defun gnus-summary-prev-same-subject () ! "Select previous article which has the same subject as current one." ! (interactive) ! (gnus-set-global-variables) ! (gnus-summary-prev-article nil (gnus-summary-article-subject))) ! ! (defun gnus-summary-next-unread-same-subject () ! "Select next unread article which has the same subject as current one." ! (interactive) ! (gnus-set-global-variables) ! (gnus-summary-next-article t (gnus-summary-article-subject))) ! ! (defun gnus-summary-prev-unread-same-subject () ! "Select previous unread article which has the same subject as current one." ! (interactive) ! (gnus-set-global-variables) ! (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) ! (prog1 ! (if (gnus-summary-first-subject t) ! (progn ! (gnus-summary-show-thread) ! (gnus-summary-first-subject t) ! (gnus-summary-display-article (gnus-summary-article-number)))) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-best-unread-article () ! "Select the unread article with the highest score." ! (interactive) ! (gnus-set-global-variables) ! (let ((best -1000000) ! (data gnus-newsgroup-data) ! 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 ! article (gnus-data-number (car data)))) ! (setq data (cdr data))) ! (prog1 ! (if article ! (gnus-summary-goto-article article) ! (error "No unread articles")) ! (gnus-summary-position-point)))) ! ! (defun gnus-summary-last-subject () ! "Go to the last displayed subject line in the group." ! (let ((article (gnus-data-number (car (gnus-data-list t))))) ! (when article ! (gnus-summary-goto-subject article)))) ! ! (defun gnus-summary-goto-article (article &optional all-headers force) ! "Fetch ARTICLE and display it if it exists. ! If ALL-HEADERS is non-nil, no header lines are hidden." ! (interactive ! (list ! (string-to-int ! (completing-read ! "Article number: " ! (mapcar (lambda (number) (list (int-to-string number))) ! gnus-newsgroup-limit))) ! current-prefix-arg ! t)) ! (prog1 ! (if (gnus-summary-goto-subject article force) ! (gnus-summary-display-article article all-headers) ! (gnus-message 4 "Couldn't go to article %s" article) nil) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-goto-last-article () ! "Go to the previously read article." ! (interactive) ! (prog1 ! (and gnus-last-article ! (gnus-summary-goto-article gnus-last-article)) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-pop-article (number) ! "Pop one article off the history and go to the previous. ! NUMBER articles will be popped off." ! (interactive "p") ! (let (to) ! (setq gnus-newsgroup-history ! (cdr (setq to (nthcdr number gnus-newsgroup-history)))) ! (if to ! (gnus-summary-goto-article (car to)) ! (error "Article history empty"))) ! (gnus-summary-position-point)) ! ! ;; Summary commands and functions for limiting the summary buffer. ! ! (defun gnus-summary-limit-to-articles (n) ! "Limit the summary buffer to the next N articles. ! If not given a prefix, use the process marked articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (prog1 ! (let ((articles (gnus-summary-work-articles n))) ! (setq gnus-newsgroup-processable nil) ! (gnus-summary-limit articles)) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-pop-limit (&optional total) ! "Restore the previous limit. ! If given a prefix, remove all limits." ! (interactive "P") ! (gnus-set-global-variables) ! (when total ! (setq gnus-newsgroup-limits ! (list (mapcar (lambda (h) (mail-header-number h)) ! gnus-newsgroup-headers)))) ! (unless gnus-newsgroup-limits ! (error "No limit to pop")) ! (prog1 ! (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 ! (or header "subject") subject 'all))) ! (or articles (error "Found no matches for \"%s\"" subject)) ! (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) ! "Limit the summary buffer to articles that are not marked as read. ! If ALL is non-nil, limit strictly to unread articles." ! (interactive "P") ! (if all ! (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 ! gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark) ! 'reverse))) ! ! (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) ! (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) ! ! (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) ! (prog1 ! (let ((data gnus-newsgroup-data) ! (marks (if (listp marks) marks ! (append marks nil))) ; Transform to list. ! articles) ! (while data ! (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) ! (memq (gnus-data-mark (car data)) marks)) ! (setq articles (cons (gnus-data-number (car data)) articles))) ! (setq data (cdr data))) ! (gnus-summary-limit articles)) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-limit-to-score (&optional score) ! "Limit to articles with score at or above SCORE." ! (interactive "P") ! (gnus-set-global-variables) ! (setq score (if score ! (prefix-numeric-value score) ! (or gnus-summary-default-score 0))) ! (let ((data gnus-newsgroup-data) ! articles) ! (while data ! (when (>= (gnus-summary-article-score (gnus-data-number (car data))) ! score) ! (push (gnus-data-number (car data)) articles)) ! (setq data (cdr data))) ! (prog1 ! (gnus-summary-limit articles) ! (gnus-summary-position-point)))) ! ! (defun gnus-summary-limit-include-dormant () ! "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)) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-limit-exclude-dormant () ! "Hide all dormant articles." ! (interactive) ! (gnus-set-global-variables) ! (prog1 ! (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-limit-exclude-childless-dormant () ! "Hide all dormant articles that have no children." ! (interactive) ! (gnus-set-global-variables) ! (let ((data (gnus-data-list t)) ! articles d children) ! ;; Find all articles that are either not dormant or have ! ;; children. ! (while (setq d (pop data)) ! (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) ! (and (setq children ! (gnus-article-children (gnus-data-number d))) ! (let (found) ! (while children ! (when (memq (car children) articles) ! (setq children nil ! found t)) ! (pop children)) ! found))) ! (push (gnus-data-number d) articles))) ! ;; Do the limiting. ! (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) ! (let ((total (length gnus-newsgroup-data)) ! (data (gnus-data-find-list (gnus-summary-article-number))) ! (gnus-summary-mark-below nil) ; Inhibit this. ! found) ! ;; This will do all the work of generating the new summary buffer ! ;; according to the new limit. ! (gnus-summary-prepare) ! ;; Hide any threads, possibly. ! (and gnus-show-threads ! gnus-thread-hide-subtree ! (gnus-summary-hide-all-threads)) ! ;; Try to return to the article you were at, or one 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)) ! (setq data (cdr data)))) ! (or found ! ;; If there is no data, that means that we were after the last ! ;; article. The same goes when we can't find any articles ! ;; after the current one. ! (progn ! (goto-char (point-max)) ! (gnus-summary-find-prev))) ! ;; We return how many articles were removed from the summary ! ;; buffer as a result of the new limit. ! (- total (length gnus-newsgroup-data)))) ! ! (defsubst gnus-invisible-cut-children (threads) ! (let ((num 0)) ! (while threads ! (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) ! (incf num)) ! (pop threads)) ! (< num 2))) ! ! (defsubst gnus-cut-thread (thread) ! "Go forwards in the thread until we find an article that we want to display." ! (when (or (eq gnus-fetch-old-headers 'some) ! (eq gnus-build-sparse-threads 'some) ! (eq gnus-build-sparse-threads 'more)) ! ;; Deal with old-fetched headers and sparse threads. ! (while (and ! thread ! (or ! (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) ! (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)) ! (or (<= (length (cdr thread)) 1) ! (gnus-invisible-cut-children (cdr thread)))) ! (setq thread (cadr thread)))) ! 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) ! (eq gnus-build-sparse-threads 'more)) ! (let ((th threads)) ! (while th ! (setcar th (gnus-cut-thread (car th))) ! (setq th (cdr th))))) ! ;; Remove nixed out threads. ! (delq nil threads)) ! ! (defun gnus-summary-initial-limit (&optional show-if-empty) ! "Figure out what the initial limit is supposed to be on group entry. ! This entails weeding out unwanted dormants, low-scored articles, ! fetch-old-headers verbiage, and so on." ! ;; Most groups have nothing to remove. ! (if (or gnus-inhibit-limiting ! (and (null gnus-newsgroup-dormant) ! (not (eq gnus-fetch-old-headers 'some)) ! (null gnus-summary-expunge-below) ! (not (eq gnus-build-sparse-threads 'some)) ! (not (eq gnus-build-sparse-threads 'more)) ! (null gnus-thread-expunge-below) ! (not gnus-use-nocem))) ! () ; Do nothing. ! (push gnus-newsgroup-limit gnus-newsgroup-limits) ! (setq gnus-newsgroup-limit nil) ! (mapatoms ! (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)) ! (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)) ! ! (defun gnus-summary-limit-children (thread) ! "Return 1 if this subthread is visible and 0 if it is not." ! ;; First we get the number of visible children to this thread. This ! ;; 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 "fetch-old-headered" and there is only one ! ;; visible child (or less), then we don't want this article. ! (and (eq gnus-fetch-old-headers 'some) ! (memq number gnus-newsgroup-ancient) ! (zerop children)) ! ;; If this is a sparsely inserted article with no children, ! ;; we don't want it. ! (and (eq gnus-build-sparse-threads 'some) ! (memq number gnus-newsgroup-sparse) ! (zerop children)) ! ;; If we use expunging, and this article is really ! ;; low-scored, then we don't want this article. ! (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) ! (and gnus-use-nocem ! (gnus-nocem-unwanted-article-p (mail-header-id (car thread))))) ! ;; 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) ! (push (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))) ! ;; Go recursively through all subthreads. ! (mapcar 'gnus-expunge-thread (cdr thread))) ! ! ;; Summary article oriented commands ! ! (defun gnus-summary-refer-parent-article (n) ! "Refer parent article N times. ! 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 ! (message-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 (setq ref (or ref (mail-header-references header))) ! (or (gnus-summary-refer-article (gnus-parent-id ref)) ! (gnus-message 1 "Couldn't find parent")) ! (gnus-message 1 "No references in article %d" ! (gnus-summary-article-number)) ! nil))) ! (setq n (1- n))) ! (gnus-summary-position-point) ! n) ! ! (defun gnus-summary-refer-references () ! "Fetch all articles mentioned in the References header. ! Return how many articles were fetched." ! (interactive) ! (gnus-set-global-variables) ! (let ((ref (mail-header-references (gnus-summary-article-header))) ! (current (gnus-summary-article-number)) ! (n 0)) ! ;; For each Message-ID in the References header... ! (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: ") ! (when (and (stringp message-id) ! (not (zerop (length message-id)))) ! ;; Construct the correct Message-ID if necessary. ! ;; Suggested by tale@pawl.rpi.edu. ! (unless (string-match "^<" message-id) ! (setq message-id (concat "<" message-id))) ! (unless (string-match ">$" message-id) ! (setq message-id (concat message-id ">"))) ! (let* ((header (gnus-id-to-header message-id)) ! (sparse (and header ! (memq (mail-header-number header) ! gnus-newsgroup-sparse)))) ! (if header ! (prog1 ! ;; The article is present in the buffer, to we just go to it. ! (gnus-summary-goto-article ! (mail-header-number header) nil header) ! (when sparse ! (gnus-summary-update-article (mail-header-number header)))) ! ;; We fetch the article ! (let ((gnus-override-method ! (and (gnus-news-group-p gnus-newsgroup-name) ! gnus-refer-article-method)) ! number) ! ;; Start the special refer-article method, if necessary. ! (when (and gnus-refer-article-method ! (gnus-news-group-p gnus-newsgroup-name)) ! (gnus-check-server gnus-refer-article-method)) ! ;; Fetch the header, and display the article. ! (if (setq number (gnus-summary-insert-subject message-id)) ! (gnus-summary-select-article nil nil nil number) ! (gnus-message 3 "Couldn't fetch article %s" message-id))))))) ! ! (defun gnus-summary-enter-digest-group (&optional force) ! "Enter a digest group based on the current article." ! (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) ! (case-fold-search t) ! (buf (current-buffer)) ! dig) ! (save-excursion ! (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) ! (insert-buffer-substring gnus-original-article-buffer) ! (narrow-to-region ! (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point))) ! (goto-char (point-min)) ! (delete-matching-lines "^\\(Path\\):\\|^From ") ! (widen)) ! (unwind-protect ! (if (gnus-group-read-ephemeral-group ! name `(nndoc ,name (nndoc-address ! ,(get-buffer dig)) ! (nndoc-article-type ,(if force 'digest 'guess))) t) ! ;; Make all postings to this group go to the parent group. ! (nconc (gnus-info-params (gnus-get-info name)) ! (list (cons 'to-group ogroup))) ! ;; Couldn't select this doc group. ! (switch-to-buffer buf) ! (gnus-set-global-variables) ! (gnus-configure-windows 'summary) ! (gnus-message 3 "Article couldn't be entered?")) ! (kill-buffer dig)))) ! ! (defun gnus-summary-isearch-article (&optional regexp-p) ! "Do incremental search forward on the current article. ! If REGEXP-P (the prefix) is non-nil, do regexp isearch." ! (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))) ! ! (defun gnus-summary-search-article-forward (regexp &optional backward) ! "Search for an article containing REGEXP forward. ! If BACKWARD, search backward instead." ! (interactive ! (list (read-string ! (format "Search article %s (regexp%s): " ! (if current-prefix-arg "backward" "forward") ! (if gnus-last-search-regexp ! (concat ", default " gnus-last-search-regexp) ! ""))) ! current-prefix-arg)) ! (gnus-set-global-variables) ! (if (string-equal regexp "") ! (setq regexp (or gnus-last-search-regexp "")) ! (setq gnus-last-search-regexp regexp)) ! (unless (gnus-summary-search-article regexp backward) ! (error "Search failed: \"%s\"" regexp))) ! ! (defun gnus-summary-search-article-backward (regexp) ! "Search for an article containing REGEXP backward." ! (interactive ! (list (read-string ! (format "Search article backward (regexp%s): " ! (if gnus-last-search-regexp ! (concat ", default " gnus-last-search-regexp) ! ""))))) ! (gnus-summary-search-article-forward regexp 'backward)) ! ! (defun gnus-summary-search-article (regexp &optional backward) ! "Search for an article containing REGEXP. ! Optional argument BACKWARD means do search for backward. ! `gnus-select-article-hook' is not called during the search." ! (let ((gnus-select-article-hook nil) ;Disable hook. ! (gnus-article-display-hook nil) ! (gnus-mark-article-hook nil) ;Inhibit marking as read. ! (re-search ! (if backward ! 're-search-backward 're-search-forward)) ! (sum (current-buffer)) ! (found nil)) ! (gnus-save-hidden-threads ! (gnus-summary-select-article) ! (set-buffer gnus-article-buffer) ! (when backward ! (forward-line -1)) ! (while (not found) ! (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) ! (if (if backward ! (re-search-backward regexp nil t) ! (re-search-forward regexp nil t)) ! ;; We found the regexp. ! (progn ! (setq found 'found) ! (beginning-of-line) ! (set-window-start ! (get-buffer-window (current-buffer)) ! (point)) ! (forward-line 1) ! (set-buffer sum)) ! ;; We didn't find it, so we go to the next article. ! (set-buffer sum) ! (if (not (if backward (gnus-summary-find-prev) ! (gnus-summary-find-next))) ! ;; No more articles. ! (setq found t) ! ;; Select the next article and adjust point. ! (gnus-summary-select-article) ! (set-buffer gnus-article-buffer) ! (widen) ! (goto-char (if backward (point-max) (point-min)))))) ! (gnus-message 7 "")) ! ;; Return whether we found the regexp. ! (when (eq found 'found) ! (gnus-summary-show-thread) ! (gnus-summary-goto-subject gnus-current-article) ! (gnus-summary-position-point) ! t))) ! ! (defun gnus-summary-find-matching (header regexp &optional backward unread ! not-case-fold) ! "Return a list of all articles that match REGEXP on HEADER. ! The search stars on the current article and goes forwards unless ! BACKWARD is non-nil. If BACKWARD is `all', do all articles. ! If UNREAD is non-nil, only unread articles will ! 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 (intern (concat "mail-header-" header))) ! (error "%s is not a valid header" header)) ! (while data ! (setq d (car data)) ! (and (or (not unread) ; We want all articles... ! (gnus-data-unread-p d)) ; Or just unreads. ! (vectorp (gnus-data-header d)) ; It's not a pseudo. ! (string-match regexp (funcall func (gnus-data-header d))) ; Match. ! (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" ! "Message-ID" "Xref" "References" "Body")) ! nil 'require-match)) ! (read-string "Regexp: ") ! (read-key-sequence "Command: ") ! current-prefix-arg)) ! (when (equal header "Body") ! (setq header "")) ! (gnus-set-global-variables) ! ;; Hidden thread subtrees must be searched as well. ! (gnus-summary-show-all-threads) ! ;; We don't want to change current point nor window configuration. ! (save-excursion ! (save-window-excursion ! (gnus-message 6 "Executing %s..." (key-description command)) ! ;; We'd like to execute COMMAND interactively so as to give arguments. ! (gnus-execute header regexp ! `(lambda () (call-interactively ',(key-binding command))) ! backward) ! (gnus-message 6 "Executing %s...done" (key-description command))))) ! ! (defun gnus-summary-beginning-of-article () ! "Scroll the article back to the beginning." ! (interactive) ! (gnus-set-global-variables) ! (gnus-summary-select-article) ! (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (widen) ! (goto-char (point-min)) ! (and gnus-break-pages (gnus-narrow-to-page)))) ! ! (defun gnus-summary-end-of-article () ! "Scroll to the end of the article." ! (interactive) ! (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)) ! (recenter -3) ! (and gnus-break-pages (gnus-narrow-to-page)))) ! ! (defun gnus-summary-show-article (&optional arg) ! "Force re-fetching of the current article. ! If ARG (the prefix) is non-nil, show the raw article without any ! article massaging functions being run." ! (interactive "P") ! (gnus-set-global-variables) ! (if (not arg) ! ;; Select the article the normal way. ! (gnus-summary-select-article nil 'force) ! ;; Bind the article treatment functions to nil. ! (let ((gnus-have-all-headers t) ! gnus-article-display-hook ! gnus-article-prepare-hook ! gnus-break-pages ! gnus-visual) ! (gnus-summary-select-article nil 'force))) ! (gnus-summary-goto-subject gnus-current-article) ! ; (gnus-configure-windows 'article) ! (gnus-summary-position-point)) ! ! (defun gnus-summary-verbose-headers (&optional arg) ! "Toggle permanent full header display. ! If ARG is a positive number, turn header display on. ! If ARG is a negative number, turn header display off." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-toggle-header arg) ! (setq gnus-show-all-headers ! (cond ((or (not (numberp arg)) ! (zerop arg)) ! (not gnus-show-all-headers)) ! ((natnump arg) ! t)))) ! ! (defun gnus-summary-toggle-header (&optional arg) ! "Show the headers if they are hidden, or hide them if they are shown. ! If ARG is a positive number, show the entire header. ! If ARG is a negative number, hide the unwanted header lines." ! (interactive "P") ! (gnus-set-global-variables) ! (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) ! (goto-char (point-min)) ! (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))))) ! (insert-buffer-substring gnus-original-article-buffer 1 e) ! (let ((gnus-inhibit-hiding t)) ! (run-hooks 'gnus-article-display-hook)) ! (if (or (not hidden) (and (numberp arg) (< arg 0))) ! (gnus-article-hide-headers))))) ! ! (defun gnus-summary-show-all-headers () ! "Make all header lines visible." ! (interactive) ! (gnus-set-global-variables) ! (gnus-article-show-all-headers)) ! ! (defun gnus-summary-toggle-mime (&optional arg) ! "Toggle MIME processing. ! If ARG is a positive number, turn MIME processing on." ! (interactive "P") ! (gnus-set-global-variables) ! (setq gnus-show-mime ! (if (null arg) (not gnus-show-mime) ! (> (prefix-numeric-value arg) 0))) ! (gnus-summary-select-article t 'force)) ! ! (defun gnus-summary-caesar-message (&optional arg) ! "Caesar rotate the current article by 13. ! The numerical prefix specifies how manu places to rotate each letter ! forward." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-select-article) ! (let ((mail-header-separator "")) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (save-restriction ! (widen) ! (let ((start (window-start)) ! buffer-read-only) ! (message-caesar-buffer-body arg) ! (set-window-start (get-buffer-window (current-buffer)) start)))))) ! ! (defun gnus-summary-stop-page-breaking () ! "Stop page breaking in the current article." ! (interactive) ! (gnus-set-global-variables) ! (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 non-nil, 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 "P") ! (unless action (setq action 'move)) ! (gnus-set-global-variables) ! ;; Check whether the source group supports the required functions. ! (cond ((and (eq action 'move) ! (not (gnus-check-backend-function ! 'request-move-article gnus-newsgroup-name))) ! (error "The current group does not support article moving")) ! ((and (eq action 'crosspost) ! (not (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 to-groups) ! (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)) ! (symbol-value (intern (format "gnus-current-%s-group" action))) ! articles prefix)) ! (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) ! (setq to-method (or select-method ! (gnus-group-name-to-method 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 (car 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 ! to-newsgroup (list 'quote select-method) ! (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 ! to-newsgroup select-method (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 ! to-newsgroup select-method (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) ! (or select-method ! (gnus-find-method-for-group to-newsgroup))) ! gnus-newsrc-hashtb))) ! (info (nth 2 entry)) ! (to-group (gnus-info-group info))) ! ;; Update the group that has been moved to. ! (when (and info ! (memq action '(move copy))) ! (unless (member to-group to-groups) ! (push to-group to-groups)) ! ! (unless (memq article gnus-newsgroup-unreads) ! (gnus-info-set-read ! info (gnus-add-to-range (gnus-info-read info) ! (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 ! to-group 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))))) ! ;; If the other group is the same as this group, ! ;; then we have to add the mark to the list. ! (when (equal to-group gnus-newsgroup-name) ! (set (intern (format "gnus-newsgroup-%s" (caar marks))) ! (cons to-article ! (symbol-value ! (intern (format "gnus-newsgroup-%s" ! (caar marks))))))) ! ;; Copy mark to other group. ! (gnus-add-marked-articles ! to-group (cdar 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) ! (when (eq action 'move) ! (gnus-summary-mark-article article gnus-canceled-mark))) ! (gnus-summary-remove-process-mark article)) ! ;; Re-activate all groups that have been moved to. ! (while to-groups ! (gnus-activate-group (pop to-groups))) ! ! (gnus-kill-buffer copy-buf) ! (gnus-summary-position-point) ! (gnus-set-mode-line 'summary))) ! ! (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 non-nil, do not move to a specific newsgroup, but ! re-spool using this method." ! (interactive "P") ! (gnus-summary-move-article n nil select-method '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)) ! ! (defvar gnus-summary-respool-default-method nil ! "Default method for respooling an article. ! If nil, use to the current newsgroup method.") ! ! (defun gnus-summary-respool-article (&optional n method) ! "Respool the current article. ! The article will be squeezed through the mail spooling process again, ! which means that it will be put in some mail newsgroup or other ! depending on `nnmail-split-methods'. ! If N is a positive number, respool the N next articles. ! If N is a negative number, respool the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! respool those articles instead. ! ! Respooling can be done both from mail groups and \"real\" newsgroups. ! In the former case, the articles in question will be moved from the ! current group into whatever groups they are destined to. In the ! latter case, they will be copied into the relevant groups." ! (interactive ! (list current-prefix-arg ! (let* ((methods (gnus-methods-using 'respool)) ! (methname ! (symbol-name (or gnus-summary-respool-default-method ! (car (gnus-find-method-for-group ! gnus-newsgroup-name))))) ! (method ! (gnus-completing-read ! methname "What backend do you want to use when respooling?" ! methods nil t nil 'gnus-method-history)) ! ms) ! (cond ! ((zerop (length (setq ms (gnus-servers-using-backend method)))) ! (list (intern method) "")) ! ((= 1 (length ms)) ! (car ms)) ! (t ! (cdr (completing-read ! "Server name: " ! (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t))))))) ! (gnus-set-global-variables) ! (unless method ! (error "No method given for respooling")) ! (if (assoc (symbol-name ! (car (gnus-find-method-for-group gnus-newsgroup-name))) ! (gnus-methods-using 'respool)) ! (gnus-summary-move-article n nil method) ! (gnus-summary-copy-article n nil 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)) ! (or (file-readable-p file) ! (not (file-regular-p file)) ! (error "Can't read %s" file)) ! (save-excursion ! (set-buffer (get-buffer-create " *import file*")) ! (buffer-disable-undo (current-buffer)) ! (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: " (message-make-message-id) "\n" ! "Lines: " (int-to-string lines) "\n" ! "Chars: " (int-to-string (nth 7 atts)) "\n\n")) ! (gnus-request-accept-article group nil t) ! (kill-buffer (current-buffer))))) ! ! (defun gnus-summary-expire-articles (&optional now) ! "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)) ! (expirable (if total ! (gnus-list-of-read-articles gnus-newsgroup-name) ! (setq gnus-newsgroup-expirable ! (sort gnus-newsgroup-expirable '<)))) ! (expiry-wait (if now 'immediate ! (gnus-group-get-parameter ! gnus-newsgroup-name 'expiry-wait))) ! es) ! (when expirable ! ;; There are expirable articles in this group, so we run them ! ;; through the expiry process. ! (gnus-message 6 "Expiring articles...") ! ;; The list of articles that weren't expired is returned. ! (if expiry-wait ! (let ((nnmail-expiry-wait-function nil) ! (nnmail-expiry-wait expiry-wait)) ! (setq es (gnus-request-expire-articles ! expirable gnus-newsgroup-name))) ! (setq es (gnus-request-expire-articles ! expirable gnus-newsgroup-name))) ! (or total (setq gnus-newsgroup-expirable es)) ! ;; We go through the old list of expirable, and mark all ! ;; really expired articles as nonexistent. ! (unless (eq es expirable) ;If nothing was expired, we don't mark. ! (let ((gnus-use-cache nil)) ! (while expirable ! (unless (memq (car expirable) es) ! (when (gnus-data-find (car expirable)) ! (gnus-summary-mark-article ! (car expirable) gnus-canceled-mark))) ! (setq expirable (cdr expirable))))) ! (gnus-message 6 "Expiring articles...done"))))) ! ! (defun gnus-summary-expire-articles-now () ! "Expunge all expirable articles in the current group. ! This means that *all* articles that are marked as expirable will be ! deleted forever, right now." ! (interactive) ! (gnus-set-global-variables) ! (or gnus-expert-user ! (gnus-y-or-n-p ! "Are you really, really, really sure you want to delete all these messages? ") ! (error "Phew!")) ! (gnus-summary-expire-articles t)) ! ! ;; 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) ! (format "these %s articles" (length 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)))) ! (gnus-summary-position-point) ! (gnus-set-mode-line 'summary) ! not-deleted)) ! ! (defun gnus-summary-edit-article (&optional force) ! "Enter into a buffer and edit the current article. ! This will have permanent effect only in mail groups. ! If FORCE is non-nil, allow editing of articles even in read-only ! groups." ! (interactive "P") ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-set-global-variables) ! (when (and (not force) ! (gnus-group-read-only-p)) ! (error "The current newsgroup does not support article editing.")) ! (gnus-summary-select-article t nil t) ! (gnus-configure-windows 'article) ! (select-window (get-buffer-window gnus-article-buffer)) ! (gnus-message 6 "C-c C-c to end edits") ! (setq buffer-read-only nil) ! (text-mode) ! (use-local-map (copy-keymap (current-local-map))) ! (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) ! (buffer-enable-undo) ! (widen) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t))) ! ! (defun gnus-summary-edit-article-done () ! "Make edits to the current article permanent." ! (interactive) ! (if (gnus-group-read-only-p) ! (progn ! (let ((beep (not (eq major-mode 'text-mode)))) ! (gnus-summary-edit-article-postpone) ! (when beep ! (gnus-error ! 3 "The current newsgroup does not support article editing.")))) ! (let ((buf (format "%s" (buffer-string)))) ! (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)) ! (when gnus-use-cache ! (gnus-cache-update-article ! (car gnus-article-current) (cdr gnus-article-current))) ! (when gnus-keep-backlog ! (gnus-backlog-remove-article ! (car gnus-article-current) (cdr gnus-article-current)))) ! (save-excursion ! (when (get-buffer gnus-original-article-buffer) ! (set-buffer gnus-original-article-buffer) ! (setq gnus-original-article nil))) ! (setq gnus-article-current nil ! gnus-current-article nil) ! (run-hooks 'gnus-article-display-hook) ! (and (gnus-visual-p 'summary-highlight 'highlight) ! (run-hooks 'gnus-visual-mark-article-hook))))) ! ! (defun gnus-summary-edit-article-postpone () ! "Postpone changes to the current article." ! (interactive) ! (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))) ! ! (defun gnus-summary-respool-query () ! "Query where the respool algorithm would put this article." ! (interactive) ! (gnus-set-global-variables) ! (gnus-summary-select-article) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (goto-char (point-min)) ! (search-forward "\n\n") ! (narrow-to-region (point-min) (point)) ! (pp-eval-expression ! (list 'quote (mapcar 'car (nnmail-article-group 'identity))))))) ! ! ;; Summary marking commands. ! ! (defun gnus-summary-kill-same-subject-and-select (&optional unmark) ! "Mark articles which has the same subject as read, and then select the next. ! If UNMARK is positive, remove any kind of mark. ! If UNMARK is negative, tick articles." ! (interactive "P") ! (gnus-set-global-variables) ! (if unmark ! (setq unmark (prefix-numeric-value unmark))) ! (let ((count ! (gnus-summary-mark-same-subject ! (gnus-summary-article-subject) unmark))) ! ;; Select next unread article. If auto-select-same mode, should ! ;; select the first unread article. ! (gnus-summary-next-article t (and gnus-auto-select-same ! (gnus-summary-article-subject))) ! (gnus-message 7 "%d article%s marked as %s" ! count (if (= count 1) " is" "s are") ! (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") ! (gnus-set-global-variables) ! (if unmark ! (setq unmark (prefix-numeric-value unmark))) ! (let ((count ! (gnus-summary-mark-same-subject ! (gnus-summary-article-subject) unmark))) ! ;; If marked as read, go to next unread subject. ! (if (null unmark) ! ;; Go to next unread subject. ! (gnus-summary-next-subject 1 t)) ! (gnus-message 7 "%d articles are marked as %s" ! count (if unmark "unread" "read")))) ! ! (defun gnus-summary-mark-same-subject (subject &optional unmark) ! "Mark articles with same SUBJECT as read, and return marked number. ! If optional argument UNMARK is positive, remove any kinds of marks. ! 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) ! (gnus-summary-find-subject subject)) ! (setq count (1+ count)))) ! ((> unmark 0) ; Tick. ! (while (and ! (progn ! (gnus-summary-mark-article-as-unread gnus-ticked-mark) ! (gnus-summary-show-thread) t) ! (gnus-summary-find-subject subject)) ! (setq count (1+ count)))) ! (t ; Mark as unread. ! (while (and ! (progn ! (gnus-summary-mark-article-as-unread gnus-unread-mark) ! (gnus-summary-show-thread) t) ! (gnus-summary-find-subject subject)) ! (setq count (1+ count))))) ! (gnus-set-mode-line 'summary) ! ;; Return the number of marked articles. ! count))) ! ! (defun gnus-summary-mark-as-processable (n &optional unmark) ! "Set the process mark on the next N articles. ! If N is negative, mark backward instead. If UNMARK is non-nil, remove ! the process mark instead. The difference between N and the actual ! number of articles marked is returned." ! (interactive "p") ! (gnus-set-global-variables) ! (let ((backward (< n 0)) ! (n (abs n))) ! (while (and ! (> n 0) ! (if unmark ! (gnus-summary-remove-process-mark ! (gnus-summary-article-number)) ! (gnus-summary-set-process-mark (gnus-summary-article-number))) ! (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) ! (setq n (1- n))) ! (if (/= 0 n) (gnus-message 7 "No more articles")) ! (gnus-summary-recenter) ! (gnus-summary-position-point) ! n)) ! ! (defun gnus-summary-unmark-as-processable (n) ! "Remove the process mark from the next N articles. ! If N is negative, mark backward instead. The difference between N and ! the actual number of articles marked is returned." ! (interactive "p") ! (gnus-set-global-variables) ! (gnus-summary-mark-as-processable n t)) ! ! (defun gnus-summary-unmark-all-processable () ! "Remove the process mark from all articles." ! (interactive) ! (gnus-set-global-variables) ! (save-excursion ! (while gnus-newsgroup-processable ! (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) ! (gnus-summary-position-point)) ! ! (defun gnus-summary-mark-as-expirable (n) ! "Mark N articles forward as expirable. ! If N is negative, mark backward instead. The difference between N and ! the actual number of articles marked is returned." ! (interactive "p") ! (gnus-set-global-variables) ! (gnus-summary-mark-forward n gnus-expirable-mark)) ! ! (defun gnus-summary-mark-article-as-replied (article) ! "Mark ARTICLE replied and update the summary line." ! (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) ! (let ((buffer-read-only nil)) ! (when (gnus-summary-goto-subject article) ! (gnus-summary-update-secondary-mark article)))) ! ! (defun gnus-summary-set-bookmark (article) ! "Set a bookmark in current article." ! (interactive (list (gnus-summary-article-number))) ! (gnus-set-global-variables) ! (if (or (not (get-buffer gnus-article-buffer)) ! (not gnus-current-article) ! (not gnus-article-current) ! (not (equal gnus-newsgroup-name (car gnus-article-current)))) ! (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 ! (min (point) ! (save-excursion ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (point))) ! (point)))) ! gnus-newsgroup-bookmarks)) ! (gnus-message 6 "A bookmark has been added to the current article.")) ! ! (defun gnus-summary-remove-bookmark (article) ! "Remove the bookmark from the current article." ! (interactive (list (gnus-summary-article-number))) ! (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.")))) ! ! ;; Suggested by Daniel Quinlan . ! (defun gnus-summary-mark-as-dormant (n) ! "Mark N articles forward as dormant. ! If N is negative, mark backward instead. The difference between N and ! the actual number of articles marked is returned." ! (interactive "p") ! (gnus-set-global-variables) ! (gnus-summary-mark-forward n gnus-dormant-mark)) ! ! (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) ! (gnus-summary-update-secondary-mark article))) ! ! (defun gnus-summary-remove-process-mark (article) ! "Remove the process mark from ARTICLE and update the summary line." ! (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) ! (when (gnus-summary-goto-subject article) ! (gnus-summary-show-thread) ! (gnus-summary-update-secondary-mark article))) ! ! (defun gnus-summary-set-saved-mark (article) ! "Set the process mark on ARTICLE and update the summary line." ! (push article gnus-newsgroup-saved) ! (when (gnus-summary-goto-subject article) ! (gnus-summary-update-secondary-mark article))) ! ! (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, ?r by default. ! The difference between N and the actual number of articles marked is ! returned." ! (interactive "p") ! (gnus-set-global-variables) ! (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) ! (gnus-summary-position-point) ! (gnus-set-mode-line 'summary) ! n)) ! ! (defun gnus-summary-mark-article-as-read (mark) ! "Mark the current article quickly as read with MARK." ! (let ((article (gnus-summary-article-number))) ! (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) ! (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)) ! ! (defun gnus-summary-mark-article-as-unread (mark) ! "Mark the current article quickly as unread with MARK." ! (let ((article (gnus-summary-article-number))) ! (if (< article 0) ! (gnus-error 1 "Unmarkable article") ! (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) ! (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) ! (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) ! (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) ! (cond ((= mark gnus-ticked-mark) ! (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)) ! ! ;; See whether the article is to be put in the cache. ! (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)))) ! ! ;; Fix the mark. ! (gnus-summary-update-mark mark 'unread)) ! t)) ! ! (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)))) ! (setq mark gnus-expirable-mark)) ! (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)) ! ! ;; See whether the article is to be put in the cache. ! (and gnus-use-cache ! (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)))) ! ! (if (gnus-summary-goto-subject article nil t) ! (let ((buffer-read-only nil)) ! (gnus-summary-show-thread) ! ;; Fix the mark. ! (gnus-summary-update-mark mark 'unread) ! t)))) ! ! (defun gnus-summary-update-secondary-mark (article) ! "Update the secondary (read, process, cache) mark." ! (gnus-summary-update-mark ! (cond ((memq article gnus-newsgroup-processable) ! gnus-process-mark) ! ((memq article gnus-newsgroup-cached) ! gnus-cached-mark) ! ((memq article gnus-newsgroup-replied) ! gnus-replied-mark) ! ((memq article gnus-newsgroup-saved) ! gnus-saved-mark) ! (t gnus-unread-mark)) ! 'replied) ! (when (gnus-visual-p 'summary-highlight 'highlight) ! (run-hooks 'gnus-summary-update-hook)) ! t) ! ! (defun gnus-summary-update-mark (mark type) ! (beginning-of-line) ! (let ((forward (cdr (assq type gnus-summary-mark-positions))) ! (buffer-read-only nil)) ! (when (and forward ! (<= (+ forward (point)) (point-max))) ! ;; Go to the right position on the line. ! (goto-char (+ forward (point))) ! ;; Replace the old mark with the new mark. ! (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. ! (let ((mark (or mark gnus-del-mark))) ! (if (= mark gnus-expirable-mark) ! (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) ! (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) ! ;; Remove from unread and marked lists. ! (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) ! (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) ! "Enter ARTICLE in the pertinent lists and remove it from others." ! (let ((mark (or mark gnus-ticked-mark))) ! (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) ! (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) ! (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) ! (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) ! (cond ((= mark gnus-ticked-mark) ! (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. ! If N is negative, tick backwards instead. ! The difference between N and the number of articles ticked is returned." ! (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. ! The difference between N and the number of articles ticked is returned." ! (interactive "p") ! (gnus-summary-mark-forward (- n) gnus-ticked-mark)) ! ! (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) ! (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) ! (defun gnus-summary-tick-article (&optional article clear-mark) ! "Mark current article as unread. ! Optional 1st argument ARTICLE specifies article number to be marked as unread. ! Optional 2nd argument CLEAR-MARK remove any kinds of mark." ! (interactive) ! (gnus-summary-mark-article article (if clear-mark gnus-unread-mark ! gnus-ticked-mark))) ! ! (defun gnus-summary-mark-as-read-forward (n) ! "Mark N articles as read forwards. ! If N is negative, mark backwards instead. ! The difference between N and the actual number of articles marked is ! returned." ! (interactive "p") ! (gnus-summary-mark-forward n gnus-del-mark t)) ! ! (defun gnus-summary-mark-as-read-backward (n) ! "Mark the N articles as read backwards. ! The difference between N and the actual number of articles marked is ! returned." ! (interactive "p") ! (gnus-summary-mark-forward (- n) gnus-del-mark t)) ! ! (defun gnus-summary-mark-as-read (&optional article mark) ! "Mark current article as read. ! ARTICLE specifies the article to be marked as read. ! MARK specifies a string to be inserted at the beginning of the line." ! (gnus-summary-mark-article article mark)) ! ! (defun gnus-summary-clear-mark-forward (n) ! "Clear marks from N articles forward. ! If N is negative, clear backward instead. ! The difference between N and the number of marks cleared is returned." ! (interactive "p") ! (gnus-summary-mark-forward n gnus-unread-mark)) ! ! (defun gnus-summary-clear-mark-backward (n) ! "Clear marks from N articles backward. ! The difference between N and the number of marks cleared is returned." ! (interactive "p") ! (gnus-summary-mark-forward (- n) gnus-unread-mark)) ! ! (defun gnus-summary-mark-unread-as-read () ! "Intended to be used by `gnus-summary-mark-article-hook'." ! (when (memq gnus-current-article gnus-newsgroup-unreads) ! (gnus-summary-mark-article gnus-current-article gnus-read-mark))) ! ! (defun gnus-summary-mark-read-and-unread-as-read () ! "Intended to be used by `gnus-summary-mark-article-hook'." ! (let ((mark (gnus-summary-article-mark))) ! (when (or (gnus-unread-mark-p mark) ! (gnus-read-mark-p mark)) ! (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) ! ! (defun gnus-summary-mark-region-as-read (point mark all) ! "Mark all unread articles between point and mark as read. ! If given a prefix, mark all articles between point and mark as read, ! even ticked and dormant ones." ! (interactive "r\nP") ! (save-excursion ! (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)) ! t) ! (gnus-summary-find-next)))))) ! ! (defun gnus-summary-mark-below (score mark) ! "Mark articles with score less than SCORE with MARK." ! (interactive "P\ncMark: ") ! (gnus-set-global-variables) ! (setq score (if score ! (prefix-numeric-value score) ! (or gnus-summary-default-score 0))) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (goto-char (point-min)) ! (while ! (progn ! (and (< (gnus-summary-article-score) score) ! (gnus-summary-mark-article nil mark)) ! (gnus-summary-find-next))))) ! ! (defun gnus-summary-kill-below (&optional score) ! "Mark articles with score below SCORE as read." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-mark-below score gnus-killed-mark)) ! ! (defun gnus-summary-clear-above (&optional score) ! "Clear all marks from articles with score above SCORE." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-mark-above score gnus-unread-mark)) ! ! (defun gnus-summary-tick-above (&optional score) ! "Tick all articles with score above SCORE." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-mark-above score gnus-ticked-mark)) ! ! (defun gnus-summary-mark-above (score mark) ! "Mark articles with score over SCORE with MARK." ! (interactive "P\ncMark: ") ! (gnus-set-global-variables) ! (setq score (if score ! (prefix-numeric-value score) ! (or gnus-summary-default-score 0))) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (goto-char (point-min)) ! (while (and (progn ! (if (> (gnus-summary-article-score) score) ! (gnus-summary-mark-article nil mark)) ! 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 (&optional no-error) ! "Display all the hidden articles that were expunged for low scores." ! (interactive) ! (gnus-set-global-variables) ! (let ((buffer-read-only nil)) ! (let ((scored gnus-newsgroup-scored) ! headers h) ! (while scored ! (or (gnus-summary-goto-subject (caar scored)) ! (and (setq h (gnus-summary-article-header (caar scored))) ! (< (cdar scored) gnus-summary-expunge-below) ! (setq headers (cons h headers)))) ! (setq scored (cdr scored))) ! (if (not headers) ! (when (not no-error) ! (error "No expunged articles hidden.")) ! (goto-char (point-min)) ! (gnus-summary-prepare-unthreaded (nreverse headers)) ! (goto-char (point-min)) ! (gnus-summary-position-point) ! t)))) ! ! (defun gnus-summary-catchup (&optional all quietly to-here not-mark) ! "Mark all articles not marked as unread in this newsgroup as read. ! If prefix argument ALL is non-nil, all articles are marked as read. ! If QUIETLY is non-nil, no questions will be asked. ! If TO-HERE is non-nil, it should be a point in the buffer. All ! articles before this point will be marked as read. ! The number of articles marked as read is returned." ! (interactive "P") ! (gnus-set-global-variables) ! (prog1 ! (if (or quietly ! (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (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 ! (when all ! (setq gnus-newsgroup-marked nil ! 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))))) ! (unless to-here ! (setq gnus-newsgroup-unreads nil)) ! (gnus-set-mode-line 'summary))) ! (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) ! (if (and (not to-here) (eq 'nnvirtual (car method))) ! (nnvirtual-catchup-group ! (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-catchup-to-here (&optional all) ! "Mark all unticked articles before the current one as read. ! If ALL is non-nil, also mark ticked and dormant articles as read." ! (interactive "P") ! (gnus-set-global-variables) ! (save-excursion ! (gnus-save-hidden-threads ! (let ((beg (point))) ! ;; We check that there are unread articles. ! (when (or all (gnus-summary-find-prev)) ! (gnus-summary-catchup all t beg))))) ! (gnus-summary-position-point)) ! ! (defun gnus-summary-catchup-all (&optional quietly) ! "Mark all articles in this newsgroup as read." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-catchup t quietly)) ! ! (defun gnus-summary-catchup-and-exit (&optional all quietly) ! "Mark all articles not marked as unread in this newsgroup as read, then exit. ! If prefix argument ALL is non-nil, all articles are marked as read." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-catchup all quietly nil 'fast) ! ;; Select next newsgroup or exit. ! (if (eq gnus-auto-select-next 'quietly) ! (gnus-summary-next-group nil) ! (gnus-summary-exit))) ! ! (defun gnus-summary-catchup-all-and-exit (&optional quietly) ! "Mark all articles in this newsgroup as read, and then exit." ! (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-catchup-and-exit t quietly)) ! ! ;; Suggested by "Arne Eofsson" . ! (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 ! (gnus-summary-catchup all)) ! (gnus-summary-next-article t nil nil t)) ! ! ;; Thread-based commands. ! ! (defun gnus-summary-articles-in-thread (&optional article) ! "Return a list of all articles in the current thread. ! If ARTICLE is non-nil, return all articles in the thread that starts ! with that article." ! (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))))) ! ((eq gnus-thread-operation-ignore-subject 'fuzzy) ! (gnus-simplify-subject-fuzzy ! (mail-header-subject (gnus-data-header (car data))))) ! (t nil))) ! (end-point (save-excursion ! (if (gnus-summary-go-to-next-thread) ! (point) (point-max)))) ! articles) ! (while (and data ! (< (gnus-data-pos (car data)) end-point)) ! (when (or (not top-subject) ! (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))))))) ! (push (gnus-data-number (car data)) articles)) ! (unless (and (setq data (cdr data)) ! (> (gnus-data-level (car data)) top-level)) ! (setq data nil))) ! ;; Return the list of articles. ! (nreverse articles))) ! ! (defun gnus-summary-rethread-current () ! "Rethread the thread the current article is part of." ! (interactive) ! (gnus-set-global-variables) ! (let* ((gnus-show-threads t) ! (article (gnus-summary-article-number)) ! (id (mail-header-id (gnus-summary-article-header))) ! (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) ! (unless id ! (error "No article on the current line")) ! (gnus-rebuild-thread id) ! (gnus-summary-goto-subject article))) ! ! (defun gnus-summary-reparent-thread () ! "Make current article child of the marked (or previous) article. ! ! Note that the re-threading will only work if `gnus-thread-ignore-subject' ! is non-nil or the Subject: of both articles are the same." ! (interactive) ! (or (not (gnus-group-read-only-p)) ! (error "The current newsgroup does not support article editing.")) ! (or (<= (length gnus-newsgroup-processable) 1) ! (error "No more than one article may be marked.")) ! (save-window-excursion ! (let ((gnus-article-buffer " *reparent*") ! (current-article (gnus-summary-article-number)) ! ; first grab the marked article, otherwise one line up. ! (parent-article (if (not (null gnus-newsgroup-processable)) ! (car gnus-newsgroup-processable) ! (save-excursion ! (if (eq (forward-line -1) 0) ! (gnus-summary-article-number) ! (error "Beginning of summary buffer.")))))) ! (or (not (eq current-article parent-article)) ! (error "An article may not be self-referential.")) ! (let ((message-id (mail-header-id ! (gnus-summary-article-header parent-article)))) ! (or (and message-id (not (equal message-id ""))) ! (error "No message-id in desired parent.")) ! (gnus-summary-select-article t t nil current-article) ! (set-buffer gnus-article-buffer) ! (setq buffer-read-only nil) ! (let ((buf (format "%s" (buffer-string)))) ! (erase-buffer) ! (insert buf)) ! (goto-char (point-min)) ! (if (search-forward-regexp "^References: " nil t) ! (insert message-id " " ) ! (insert "References: " message-id "\n")) ! (or (gnus-request-replace-article current-article ! (car gnus-article-current) ! gnus-article-buffer) ! (error "Couldn't replace article.")) ! (set-buffer gnus-summary-buffer) ! (gnus-summary-unmark-all-processable) ! (gnus-summary-rethread-current) ! (gnus-message 3 "Article %d is now the child of article %d." ! current-article parent-article))))) ! ! (defun gnus-summary-toggle-threads (&optional arg) ! "Toggle showing conversation threads. ! If ARG is positive number, turn showing conversation threads on." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) ! (setq gnus-show-threads ! (if (null arg) (not gnus-show-threads) ! (> (prefix-numeric-value arg) 0))) ! (gnus-summary-prepare) ! (gnus-summary-goto-subject current) ! (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off")) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-show-all-threads () ! "Show all threads." ! (interactive) ! (gnus-set-global-variables) ! (save-excursion ! (let ((buffer-read-only nil)) ! (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) ! (gnus-summary-position-point)) ! ! (defun gnus-summary-show-thread () ! "Show thread subtrees. ! Returns nil if no thread was there to be shown." ! (interactive) ! (gnus-set-global-variables) ! (let ((buffer-read-only nil) ! (orig (point)) ! ;; first goto end then to beg, to have point at beg after let ! (end (progn (end-of-line) (point))) ! (beg (progn (beginning-of-line) (point)))) ! (prog1 ! ;; Any hidden lines here? ! (search-forward "\r" end t) ! (subst-char-in-region beg end ?\^M ?\n t) ! (goto-char orig) ! (gnus-summary-position-point)))) ! ! (defun gnus-summary-hide-all-threads () ! "Hide all thread subtrees." ! (interactive) ! (gnus-set-global-variables) ! (save-excursion ! (goto-char (point-min)) ! (gnus-summary-hide-thread) ! (while (zerop (gnus-summary-next-thread 1 t)) ! (gnus-summary-hide-thread))) ! (gnus-summary-position-point)) ! ! (defun gnus-summary-hide-thread () ! "Hide thread subtrees. ! Returns nil if no threads were there to be hidden." ! (interactive) ! (gnus-set-global-variables) ! (let ((buffer-read-only nil) ! (start (point)) ! (article (gnus-summary-article-number))) ! (goto-char start) ! ;; Go forward until either the buffer ends or the subthread ! ;; ends. ! (when (and (not (eobp)) ! (or (zerop (gnus-summary-next-thread 1 t)) ! (goto-char (point-max)))) ! (prog1 ! (if (and (> (point) start) ! (search-backward "\n" start t)) ! (progn ! (subst-char-in-region start (point) ?\n ?\^M) ! (gnus-summary-goto-subject article)) ! (goto-char start) ! nil) ! ;;(gnus-summary-position-point) ! )))) ! ! (defun gnus-summary-go-to-next-thread (&optional previous) ! "Go to the same level (or less) next thread. ! If PREVIOUS is non-nil, go to previous thread instead. ! Return the article number moved to, or nil if moving was impossible." ! (let ((level (gnus-summary-thread-level)) ! (way (if previous -1 1)) ! (beg (point))) ! (forward-line way) ! (while (and (not (eobp)) ! (< level (gnus-summary-thread-level))) ! (forward-line way)) ! (if (eobp) ! (progn ! (goto-char beg) ! nil) ! (setq beg (point)) ! (prog1 ! (gnus-summary-article-number) ! (goto-char beg))))) ! ! (defun gnus-summary-go-to-next-thread-old (&optional previous) ! "Go to the same level (or less) next thread. ! If PREVIOUS is non-nil, go to previous thread instead. ! Return the article number moved to, or nil if moving was impossible." ! (if (and (eq gnus-summary-make-false-root 'dummy) ! (gnus-summary-article-intangible-p)) ! (let ((beg (point))) ! (while (and (zerop (forward-line 1)) ! (not (gnus-summary-article-intangible-p)) ! (not (zerop (save-excursion ! (gnus-summary-thread-level)))))) ! (if (eobp) ! (progn ! (goto-char beg) ! nil) ! (point))) ! (let* ((level (gnus-summary-thread-level)) ! (article (gnus-summary-article-number)) ! (data (cdr (gnus-data-find-list article (gnus-data-list previous)))) ! oart) ! (while data ! (if (<= (gnus-data-level (car data)) level) ! (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) ! "Go to the same level next N'th thread. ! If N is negative, search backward instead. ! Returns the difference between N and the number of skips actually ! done. ! ! If SILENT, don't output messages." ! (interactive "p") ! (gnus-set-global-variables) ! (let ((backward (< n 0)) ! (n (abs n)) ! old dum int) ! (while (and (> n 0) ! (gnus-summary-go-to-next-thread backward)) ! (decf n)) ! (unless silent ! (gnus-summary-position-point)) ! (when (and (not silent) (/= 0 n)) ! (gnus-message 7 "No more threads")) ! n)) ! ! (defun gnus-summary-prev-thread (n) ! "Go to the same level previous N'th thread. ! Returns the difference between N and the number of skips actually ! done." ! (interactive "p") ! (gnus-set-global-variables) ! (gnus-summary-next-thread (- n))) ! ! (defun gnus-summary-go-down-thread () ! "Go down one level in the current thread." ! (let ((children (gnus-summary-article-children))) ! (and children ! (gnus-summary-goto-subject (car children))))) ! ! (defun gnus-summary-go-up-thread () ! "Go up one level in the current thread." ! (let ((parent (gnus-summary-article-parent))) ! (and parent ! (gnus-summary-goto-subject parent)))) ! ! (defun gnus-summary-down-thread (n) ! "Go down thread N steps. ! If N is negative, go up instead. ! Returns the difference between N and how many steps down that were ! taken." ! (interactive "p") ! (gnus-set-global-variables) ! (let ((up (< n 0)) ! (n (abs n))) ! (while (and (> n 0) ! (if up (gnus-summary-go-up-thread) ! (gnus-summary-go-down-thread))) ! (setq n (1- n))) ! (gnus-summary-position-point) ! (if (/= 0 n) (gnus-message 7 "Can't go further")) ! n)) ! ! (defun gnus-summary-up-thread (n) ! "Go up thread N steps. ! If N is negative, go up instead. ! Returns the difference between N and how many steps down that were ! taken." ! (interactive "p") ! (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. ! If the prefix argument is negative, tick articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (when unmark ! (setq unmark (prefix-numeric-value unmark))) ! (let ((articles (gnus-summary-articles-in-thread))) ! (save-excursion ! ;; Expand the thread. ! (gnus-summary-show-thread) ! ;; 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. ! (and (null unmark) ! gnus-thread-hide-killed ! (gnus-summary-hide-thread)) ! ;; If marked as read, go to next unread subject. ! (if (null unmark) ! ;; Go to next unread subject. ! (gnus-summary-next-subject 1 t))) ! (gnus-set-mode-line 'summary)) ! ! ;; Summary sorting commands ! ! (defun gnus-summary-sort-by-number (&optional reverse) ! "Sort summary buffer by article number. ! Argument REVERSE means reverse order." ! (interactive "P") ! (gnus-summary-sort 'number reverse)) ! ! (defun gnus-summary-sort-by-author (&optional reverse) ! "Sort summary buffer by author name alphabetically. ! If case-fold-search is non-nil, case of letters is ignored. ! Argument REVERSE means reverse order." ! (interactive "P") ! (gnus-summary-sort 'author reverse)) ! ! (defun gnus-summary-sort-by-subject (&optional reverse) ! "Sort summary buffer by subject alphabetically. `Re:'s are ignored. ! If case-fold-search is non-nil, case of letters is ignored. ! Argument REVERSE means reverse order." ! (interactive "P") ! (gnus-summary-sort 'subject reverse)) ! ! (defun gnus-summary-sort-by-date (&optional reverse) ! "Sort summary buffer by date. ! Argument REVERSE means reverse order." ! (interactive "P") ! (gnus-summary-sort 'date reverse)) ! ! (defun gnus-summary-sort-by-score (&optional reverse) ! "Sort summary buffer by score. ! Argument REVERSE means reverse order." ! (interactive "P") ! (gnus-summary-sort 'score reverse)) ! ! (defun gnus-summary-sort (predicate reverse) ! "Sort summary buffer by PREDICATE. REVERSE means reverse order." ! (gnus-set-global-variables) ! (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) ! (article (intern (format "gnus-article-sort-by-%s" predicate))) ! (gnus-thread-sort-functions ! (list ! (if (not reverse) ! thread ! `(lambda (t1 t2) ! (,thread t2 t1))))) ! (gnus-article-sort-functions ! (list ! (if (not reverse) ! article ! `(lambda (t1 t2) ! (,article t2 t1))))) ! (buffer-read-only) ! (gnus-summary-prepare-hook nil)) ! ;; We do the sorting by regenerating the threads. ! (gnus-summary-prepare) ! ;; Hide subthreads if needed. ! (when (and gnus-show-threads gnus-thread-hide-subtree) ! (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." ! (condition-case () ! (progn ! (setq date (inline (timezone-fix-time ! date nil ! (aref (inline (timezone-parse-date date)) 4)))) ! (inline ! (timezone-make-sortable-date ! (aref date 0) (aref date 1) (aref date 2) ! (inline ! (timezone-make-time-string ! (aref date 3) (aref date 4) (aref date 5)))))) ! (error ""))) ! ! ;; Summary saving commands. ! ! (defun gnus-summary-save-article (&optional n not-saved) ! "Save the current article using the default saver function. ! If N is a positive number, save the N next articles. ! If N is a negative number, save the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! save those articles instead. ! The variable `gnus-default-article-saver' specifies the saver function." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles n)) ! (save-buffer (save-excursion ! (nnheader-set-temp-buffer " *Gnus Save*"))) ! file header article) ! (while articles ! (setq header (gnus-summary-article-header ! (setq article (pop articles)))) ! (if (not (vectorp header)) ! ;; This is a pseudo-article. ! (if (assq 'name header) ! (gnus-copy-file (cdr (assq 'name header))) ! (gnus-message 1 "Article %d is unsaveable" article)) ! ;; This is a real article. ! (save-window-excursion ! (gnus-summary-select-article t nil nil article)) ! (save-excursion ! (set-buffer save-buffer) ! (erase-buffer) ! (insert-buffer-substring gnus-original-article-buffer)) ! (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-buffer save-buffer)) ! (gnus-article-hide-headers 1 t))) ! (save-window-excursion ! (if (not gnus-default-article-saver) ! (error "No default saver is defined.") ! ;; !!! Magic! The saving functions all save ! ;; `gnus-original-article-buffer' (or so they think), ! ;; but we bind that variable to our save-buffer. ! (set-buffer gnus-article-buffer) ! (let ((gnus-original-article-buffer save-buffer)) ! (set-buffer gnus-summary-buffer) ! (setq file (funcall ! gnus-default-article-saver ! (cond ! ((not gnus-prompt-before-saving) ! 'default) ! ((eq gnus-prompt-before-saving 'always) ! nil) ! (t file))))))) ! (gnus-summary-remove-process-mark article) ! (unless not-saved ! (gnus-summary-set-saved-mark article)))) ! (gnus-kill-buffer save-buffer) ! (gnus-summary-position-point) ! n)) ! ! (defun gnus-summary-pipe-output (&optional arg) ! "Pipe the current article to a subprocess. ! If N is a positive number, pipe the N next articles. ! If N is a negative number, pipe the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! pipe those articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) ! (gnus-summary-save-article arg t)) ! (gnus-configure-windows 'pipe)) ! ! (defun gnus-summary-save-article-mail (&optional arg) ! "Append the current article to an mail file. ! If N is a positive number, save the N next articles. ! If N is a negative number, save the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! save those articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) ! (gnus-summary-save-article arg))) ! ! (defun gnus-summary-save-article-rmail (&optional arg) ! "Append the current article to an rmail file. ! If N is a positive number, save the N next articles. ! If N is a negative number, save the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! save those articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) ! (gnus-summary-save-article arg))) ! ! (defun gnus-summary-save-article-file (&optional arg) ! "Append the current article to a file. ! If N is a positive number, save the N next articles. ! If N is a negative number, save the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! save those articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) ! (gnus-summary-save-article arg))) ! ! (defun gnus-summary-save-article-body-file (&optional arg) ! "Append the current article body to a file. ! If N is a positive number, save the N next articles. ! If N is a negative number, save the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! save those articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) ! (gnus-summary-save-article arg))) ! ! (defun gnus-get-split-value (methods) ! "Return a value based on the split METHODS." ! (let (split-name method result match) ! (when methods ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (save-restriction ! (nnheader-narrow-to-headers) ! (while methods ! (goto-char (point-min)) ! (setq method (pop methods)) ! (setq match (car method)) ! (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))))) ! (setq split-name (append (cdr method) split-name)) ! (cond ((stringp result) ! (push result split-name)) ! ((consp result) ! (setq split-name (append result split-name))))))))) ! split-name)) ! ! (defun gnus-read-move-group-name (prompt default articles prefix) ! "Read a group name." ! (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) ! (minibuffer-confirm-incomplete nil) ; XEmacs ! group-map ! (dum (mapatoms ! (lambda (g) ! (and (boundp g) ! (symbol-name g) ! (memq 'respool ! (assoc (symbol-name ! (car (gnus-find-method-for-group ! (symbol-name g)))) ! gnus-valid-select-methods)) ! (push (list (symbol-name g)) group-map))) ! gnus-active-hashtb)) ! (prom ! (format "%s %s to:" ! prompt ! (if (> (length articles) 1) ! (format "these %d articles" (length articles)) ! "this article"))) ! (to-newsgroup ! (cond ! ((null split-name) ! (gnus-completing-read default prom ! group-map nil nil prefix ! 'gnus-group-history)) ! ((= 1 (length split-name)) ! (gnus-completing-read (car split-name) prom group-map ! nil nil nil ! 'gnus-group-history)) ! (t ! (gnus-completing-read nil prom ! (mapcar (lambda (el) (list el)) ! (nreverse split-name)) ! nil nil nil ! 'gnus-group-history))))) ! (when to-newsgroup ! (if (or (string= to-newsgroup "") ! (string= to-newsgroup prefix)) ! (setq to-newsgroup (or default ""))) ! (or (gnus-active to-newsgroup) ! (gnus-activate-group to-newsgroup) ! (if (gnus-y-or-n-p (format "No such group: %s. Create it? " ! to-newsgroup)) ! (or (and (gnus-request-create-group ! to-newsgroup (gnus-group-name-to-method to-newsgroup)) ! (gnus-activate-group to-newsgroup nil nil ! (gnus-group-name-to-method ! to-newsgroup))) ! (error "Couldn't create group %s" to-newsgroup))) ! (error "No such group: %s" to-newsgroup))) ! 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)) ! (let* ((name (car split-name)) ! (dir (cond ((file-directory-p name) ! (file-name-as-directory name)) ! ((file-exists-p name) name) ! (t gnus-article-save-directory)))) ! (read-file-name ! (concat prompt " (default " name ") ") ! dir name))) ! ;; A list of splits was found. ! (t ! (setq split-name (nreverse split-name)) ! (let (result) ! (let ((file-name-history (nconc split-name file-name-history))) ! (setq result ! (read-file-name ! (concat prompt " (`M-p' for defaults) ") ! gnus-article-save-directory ! (car split-name)))) ! (car (push result file-name-history))))))) ! ;; Create the directory. ! (unless (equal (directory-file-name file) file) ! (make-directory (file-name-directory file) t)) ! ;; 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 characters. ! (nnheader-translate-file-chars file))) ! ! (defun gnus-article-archive-name (group) ! "Return the first instance of an \"Archive-name\" in the current buffer." ! (let ((case-fold-search t)) ! (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) ! (nnheader-concat gnus-article-save-directory ! (match-string 1))))) ! ! (defun gnus-summary-save-in-rmail (&optional filename) ! "Append this article to Rmail file. ! Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory'." ! (interactive) ! (gnus-set-global-variables) ! (let ((default-name ! (funcall gnus-rmail-save-name gnus-newsgroup-name ! gnus-current-headers gnus-newsgroup-last-rmail))) ! (setq filename ! (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 ! (widen) ! (gnus-output-to-rmail filename)))) ! ;; Remember the directory name to save articles ! (setq gnus-newsgroup-last-rmail filename))) ! ! (defun gnus-summary-save-in-mail (&optional filename) ! "Append this article to Unix mail file. ! Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory'." ! (interactive) ! (gnus-set-global-variables) ! (let ((default-name ! (funcall gnus-mail-save-name gnus-newsgroup-name ! gnus-current-headers gnus-newsgroup-last-mail))) ! (setq filename ! (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 ! (widen) ! (if (and (file-readable-p filename) (mail-file-babyl-p filename)) ! (gnus-output-to-rmail filename) ! (let ((mail-use-rfc822 t)) ! (rmail-output filename 1 t t)))))) ! ;; Remember the directory name to save articles. ! (setq gnus-newsgroup-last-mail filename))) ! ! (defun gnus-summary-save-in-file (&optional filename) ! "Append this article to file. ! Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory'." ! (interactive) ! (gnus-set-global-variables) ! (let ((default-name ! (funcall gnus-file-save-name gnus-newsgroup-name ! gnus-current-headers gnus-newsgroup-last-file))) ! (setq filename ! (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-original-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (gnus-output-to-file filename)))) ! ;; Remember the directory name to save articles. ! (setq gnus-newsgroup-last-file filename))) ! ! (defun gnus-summary-save-body-in-file (&optional filename) ! "Append this article body to a file. ! Optional argument FILENAME specifies file name. ! The directory to save in defaults to `gnus-article-save-directory'." ! (interactive) ! (gnus-set-global-variables) ! (let ((default-name ! (funcall gnus-file-save-name gnus-newsgroup-name ! gnus-current-headers gnus-newsgroup-last-file))) ! (setq filename ! (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-original-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (goto-char (point-min)) ! (and (search-forward "\n\n" nil t) ! (narrow-to-region (point) (point-max))) ! (gnus-output-to-file filename)))) ! ;; Remember the directory name to save articles. ! (setq gnus-newsgroup-last-file filename))) ! ! (defun gnus-summary-save-in-pipe (&optional command) ! "Pipe this article to subprocess." ! (interactive) ! (gnus-set-global-variables) ! (setq command ! (cond ((eq command 'default) ! gnus-last-shell-command) ! (command command) ! (t (read-string "Shell command on article: " ! 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) ! (shell-command-on-region (point-min) (point-max) command nil))) ! (setq gnus-last-shell-command command)) ! ! ;; Summary extract commands ! ! (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<))) ! files action) ! (while ps ! (setq action (cdr (assq 'action (car ps)))) ! (setq files (list (cdr (assq 'name (car ps))))) ! (while (and ps (cdr ps) ! (string= (or action "1") ! (or (cdr (assq 'action (cadr ps))) "2"))) ! (setq files (cons (cdr (assq 'name (cadr ps))) files)) ! (setcdr ps (cddr ps))) ! (if (not files) ! () ! (if (not (string-match "%s" action)) ! (setq files (cons " " files))) ! (setq files (cons " " files)) ! (and (assq 'execute (car ps)) ! (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)) ! (while pslist ! (and (assq 'execute (car pslist)) ! (gnus-execute-command (cdr (assq 'execute (car pslist))) ! (eq gnus-view-pseudos 'not-confirm))) ! (setq pslist (cdr pslist))) ! (save-excursion ! (while pslist ! (setq after-article (or (cdr (assq 'article (car pslist))) ! (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' ! (gnus-add-text-properties ! b (1- 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)) ! (push gnus-reffed-article-number gnus-newsgroup-unreads) ! (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) ! (setq pslist (cdr pslist))))))) ! ! (defun gnus-pseudos< (p1 p2) ! (let ((c1 (cdr (assq 'action p1))) ! (c2 (cdr (assq 'action p2)))) ! (and c1 c2 (string< c1 c2)))) ! ! (defun gnus-request-pseudo-article (props) ! (cond ((assq 'execute props) ! (gnus-execute-command (cdr (assq 'execute props))))) ! (let ((gnus-current-article (gnus-summary-article-number))) ! (run-hooks 'gnus-mark-article-hook))) ! ! (defun gnus-execute-command (command &optional automatic) ! (save-excursion ! (gnus-article-setup-buffer) ! (set-buffer gnus-article-buffer) ! (setq buffer-read-only nil) ! (let ((command (if automatic command (read-string "Command: " command))) ! ;; Just binding this here doesn't help, because there might ! ;; be output from the process after exiting the scope of ! ;; this `let'. ! ;; (buffer-read-only nil) ! ) ! (erase-buffer) ! (insert "$ " command "\n\n") ! (if gnus-view-pseudo-asynchronously ! (start-process "gnus-execute" nil shell-file-name ! shell-command-switch command) ! (call-process shell-file-name nil t nil ! shell-command-switch command))))) ! ! (defun gnus-copy-file (file &optional to) ! "Copy FILE to TO." ! (interactive ! (list (read-file-name "Copy file: " default-directory) ! (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)) ! ! ;; Summary kill commands. ! ! (defun gnus-summary-edit-global-kill (article) ! "Edit the \"global\" kill file." ! (interactive (list (gnus-summary-article-number))) ! (gnus-set-global-variables) ! (gnus-group-edit-global-kill article)) ! ! (defun gnus-summary-edit-local-kill () ! "Edit a local kill file applied to the current newsgroup." ! (interactive) ! (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)) ! ! ! ;;; ! ;;; Gnus article mode ! ;;; ! ! (put 'gnus-article-mode 'mode-class 'special) ! ! (if gnus-article-mode-map ! 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 ! [delete] 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 ! "<" beginning-of-buffer ! ">" end-of-buffer ! "\C-c\C-i" gnus-info-find-node ! "\C-c\C-b" gnus-bug) ! ! (substitute-key-definition ! 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) ! ! (defun gnus-article-mode () ! "Major mode for displaying an article. ! ! All normal editing commands are switched off. ! ! The following commands are available: ! ! \\ ! \\[gnus-article-next-page]\t Scroll the article one page forwards ! \\[gnus-article-prev-page]\t Scroll the article one page backwards ! \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point ! \\[gnus-article-show-summary]\t Display the summary buffer ! \\[gnus-article-mail]\t Send a reply to the address near point ! \\[gnus-article-describe-briefly]\t Describe the current mode briefly ! \\[gnus-info-find-node]\t Go to the Gnus info node" ! (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'article-menu 'menu)) ! (gnus-article-make-menu-bar)) ! (kill-all-local-variables) ! (gnus-simplify-mode-line) ! (setq mode-name "Article") ! (setq major-mode 'gnus-article-mode) ! (make-local-variable 'minor-mode-alist) ! (or (assq 'gnus-show-mime minor-mode-alist) ! (setq minor-mode-alist ! (cons (list 'gnus-show-mime " MIME") minor-mode-alist))) ! (use-local-map gnus-article-mode-map) ! (make-local-variable 'page-delimiter) ! (setq page-delimiter gnus-page-delimiter) ! (buffer-disable-undo (current-buffer)) ! (setq buffer-read-only t) ;Disable modification ! (run-hooks 'gnus-article-mode-hook)) ! ! (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) ! (gnus-set-global-variables)) ! (make-local-variable 'gnus-summary-buffer)) ! ;; Init original article buffer. ! (save-excursion ! (set-buffer (get-buffer-create gnus-original-article-buffer)) ! (buffer-disable-undo (current-buffer)) ! (setq major-mode 'gnus-original-article-mode) ! (gnus-add-current-to-buffer-list) ! (make-local-variable 'gnus-original-article)) ! (if (get-buffer name) ! (save-excursion ! (set-buffer name) ! (buffer-disable-undo (current-buffer)) ! (setq buffer-read-only t) ! (gnus-add-current-to-buffer-list) ! (or (eq major-mode 'gnus-article-mode) ! (gnus-article-mode)) ! (current-buffer)) ! (save-excursion ! (set-buffer (get-buffer-create name)) ! (gnus-add-current-to-buffer-list) ! (gnus-article-mode) ! (current-buffer))))) ! ! ;; 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 t) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (goto-char (point-min)) ! (if (not line) ! (point-min) ! (gnus-message 6 "Moved to bookmark") ! (search-forward "\n\n" nil t) ! (forward-line line) ! (point))))) ! ! (defun gnus-kill-all-overlays () ! "Delete all overlays in the current buffer." ! (when (fboundp 'overlay-lists) ! (let* ((overlayss (overlay-lists)) ! (buffer-read-only nil) ! (overlays (nconc (car overlayss) (cdr overlayss)))) ! (while overlays ! (delete-overlay (pop overlays)))))) ! ! (defun gnus-request-article-this-buffer (article group) ! "Get an article and insert it into this buffer." ! (let (do-update-line) ! (prog1 ! (save-excursion ! (erase-buffer) ! (gnus-kill-all-overlays) ! (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. ! (when (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. ! (when (and (numberp article) ! gnus-summary-buffer ! (get-buffer gnus-summary-buffer) ! (buffer-name (get-buffer gnus-summary-buffer))) ! (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 do-update-line article) ! (setq article (mail-header-id header)) ! (let ((gnus-override-method gnus-refer-article-method)) ! (gnus-read-header article)) ! (setq gnus-newsgroup-sparse ! (delq article gnus-newsgroup-sparse))) ! ((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 ! ;; Refuse to select canceled articles. ! ((and (numberp article) ! gnus-summary-buffer ! (get-buffer gnus-summary-buffer) ! (buffer-name (get-buffer gnus-summary-buffer)) ! (eq (cdr (save-excursion ! (set-buffer gnus-summary-buffer) ! (assq article gnus-newsgroup-reads))) ! gnus-canceled-mark)) ! nil) ! ;; We first check `gnus-original-article-buffer'. ! ((and (get-buffer gnus-original-article-buffer) ! (numberp article) ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (and (equal (car gnus-original-article) group) ! (eq (cdr gnus-original-article) article)))) ! (insert-buffer-substring gnus-original-article-buffer) ! 'article) ! ;; Check the backlog. ! ((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 ! (numberp article) ! (gnus-backlog-enter-article ! group article (current-buffer))) ! 'article)))) ! ;; It was a pseudo. ! (t article))) ! ! ;; Take the article from the original article buffer ! ;; and place it in the buffer it's supposed to be in. ! (when (and (get-buffer gnus-article-buffer) ! ;;(numberp article) ! (equal (buffer-name (current-buffer)) ! (buffer-name (get-buffer gnus-article-buffer)))) ! (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)) ! (let (buffer-read-only) ! (erase-buffer) ! (insert-buffer-substring gnus-article-buffer)) ! (setq gnus-original-article (cons group article)))) ! ! ;; Update sparse articles. ! (when (and do-update-line ! (or (numberp article) ! (stringp article))) ! (let ((buf (current-buffer))) ! (set-buffer gnus-summary-buffer) ! (gnus-summary-update-article do-update-line) ! (gnus-summary-goto-subject do-update-line nil t) ! (set-window-point (get-buffer-window (current-buffer) t) ! (point)) ! (set-buffer buf)))))) ! ! (defun gnus-read-header (id &optional header) ! "Read the headers of article ID and enter them into the Gnus system." ! (let ((group gnus-newsgroup-name) ! (gnus-override-method ! (and (gnus-news-group-p gnus-newsgroup-name) ! gnus-refer-article-method)) ! where) ! ;; First we check to see whether the header in question is already ! ;; fetched. ! (if (stringp id) ! ;; This is a Message-ID. ! (setq header (or header (gnus-id-to-header id))) ! ;; This is an article number. ! (setq header (or header (gnus-summary-article-header id)))) ! (if (and header ! (not (memq (mail-header-number header) gnus-newsgroup-sparse))) ! ;; We have found the header. ! header ! ;; We have to really fetch the header to this article. ! (when (setq where (gnus-request-head id group)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-max)) ! (insert ".\n") ! (goto-char (point-min)) ! (insert "211 ") ! (princ (cond ! ((numberp id) id) ! ((cdr where) (cdr where)) ! (header (mail-header-number header)) ! (t gnus-reffed-article-number)) ! (current-buffer)) ! (insert " Article retrieved.\n")) ! ;(when (and header ! ; (memq (mail-header-number header) gnus-newsgroup-sparse)) ! ; (setcar (gnus-id-to-thread id) nil)) ! (if (not (setq header (car (gnus-get-newsgroup-headers)))) ! () ; Malformed head. ! (unless (memq (mail-header-number header) gnus-newsgroup-sparse) ! (if (and (stringp id) ! (not (string= (gnus-group-real-name group) ! (car where)))) ! ;; If we fetched by Message-ID and the article came ! ;; from a different group, we fudge some bogus article ! ;; numbers for this article. ! (mail-header-set-number header gnus-reffed-article-number)) ! (decf gnus-reffed-article-number) ! (gnus-remove-header (mail-header-number header)) ! (push header gnus-newsgroup-headers) ! (setq gnus-current-headers header) ! (push (mail-header-number header) gnus-newsgroup-limit)) ! header))))) ! ! (defun gnus-remove-header (number) ! "Remove header NUMBER from `gnus-newsgroup-headers'." ! (if (and gnus-newsgroup-headers ! (= number (mail-header-number (car gnus-newsgroup-headers)))) ! (pop gnus-newsgroup-headers) ! (let ((headers gnus-newsgroup-headers)) ! (while (and (cdr headers) ! (not (= number (mail-header-number (cadr headers))))) ! (pop headers)) ! (when (cdr headers) ! (setcdr headers (cddr headers)))))) ! ! (defun gnus-article-prepare (article &optional all-headers header) ! "Prepare ARTICLE in article mode buffer. ! ARTICLE should either be an article number or a Message-ID. ! If ARTICLE is an id, HEADER should be the article headers. ! If ALL-HEADERS is non-nil, no headers are hidden." ! (save-excursion ! ;; Make sure we start in a summary buffer. ! (unless (eq major-mode 'gnus-summary-mode) ! (set-buffer gnus-summary-buffer)) ! (setq gnus-summary-buffer (current-buffer)) ! ;; Make sure the connection to the server is alive. ! (unless (gnus-server-opened ! (gnus-find-method-for-group gnus-newsgroup-name)) ! (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) ! (gnus-request-group gnus-newsgroup-name t)) ! (let* ((article (if header (mail-header-number header) article)) ! (summary-buffer (current-buffer)) ! (internal-hook gnus-article-internal-prepare-hook) ! (group gnus-newsgroup-name) ! result) ! (save-excursion ! (gnus-article-setup-buffer) ! (set-buffer gnus-article-buffer) ! ;; Deactivate active regions. ! (when (and (boundp 'transient-mark-mode) ! 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-error ! 1 "No such article (may have expired or been canceled)"))) ! (if (or (eq result 'pseudo) (eq result 'nneething)) ! (progn ! (save-excursion ! (set-buffer summary-buffer) ! (setq gnus-last-article gnus-current-article ! gnus-newsgroup-history (cons gnus-current-article ! gnus-newsgroup-history) ! gnus-current-article 0 ! gnus-current-headers nil ! gnus-article-current nil) ! (if (eq result 'nneething) ! (gnus-configure-windows 'summary) ! (gnus-configure-windows 'article)) ! (gnus-set-global-variables)) ! (gnus-set-mode-line 'article)) ! ;; The result from the `request' was an actual article - ! ;; or at least some text that is now displayed in the ! ;; article buffer. ! (if (and (numberp article) ! (not (eq article gnus-current-article))) ! ;; Seems like a new article has been selected. ! ;; `gnus-current-article' must be an article number. ! (save-excursion ! (set-buffer summary-buffer) ! (setq gnus-last-article gnus-current-article ! 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)) ! (gnus-summary-show-thread) ! (run-hooks 'gnus-mark-article-hook) ! (gnus-set-mode-line 'summary) ! (and (gnus-visual-p 'article-highlight 'highlight) ! (run-hooks 'gnus-visual-mark-article-hook)) ! ;; Set the global newsgroup variables here. ! ;; 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 ! (gnus-summary-article-header article) ! (memq article gnus-newsgroup-marked) ! (memq article gnus-newsgroup-dormant) ! (memq article gnus-newsgroup-unreads))))) ! (when (or (numberp article) ! (stringp article)) ! ;; Hooks for getting information from the article. ! ;; This hook must be called before being narrowed. ! (let (buffer-read-only) ! (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. ! (goto-char (point-min)) ! (and gnus-break-pages (gnus-narrow-to-page))) ! (gnus-set-mode-line 'article) ! (gnus-configure-windows 'article) ! (goto-char (point-min)) ! t)))))) ! ! (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)) ! (gnus-unhide-text (point-min) (point-max))))) ! ! (defun gnus-article-hide-headers-if-wanted () ! "Hide unwanted headers if `gnus-have-all-headers' is nil. ! Provided for backwards compatibility." ! (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) ! gnus-inhibit-hiding ! (gnus-article-hide-headers))) ! ! (defsubst gnus-article-header-rank () ! "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." ! (let ((list gnus-sorted-header-list) ! (i 0)) ! (while list ! (when (looking-at (car list)) ! (setq list nil)) ! (setq list (cdr list)) ! (incf i)) ! i)) ! ! (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 (gnus-hidden-arg)) ! (if (gnus-article-check-hidden-text 'headers arg) ! ;; Show boring headers as well. ! (gnus-article-show-hidden-text 'boring-headers) ! ;; This function might be inhibited. ! (unless gnus-inhibit-hiding ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((buffer-read-only nil) ! (props (nconc (list 'gnus-type 'headers) ! gnus-hidden-properties)) ! (max (1+ (length gnus-sorted-header-list))) ! (ignored (when (not (stringp gnus-visible-headers)) ! (cond ((stringp gnus-ignored-headers) ! gnus-ignored-headers) ! ((listp gnus-ignored-headers) ! (mapconcat 'identity gnus-ignored-headers ! "\\|"))))) ! (visible ! (cond ((stringp gnus-visible-headers) ! gnus-visible-headers) ! ((and gnus-visible-headers ! (listp gnus-visible-headers)) ! (mapconcat 'identity gnus-visible-headers "\\|")))) ! (inhibit-point-motion-hooks t) ! want-list beg) ! ;; 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) ! (if delete ! (delete-region (point-min) (point)) ! (gnus-hide-text (point-min) (point) props))) ! ;; 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 ! ;; select which header lines is to remain visible in the ! ;; article buffer. ! (goto-char (point-min)) ! (while (re-search-forward "^[^ \t]*:" nil t) ! (beginning-of-line) ! ;; We add the headers we want to keep to a list and delete ! ;; them from the buffer. ! (gnus-put-text-property ! (point) (1+ (point)) 'message-rank ! (if (or (and visible (looking-at visible)) ! (and ignored ! (not (looking-at ignored)))) ! (gnus-article-header-rank) ! (+ 2 max))) ! (forward-line 1)) ! (message-sort-headers-1) ! (when (setq beg (text-property-any ! (point-min) (point-max) 'message-rank (+ 2 max))) ! ;; We make the unwanted headers invisible. ! (if delete ! (delete-region beg (point-max)) ! ;; Suggested by Sudish Joseph . ! (gnus-hide-text-type beg (point-max) 'headers)) ! ;; Work around XEmacs lossage. ! (gnus-put-text-property (point-min) beg 'invisible nil)))))))) ! ! (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 (gnus-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'boring-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-hide-text-type ! (progn (beginning-of-line) (point)) ! (progn ! (end-of-line) ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! (point-max))) ! 'boring-headers))) ! ;; Hide boring Newsgroups header. ! ((eq elem 'newsgroups) ! (when (equal (message-fetch-field "newsgroups") ! (gnus-group-real-name gnus-newsgroup-name)) ! (gnus-article-hide-header "newsgroups"))) ! ((eq elem 'followup-to) ! (when (equal (message-fetch-field "followup-to") ! (message-fetch-field "newsgroups")) ! (gnus-article-hide-header "followup-to"))) ! ((eq elem 'reply-to) ! (let ((from (message-fetch-field "from")) ! (reply-to (message-fetch-field "reply-to"))) ! (when (and ! from reply-to ! (equal ! (nth 1 (funcall gnus-extract-address-components from)) ! (nth 1 (funcall gnus-extract-address-components ! reply-to)))) ! (gnus-article-hide-header "reply-to")))) ! ((eq elem 'date) ! (let ((date (message-fetch-field "date"))) ! (when (and date ! (< (gnus-days-between date (current-time-string)) ! 4)) ! (gnus-article-hide-header "date"))))))))))) ! ! (defun gnus-article-hide-header (header) ! (save-excursion ! (goto-char (point-min)) ! (when (re-search-forward (concat "^" header ":") nil t) ! (gnus-hide-text-type ! (progn (beginning-of-line) (point)) ! (progn ! (end-of-line) ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! (point-max))) ! 'boring-headers)))) ! ! ;; Written by Per Abrahamsen . ! (defun gnus-article-treat-overstrike () ! "Translate overstrikes into bold text." ! (interactive) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (while (search-forward "\b" nil t) ! (let ((next (following-char)) ! (previous (char-after (- (point) 2)))) ! (cond ! ((eq next previous) ! (gnus-put-text-property (- (point) 2) (point) 'invisible t) ! (gnus-put-text-property (point) (1+ (point)) 'face 'bold)) ! ((eq next ?_) ! (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t) ! (gnus-put-text-property ! (- (point) 2) (1- (point)) 'face 'underline)) ! ((eq previous ?_) ! (gnus-put-text-property (- (point) 2) (point) 'invisible t) ! (gnus-put-text-property ! (point) (1+ (point)) 'face 'underline)))))))) ! ! (defun gnus-article-word-wrap () ! "Format too long lines." ! (interactive) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (widen) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (end-of-line 1) ! (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") ! (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") ! (adaptive-fill-mode t)) ! (while (not (eobp)) ! (and (>= (current-column) (min fill-column (window-width))) ! (/= (preceding-char) ?:) ! (fill-paragraph nil)) ! (end-of-line 2)))))) ! ! (defun gnus-article-remove-cr () ! "Remove carriage returns from an article." ! (interactive) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (goto-char (point-min)) ! (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)) ! (save-excursion ! (set-buffer gnus-article-buffer) ! ;; Delete the old process, if any. ! (when (process-status "gnus-x-face") ! (delete-process "gnus-x-face")) ! (let ((inhibit-point-motion-hooks t) ! (case-fold-search nil) ! from) ! (save-restriction ! (nnheader-narrow-to-headers) ! (setq from (message-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)) ! ;; We now have the area of the buffer where the X-Face is stored. ! (let ((beg (point)) ! (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) ! ;; We display the face. ! (if (symbolp gnus-article-x-face-command) ! ;; The command is a lisp function, so we call it. ! (if (gnus-functionp gnus-article-x-face-command) ! (funcall gnus-article-x-face-command beg end) ! (error "%s is not a function" gnus-article-x-face-command)) ! ;; The command is a string, so we interpret the command ! ;; as a, well, command, and fork it off. ! (let ((process-connection-type nil)) ! (process-kill-without-query ! (start-process ! "gnus-x-face" nil shell-file-name shell-command-switch ! gnus-article-x-face-command)) ! (process-send-region "gnus-x-face" beg end) ! (process-send-eof "gnus-x-face"))))))))) ! ! (defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522) ! (defun gnus-decode-rfc1522 () ! "Hack to remove QP encoding from headers." ! (let ((case-fold-search t) ! (inhibit-point-motion-hooks t) ! (buffer-read-only nil) ! string) ! (save-restriction ! (narrow-to-region ! (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point-max))) ! ! (goto-char (point-min)) ! (while (re-search-forward ! "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) ! (setq string (match-string 1)) ! (narrow-to-region (match-beginning 0) (match-end 0)) ! (delete-region (point-min) (point-max)) ! (insert string) ! (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) ! (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) ! (let ((case-fold-search t) ! (buffer-read-only nil) ! (type (gnus-fetch-field "content-transfer-encoding"))) ! (gnus-decode-rfc1522) ! (when (or force ! (and type (string-match "quoted-printable" (downcase type)))) ! (goto-char (point-min)) ! (search-forward "\n\n" nil 'move) ! (gnus-mime-decode-quoted-printable (point) (point-max)))))) ! ! (defun gnus-mime-decode-quoted-printable (from to) ! "Decode Quoted-Printable in the region between FROM and TO." ! (interactive "r") ! (goto-char from) ! (while (search-forward "=" to t) ! (cond ((eq (following-char) ?\n) ! (delete-char -1) ! (delete-char 1)) ! ((looking-at "[0-9A-F][0-9A-F]") ! (subst-char-in-region ! (1- (point)) (point) ?= ! (hexl-hex-string-to-integer ! (buffer-substring (point) (+ 2 (point))))) ! (delete-char 2)) ! ((looking-at "=") ! (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 (gnus-hidden-arg)) ! (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)) ! buffer-read-only beg end) ! (widen) ! (goto-char (point-min)) ! ;; Hide the "header". ! (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) ! (gnus-hide-text (match-beginning 0) (match-end 0) props)) ! (setq beg (point)) ! ;; Hide the actual signature. ! (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) ! (setq end (1+ (match-beginning 0))) ! (gnus-hide-text ! end ! (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) ! (match-end 0) ! ;; Perhaps we shouldn't hide to the end of the buffer ! ;; if there is no end to the signature? ! (point-max)) ! props)) ! ;; Hide "- " PGP quotation markers. ! (when (and beg end) ! (narrow-to-region beg end) ! (goto-char (point-min)) ! (while (re-search-forward "^- " nil t) ! (gnus-hide-text (match-beginning 0) (match-end 0) props)) ! (widen)))))) ! ! (defun gnus-article-hide-pem (&optional arg) ! "Toggle hiding of any PEM headers and signatures in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'pem arg) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((props (nconc (list 'gnus-type 'pem) gnus-hidden-properties)) ! buffer-read-only end) ! (widen) ! (goto-char (point-min)) ! ;; hide the horrendously ugly "header". ! (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" ! nil ! t) ! (setq end (1+ (match-beginning 0))) ! (gnus-hide-text ! end ! (if (search-forward "\n\n" nil t) ! (match-end 0) ! (point-max)) ! props)) ! ;; hide the trailer as well ! (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" ! nil ! t) ! (gnus-hide-text (match-beginning 0) (match-end 0) props)))))) ! ! (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 (gnus-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'signature arg) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((buffer-read-only nil)) ! (when (gnus-narrow-to-signature) ! (gnus-hide-text-type (point-min) (point-max) 'signature))))))) ! ! (defun gnus-article-strip-leading-blank-lines () ! "Remove all blank lines from the beginning of the article." ! (interactive) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let (buffer-read-only) ! (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (while (looking-at "[ \t]$") ! (gnus-delete-line)))))) ! ! (defvar mime::preview/content-list) ! (defvar mime::preview-content-info/point-min) ! (defun gnus-narrow-to-signature () ! "Narrow to the signature." ! (widen) ! (if (and (boundp 'mime::preview/content-list) ! mime::preview/content-list) ! (let ((pcinfo (car (last mime::preview/content-list)))) ! (condition-case () ! (narrow-to-region ! (funcall (intern "mime::preview-content-info/point-min") pcinfo) ! (point-max)) ! (error nil)))) ! (goto-char (point-max)) ! (when (re-search-backward gnus-signature-separator nil t) ! (forward-line 1) ! (when (or (null gnus-signature-limit) ! (and (numberp gnus-signature-limit) ! (< (- (point-max) (point)) gnus-signature-limit)) ! (and (gnus-functionp gnus-signature-limit) ! (funcall gnus-signature-limit)) ! (and (stringp gnus-signature-limit) ! (not (re-search-forward gnus-signature-limit nil t)))) ! (narrow-to-region (point) (point-max)) ! t))) ! ! (defun gnus-hidden-arg () ! "Return the current prefix arg as a number, or 0 if no prefix." ! (list (if current-prefix-arg ! (prefix-numeric-value current-prefix-arg) ! 0))) ! ! (defun gnus-article-check-hidden-text (type arg) ! "Return nil if hiding is necessary. ! Arg can be nil or a number. Nil and positive means hide, negative ! means show, 0 means toggle." ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((hide (gnus-article-hidden-text-p type))) ! (cond ! ((or (null arg) ! (> arg 0)) ! nil) ! ((< arg 0) ! (gnus-article-show-hidden-text type)) ! (t ! (if (eq hide 'hidden) ! (gnus-article-show-hidden-text type) ! 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))) ! (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-min))) ! (while (gnus-goto-char (text-property-any ! beg (point-max) 'gnus-type type)) ! (setq beg (point)) ! (forward-char) ! (if hide ! (gnus-hide-text beg (point) gnus-hidden-properties) ! (gnus-unhide-text beg (point))) ! (setq beg (point))) ! t))) ! ! (defvar gnus-article-time-units ! `((year . ,(* 365.25 24 60 60)) ! (week . ,(* 7 24 60 60)) ! (day . ,(* 24 60 60)) ! (hour . ,(* 60 60)) ! (minute . 60) ! (second . 1)) ! "Mapping from time units to seconds.") ! ! (defun gnus-article-date-ut (&optional type highlight) ! "Convert DATE date to universal time in the current article. ! 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) ! bface eface) ! (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 (re-search-forward date-regexp nil t) ! (progn ! (setq bface (get-text-property (gnus-point-at-bol) 'face) ! eface (get-text-property (1- (gnus-point-at-eol)) ! 'face)) ! (message-remove-header date-regexp t) ! (beginning-of-line)) ! (goto-char (point-max))) ! (insert (gnus-make-date-line date type)) ! ;; Do highlighting. ! (forward-line -1) ! (when (and (gnus-visual-p 'article-highlight 'highlight) ! (looking-at "\\([^:]+\\): *\\(.*\\)$")) ! (gnus-put-text-property (match-beginning 1) (match-end 1) ! 'face bface) ! (gnus-put-text-property (match-beginning 2) (match-end 2) ! 'face eface)))))))) ! ! (defun gnus-make-date-line (date type) ! "Return a DATE line of TYPE." ! (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. ! ((eq type 'local) ! (concat "Date: " (condition-case () ! (timezone-make-date-arpa-standard date) ! (error date)) ! "\n")) ! ;; Convert to Universal Time. ! ((eq type 'ut) ! (concat "Date: " ! (condition-case () ! (timezone-make-date-arpa-standard date nil "UT") ! (error date)) ! "\n")) ! ;; Get the original date from the article. ! ((eq type 'original) ! (concat "Date: " date "\n")) ! ;; Do an X-Sent lapsed format. ! ((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* ((now (current-time)) ! (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) ! (cond ! ((equal real-time '(0 0)) ! "X-Sent: Unknown\n") ! ((zerop sec) ! "X-Sent: Now\n") ! (t ! (concat ! "X-Sent: " ! ;; This is a bit convoluted, but basically we go ! ;; 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" "")) ! (setq prev t)))) ! gnus-article-time-units "") ! ;; If dates are odd, then it might appear like the ! ;; article was sent in the future. ! (if (> real-sec 0) ! " ago\n" ! " in the future\n")))))) ! (t ! (error "Unknown conversion type: %s" type)))) ! ! (defun gnus-article-date-local (&optional highlight) ! "Convert the current article date to the local timezone." ! (interactive (list t)) ! (gnus-article-date-ut 'local highlight)) ! ! (defun gnus-article-date-original (&optional highlight) ! "Convert the current article date to what it was originally. ! This is only useful if you have used some other date conversion ! function and want to see what the date was before converting." ! (interactive (list t)) ! (gnus-article-date-ut 'original highlight)) ! ! (defun gnus-article-date-lapsed (&optional highlight) ! "Convert the current article date to time lapsed since it was sent." ! (interactive (list t)) ! (gnus-article-date-ut 'lapsed highlight)) ! ! (defun gnus-article-maybe-highlight () ! "Do some article highlighting if `gnus-visual' is non-nil." ! (if (gnus-visual-p 'article-highlight 'highlight) ! (gnus-article-highlight-some))) ! ! ;;; Article savers. ! ! (defun gnus-output-to-rmail (file-name) ! "Append the current article to an Rmail file named FILE-NAME." ! (require 'rmail) ! ;; Most of these codes are borrowed from rmailout.el. ! (setq file-name (expand-file-name file-name)) ! (setq rmail-default-rmail-file file-name) ! (let ((artbuf (current-buffer)) ! (tmpbuf (get-buffer-create " *Gnus-output*"))) ! (save-excursion ! (or (get-file-buffer file-name) ! (file-exists-p file-name) ! (if (gnus-yes-or-no-p ! (concat "\"" file-name "\" does not exist, create it? ")) ! (let ((file-buffer (create-file-buffer file-name))) ! (save-excursion ! (set-buffer file-buffer) ! (rmail-insert-rmail-file-header) ! (let ((require-final-newline nil)) ! (write-region (point-min) (point-max) file-name t 1))) ! (kill-buffer file-buffer)) ! (error "Output file does not exist"))) ! (set-buffer tmpbuf) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (insert-buffer-substring artbuf) ! (gnus-convert-article-to-rmail) ! ;; Decide whether to append to a file or to an Emacs buffer. ! (let ((outbuf (get-file-buffer file-name))) ! (if (not outbuf) ! (append-to-file (point-min) (point-max) file-name) ! ;; File has been visited, in buffer OUTBUF. ! (set-buffer outbuf) ! (let ((buffer-read-only nil) ! (msg (and (boundp 'rmail-current-message) ! (symbol-value 'rmail-current-message)))) ! ;; If MSG is non-nil, buffer is in RMAIL mode. ! (if msg ! (progn (widen) ! (narrow-to-region (point-max) (point-max)))) ! (insert-buffer-substring tmpbuf) ! (if msg ! (progn ! (goto-char (point-min)) ! (widen) ! (search-backward "\^_") ! (narrow-to-region (point) (point-max)) ! (goto-char (1+ (point-min))) ! (rmail-count-new-messages t) ! (rmail-show-message msg))))))) ! (kill-buffer tmpbuf))) ! ! (defun gnus-output-to-file (file-name) ! "Append the current article to a file named FILE-NAME." ! (let ((artbuf (current-buffer))) ! (nnheader-temp-write nil ! (insert-buffer-substring artbuf) ! ;; Append newline at end of the buffer as separator, and then ! ;; save it to file. ! (goto-char (point-max)) ! (insert "\n") ! (append-to-file (point-min) (point-max) file-name)))) ! ! (defun gnus-convert-article-to-rmail () ! "Convert article in current buffer to Rmail message format." ! (let ((buffer-read-only nil)) ! ;; Convert article directly into Babyl format. ! ;; Suggested by Rob Austein ! (goto-char (point-min)) ! (insert "\^L\n0, unseen,,\n*** EOOH ***\n") ! (while (search-forward "\n\^_" nil t) ;single char ! (replace-match "\n^_" t t)) ;2 chars: "^" and "_" ! (goto-char (point-max)) ! (insert "\^_"))) ! ! (defun gnus-narrow-to-page (&optional arg) ! "Narrow the article buffer to a page. ! If given a numerical ARG, move forward ARG pages." ! (interactive "P") ! (setq arg (if arg (prefix-numeric-value arg) 0)) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (goto-char (point-min)) ! (widen) ! (when (gnus-visual-p 'page-marker) ! (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) ! (re-search-forward page-delimiter nil 'move arg))) ! (goto-char (match-end 0))) ! (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))) ! (save-excursion ! (goto-char (point-min)) ! (gnus-insert-prev-page-button))) ! (when (and (gnus-visual-p 'page-marker) ! (not (= (1- (point-max)) (buffer-size)))) ! (save-excursion ! (goto-char (point-max)) ! (gnus-insert-next-page-button))))) ! ! ;; 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 (gnus-character-to-event ?n)))) ! ! (defun gnus-article-goto-prev-page () ! "Show the next page of the article." ! (interactive) ! (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?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 ! (end-of-line) ! (and (pos-visible-in-window-p) ;Not continuation line. ! (eobp))) ! ;; Nothing in this page. ! (if (or (not gnus-break-pages) ! (save-excursion ! (save-restriction ! (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? ! t ;Nothing more. ! (gnus-narrow-to-page 1) ;Go to next page. ! nil) ! ;; More in this page. ! (condition-case () ! (scroll-up lines) ! (end-of-buffer ! ;; Long lines may cause an end-of-buffer error. ! (goto-char (point-max)))) ! (move-to-window-line 0) ! nil)) ! ! (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) ! (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? ! (progn ! (gnus-narrow-to-page -1) ;Go to previous page. ! (goto-char (point-max)) ! (recenter -1)) ! (prog1 ! (condition-case () ! (scroll-down lines) ! (error nil)) ! (move-to-window-line 0)))) ! ! (defun gnus-article-refer-article () ! "Read article specified by message-id around point." ! (interactive) ! (let ((point (point))) ! (search-forward ">" nil t) ;Move point to end of "<....>". ! (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) ! (let ((message-id (match-string 1))) ! (goto-char point) ! (set-buffer gnus-summary-buffer) ! (gnus-summary-refer-article message-id)) ! (goto-char (point)) ! (error "No references around point")))) ! ! (defun gnus-article-show-summary () ! "Reconfigure windows to show summary buffer." ! (interactive) ! (gnus-configure-windows 'article) ! (gnus-summary-goto-subject gnus-current-article)) ! ! (defun gnus-article-describe-briefly () ! "Describe article mode commands briefly." ! (interactive) ! (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-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." ! (interactive) ! (let ((obuf (current-buffer)) ! (owin (current-window-configuration)) ! func) ! (switch-to-buffer gnus-summary-buffer 'norecord) ! (setq func (lookup-key (current-local-map) (this-command-keys))) ! (call-interactively func) ! (set-buffer obuf) ! (set-window-configuration owin) ! (set-window-point (get-buffer-window (current-buffer)) (point)))) ! ! (defun gnus-article-summary-command-nosave () ! "Execute the last keystroke in the summary buffer." ! (interactive) ! (let (func) ! (pop-to-buffer gnus-summary-buffer 'norecord) ! (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-^" "|")) ! (nosave-but-article ! '("A\r")) ! 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 (or (member keys nosaves) ! (member keys nosave-but-article)) ! (let (func) ! (save-window-excursion ! (pop-to-buffer gnus-summary-buffer 'norecord) ! (setq func (lookup-key (current-local-map) keys))) ! (if (not func) ! (ding) ! (set-buffer gnus-summary-buffer) ! (call-interactively func)) ! (when (member keys nosave-but-article) ! (pop-to-buffer gnus-article-buffer 'norecord))) ! (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)))))) ;;; ;;; Kill file handling. ;;; - ;;;###autoload - (defalias 'gnus-batch-kill 'gnus-batch-score) - ;;;###autoload - (defun gnus-batch-score () - "Run batched scoring. - Usage: emacs -batch -l gnus -f gnus-batch-score ... - Newsgroups is a list of strings in Bnews format. If you want to score - the comp hierarchy, you'd say \"comp.all\". If you would not like to - score the alt hierarchy, you'd say \"!alt.all\"." - (interactive) - (let* ((yes-and-no - (gnus-newsrc-parse-options - (apply (function concat) - (mapcar (lambda (g) (concat g " ")) - command-line-args-left)))) - (gnus-expert-user t) - (nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (yes (car yes-and-no)) - (no (cdr yes-and-no)) - group newsrc entry - ;; Disable verbose message. - gnus-novice-user gnus-large-newsgroup) - ;; Eat all arguments. - (setq command-line-args-left nil) - ;; Start Gnus. - (gnus) - ;; Apply kills to specified newsgroups in command line arguments. - (setq newsrc (cdr gnus-newsrc-alist)) - (while newsrc - (setq group (caar newsrc)) - (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) - (and (car entry) - (or (eq (car entry) t) - (not (zerop (car entry))))) - (if yes (string-match yes group) t) - (or (null no) (not (string-match no group)))) - (progn - (gnus-summary-read-group group nil t nil t) - (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) - (gnus-summary-exit)))) - (setq newsrc (cdr newsrc))) - ;; Exit Emacs. - (switch-to-buffer gnus-group-buffer) - (gnus-group-save-newsrc))) - (defun gnus-apply-kill-file () "Apply a kill file to the current newsgroup. Returns the number of articles marked as read." --- 580,617 ---- (when info (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) ! ;; 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) ! (setq skip (match-end 0) ! depth (+ depth 1))) ! depth)))) ! (if (string-match ":" group) ! (setq foreign (substring group 0 (match-end 0)) ! group (substring group (match-end 0)))) ! (while group ! (if (and (string-match "\\." group) ! (> levels (- gnus-group-uncollapsed-levels 1))) ! (setq name (concat name (substring group 0 1)) ! group (substring group (match-end 0)) ! levels (- levels 1) ! name (concat name ".")) ! (setq name (concat foreign name group) ! group nil))) ! name)) ;;; ;;; Kill file handling. ;;; (defun gnus-apply-kill-file () "Apply a kill file to the current newsgroup. Returns the number of articles marked as read." *************** *** 15038,15503 **** "/" gnus-kill-file-name) gnus-kill-files-directory)))) ! ! ;;; ! ;;; Dribble file ! ;;; ! ! (defvar gnus-dribble-ignore nil) ! (defvar gnus-dribble-eval-file nil) ! ! (defun gnus-dribble-file-name () ! "Return the dribble file for the current .newsrc." ! (concat ! (if gnus-dribble-directory ! (concat (file-name-as-directory gnus-dribble-directory) ! (file-name-nondirectory gnus-current-startup-file)) ! gnus-current-startup-file) ! "-dribble")) ! ! (defun gnus-dribble-enter (string) ! "Enter STRING into the dribble buffer." ! (if (and (not gnus-dribble-ignore) ! gnus-dribble-buffer ! (buffer-name gnus-dribble-buffer)) ! (let ((obuf (current-buffer))) ! (set-buffer gnus-dribble-buffer) ! (insert string "\n") ! (set-window-point (get-buffer-window (current-buffer)) (point-max)) ! (bury-buffer gnus-dribble-buffer) ! (set-buffer obuf)))) ! ! (defun gnus-dribble-read-file () ! "Read the dribble file from disk." ! (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) ! (setq buffer-file-name dribble-file) ! (auto-save-mode t) ! (buffer-disable-undo (current-buffer)) ! (bury-buffer (current-buffer)) ! (set-buffer-modified-p nil) ! (let ((auto (make-auto-save-file-name)) ! (gnus-dribble-ignore t) ! modes) ! (when (or (file-exists-p auto) (file-exists-p dribble-file)) ! ;; Load whichever file is newest -- the auto save file ! ;; or the "real" file. ! (if (file-newer-than-file-p auto dribble-file) ! (insert-file-contents auto) ! (insert-file-contents dribble-file)) ! (unless (zerop (buffer-size)) ! (set-buffer-modified-p t)) ! ;; Set the file modes to reflect the .newsrc file modes. ! (save-buffer) ! (when (and (file-exists-p gnus-current-startup-file) ! (setq modes (file-modes gnus-current-startup-file))) ! (set-file-modes dribble-file modes)) ! ;; Possibly eval the file later. ! (when (gnus-y-or-n-p ! "Auto-save file exists. Do you want to read it? ") ! (setq gnus-dribble-eval-file t))))))) ! ! (defun gnus-dribble-eval-file () ! (when gnus-dribble-eval-file ! (setq gnus-dribble-eval-file nil) ! (save-excursion ! (let ((gnus-dribble-ignore t)) ! (set-buffer gnus-dribble-buffer) ! (eval-buffer (current-buffer)))))) ! ! (defun gnus-dribble-delete-file () ! (when (file-exists-p (gnus-dribble-file-name)) ! (delete-file (gnus-dribble-file-name))) ! (when gnus-dribble-buffer ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (let ((auto (make-auto-save-file-name))) ! (if (file-exists-p auto) ! (delete-file auto)) ! (erase-buffer) ! (set-buffer-modified-p nil))))) ! ! (defun gnus-dribble-save () ! (when (and gnus-dribble-buffer ! (buffer-name gnus-dribble-buffer)) ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (save-buffer)))) ! ! (defun gnus-dribble-clear () ! (when (gnus-buffer-exists-p gnus-dribble-buffer) ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (erase-buffer) ! (set-buffer-modified-p nil) ! (setq buffer-saved-size (buffer-size))))) ! ! ! ;;; ! ;;; Server Communication ! ;;; ! ! (defun gnus-start-news-server (&optional confirm) ! "Open a method for getting news. ! If CONFIRM is non-nil, the user will be asked for an NNTP server." ! (let (how) ! (if gnus-current-select-method ! ;; Stream is already opened. ! nil ! ;; Open NNTP server. ! (if (null gnus-nntp-service) (setq gnus-nntp-server nil)) ! (if confirm ! (progn ! ;; Read server name with completion. ! (setq gnus-nntp-server ! (completing-read "NNTP server: " ! (mapcar (lambda (server) (list server)) ! (cons (list gnus-nntp-server) ! 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 ! (cond ((or (string= gnus-nntp-server "") ! (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 ! gnus-nntp-server 1))))) ! (list 'nnmh-get-new-mail nil))) ! (t ! (list 'nntp gnus-nntp-server))))) ! ! (setq how (car gnus-select-method)) ! (cond ((eq how 'nnspool) ! (require 'nnspool) ! (gnus-message 5 "Looking up local news spool...")) ! ((eq how 'nnmh) ! (require 'nnmh) ! (gnus-message 5 "Looking up mh spool...")) ! (t ! (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 (%s) open error: '%s'. Continue? " ! (car gnus-select-method) (cadr gnus-select-method) ! (gnus-status-message gnus-select-method))) ! (gnus-error 1 "Couldn't open server on %s" ! (nth 1 gnus-select-method)))))) ! ! (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 silent) ! "Check whether the connection to METHOD is down. ! If METHOD is nil, use `gnus-select-method'. ! If it is down, start it up (again)." ! (let ((method (or method gnus-select-method))) ! ;; Transform virtual server names into select methods. ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (if (gnus-server-opened method) ! ;; The stream is already opened. ! t ! ;; Open the server. ! (unless silent ! (gnus-message 5 "Opening %s server%s..." (car method) ! (if (equal (nth 1 method) "") "" ! (format " on %s" (nth 1 method))))) ! (run-hooks 'gnus-open-server-hook) ! (prog1 ! (gnus-open-server method) ! (unless silent ! (message "")))))) ! ! (defun gnus-get-function (method function &optional noerror) ! "Return a function symbol based on METHOD and FUNCTION." ! ;; Translate server names into methods. ! (unless method ! (error "Attempted use of a nil select method")) ! (when (stringp method) ! (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)) ! (when (and (not (fboundp func)) ! (not noerror)) ! ;; This backend doesn't implement this function. ! (error "No such function: %s" func))) ! func)) ! ! ! ;;; ! ;;; Interface functions to the backends. ! ;;; ! ! (defun gnus-open-server (method) ! "Open a connection to METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let ((elem (assoc method gnus-opened-servers))) ! ;; If this method was previously denied, we just return nil. ! (if (eq (nth 1 elem) 'denied) ! (progn ! (gnus-message 1 "Denied server") ! nil) ! ;; Open the server. ! (let ((result ! (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. ! (setcar (cdr elem) (if result 'ok 'denied)) ! ;; Return the result from the "open" call. ! result)))) ! ! (defun gnus-close-server (method) ! "Close the connection to METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'close-server) (nth 1 method))) ! ! (defun gnus-request-list (method) ! "Request the active file from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-list) (nth 1 method))) ! ! (defun gnus-request-list-newsgroups (method) ! "Request the newsgroups file from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) ! ! (defun gnus-request-newgroups (date method) ! "Request all new groups since DATE from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-newgroups) ! date (nth 1 method))) ! ! (defun gnus-server-opened (method) ! "Check whether a connection to METHOD has been opened." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'server-opened) (nth 1 method))) ! ! (defun gnus-status-message (method) ! "Return the status message from METHOD. ! If METHOD is a string, it is interpreted as a group name. The method ! this group uses will be queried." ! (let ((method (if (stringp method) (gnus-find-method-for-group method) ! 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)))) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-group) ! (gnus-group-real-name group) (nth 1 method) dont-check))) ! ! (defun gnus-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) ! "Request active information on GROUP." ! (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) ! "Request a description of GROUP." ! (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) ! "Request headers for ARTICLES in GROUP. ! If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." ! (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)))) ! ! (defun gnus-retrieve-groups (groups method) ! "Request active information on GROUPS from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) ! ! (defun gnus-request-type (group &optional article) ! "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-type (car method))) ! 'unknown ! (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 mark)))) ! ! (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)) ! (head (gnus-get-function method 'request-head t))) ! (if (fboundp head) ! (funcall head article (gnus-group-real-name group) (nth 1 method)) ! (let ((res (gnus-request-article article group))) ! (when res ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (delete-region (1- (point)) (point-max))) ! (nnheader-fold-continuation-lines))) ! res)))) ! ! (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) ! "Post the current buffer using METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-post) (nth 1 method))) ! ! (defun gnus-request-scan (group method) ! "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 (stringp method) ! (setq method (gnus-server-to-method method))) ! (when (gnus-check-backend-function 'request-update-info (car method)) ! (funcall (gnus-get-function method 'request-update-info) ! (gnus-group-real-name (gnus-info-group info)) ! 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 method &optional last) ! ;; Make sure there's a newline at the end of the article. ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (when (and (not method) ! (stringp group)) ! (setq method (gnus-group-name-to-method group))) ! (goto-char (point-max)) ! (unless (bolp) ! (insert "\n")) ! (let ((func (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) ! (cadr method) ! last))) ! ! (defun gnus-request-replace-article (article group buffer) ! (let ((func (car (gnus-find-method-for-group group)))) ! (funcall (intern (format "%s-request-replace-article" func)) ! article (gnus-group-real-name group) buffer))) ! ! (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) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let ((method (or method (gnus-find-method-for-group group)))) ! (funcall (gnus-get-function method 'request-create-group) ! (gnus-group-real-name group) (nth 1 method)))) ! ! (defun gnus-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." --- 651,657 ---- "/" gnus-kill-file-name) gnus-kill-files-directory)))) ! ;;; Server things. (defun gnus-member-of-valid (symbol group) "Find out if GROUP has SYMBOL as part of its \"valid\" spec." *************** *** 15579,17363 **** (setq valids (cdr valids))) outs)) ! ! ;;; ! ;;; Active & Newsrc File Handling ! ;;; ! (defun gnus-setup-news (&optional rawfile level dont-connect) ! "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))))) ! ! (when init ! ;; Clear some variables to re-initialize news information. ! (setq gnus-newsrc-alist nil ! gnus-active-hashtb nil) ! ;; Read the newsrc file and create `gnus-newsrc-hashtb'. ! (gnus-read-newsrc-file rawfile)) ! ! (when (and (not (assoc "archive" gnus-server-alist)) ! (gnus-archive-server-wanted-p)) ! (push (cons "archive" gnus-message-archive-method) ! gnus-server-alist)) ! ! ;; 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)) ! ! ;; Read the active file and create `gnus-active-hashtb'. ! ;; 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)) ! ! (or gnus-active-hashtb ! (setq gnus-active-hashtb (make-vector 4095 0))) ! ! ;; Initialize the cache. ! (when gnus-use-cache ! (gnus-cache-open)) ! ! ;; Possibly eval the dribble file. ! (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) ! ! ;; Slave Gnusii should then clear the dribble buffer. ! (when (and init gnus-slave) ! (gnus-dribble-clear)) ! ! (gnus-update-format-specifications) ! ! ;; See whether we need to read the description file. ! (if (and (string-match "%[-,0-9]*D" gnus-group-line-format) ! (not gnus-description-hashtb) ! (not dont-connect) ! gnus-read-active-file) ! (gnus-read-all-descriptions-files)) ! ! ;; Find new newsgroups and treat them. ! (if (and init gnus-check-new-newsgroups (not level) ! (gnus-check-server gnus-select-method)) ! (gnus-find-new-newsgroups)) ! ! ;; We might read in new NoCeM messages here. ! (when (and gnus-use-nocem ! (not level) ! (not dont-connect)) ! (gnus-nocem-scan-groups)) ! ! ;; Find the number of unread articles in each non-dead group. ! (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) ! (gnus-get-unread-articles level)) ! ! (if (and init gnus-check-bogus-newsgroups ! gnus-read-active-file (not level) ! (gnus-server-opened gnus-select-method)) ! (gnus-check-bogus-newsgroups)))) ! ! (defun gnus-find-new-newsgroups (&optional arg) ! "Search for new newsgroups and add them. ! Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' ! The `-n' option line from .newsrc is respected. ! If ARG (the prefix), use the `ask-server' method to query ! the server for new groups." (interactive "P") ! (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) ! (null gnus-read-active-file) ! (eq gnus-read-active-file 'some)) ! 'ask-server gnus-check-new-newsgroups))) ! (unless (gnus-check-first-time-used) ! (if (or (consp check) ! (eq check 'ask-server)) ! ;; Ask the server for new groups. ! (gnus-ask-server-for-new-groups) ! ;; Go through the active hashtb and look for new groups. ! (let ((groups 0) ! group new-newsgroups) ! (gnus-message 5 "Looking for new newsgroups...") ! (unless gnus-have-read-active-file ! (gnus-read-active-file)) ! (setq gnus-newsrc-last-checked-date (current-time-string)) ! (unless 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) ! (when 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 unconditionally ! ;; subscribed, `ignore' if it is to be ignored, and nil if there is ! ;; no match for the group. ! ! ;; First we check the two user variables. ! (cond ! ((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 ! (let ((regs gnus-newsrc-options-n)) ! (while (and regs ! (not (string-match (caar regs) group))) ! (setq regs (cdr regs))) ! (and regs (cdar regs)))))) ! ! (defun gnus-ask-server-for-new-groups () ! (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) ! (methods (cons gnus-select-method ! (nconc ! (when (gnus-archive-server-wanted-p) ! (list "archive")) ! (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 new-newsgroups nil) ! (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))) ! (not (boundp 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 () ! (if (or (> (length gnus-newsrc-alist) 1) ! (file-exists-p gnus-startup-file) ! (file-exists-p (concat gnus-startup-file ".el")) ! (file-exists-p (concat gnus-startup-file ".eld"))) ! nil ! (gnus-message 6 "First time user; subscribing you to default groups") ! (unless (gnus-read-active-file-p) ! (gnus-read-active-file)) ! (setq gnus-newsrc-last-checked-date (current-time-string)) ! (let ((groups gnus-default-subscribed-newsgroups) ! group) ! (if (eq groups t) ! nil ! (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) ! (mapatoms ! (lambda (sym) ! (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)) ! ((eq do-sub 'ignore) ! nil) ! (t ! (setq gnus-killed-list (cons group gnus-killed-list))))))) ! 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) ! (and gnus-novice-user ! (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 ! ;; subscription levels of newsgroups. This might mean just changing ! ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back ! ;; again, which subscribes/unsubscribes a group, which is equally ! ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and ! ;; from 8-9 to 1-7 means that you remove the group from the list of ! ;; killed (or zombie) groups and add them to the (kinda) subscribed ! ;; groups. And last but not least, moving from 8 to 9 and 9 to 8, ! ;; which is trivial. ! ;; 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) ! ;; Glean what info we can from the arguments ! (if (consp entry) ! (if fromkilled (setq group (nth 1 entry)) ! (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) ! (consp entry)) ! (setq oldlevel (gnus-info-level (nth 2 entry))) ! (setq oldlevel (or oldlevel 9))) ! (if (stringp previous) ! (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) ! ! (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 ! ;; it from the newsrc hash table and assoc. ! (cond ! ((>= oldlevel gnus-level-zombie) ! (if (= oldlevel gnus-level-zombie) ! (setq gnus-zombie-list (delete group gnus-zombie-list)) ! (setq gnus-killed-list (delete group gnus-killed-list)))) ! (t ! (if (and (>= level gnus-level-zombie) ! entry) ! (progn ! (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) ! (if (nth 3 entry) ! (setcdr (gnus-gethash (car (nth 3 entry)) ! gnus-newsrc-hashtb) ! (cdr entry))) ! (setcdr (cdr entry) (cdddr entry)))))) ! ! ;; Finally we enter (if needed) the list where it is supposed to ! ;; go, and change the subscription level. If it is to be killed, ! ;; we enter it into the killed or zombie list. ! (cond ! ((>= level gnus-level-zombie) ! ;; 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)) ! (setq gnus-killed-list (cons group gnus-killed-list))))) ! (t ! ;; If the list is to be entered into the newsrc assoc, and ! ;; it was killed, we have to create an entry in the newsrc ! ;; hashtb format and fix the pointers in the newsrc assoc. ! (if (< oldlevel gnus-level-zombie) ! ;; 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 (cdaddr entry) level) ! (if (listp entry) ! (setq info (cdr entry) ! 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 group)))) ! (if (eq method gnus-select-method) ! (setq info (list group level nil)) ! (setq info (list group level nil nil method))))) ! (unless previous ! (setq previous ! (let ((p gnus-newsrc-alist)) ! (while (cddr p) ! (setq p (cdr p))) ! p))) ! (setq entry (cons info (cddr previous))) ! (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) ! gnus-newsrc-hashtb)) ! (when (cdr entry) ! (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))))) ! (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." ! (gnus-group-change-level ! (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) ! ! (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-read-active-file-p) ! (gnus-read-active-file)) ! (when (gnus-read-active-file-p) ! ;; Find all bogus newsgroup that are subscribed. ! (while newsrc ! (setq info (pop newsrc) ! group (gnus-info-group info)) ! (unless (or (gnus-active group) ; Active ! (gnus-info-method info) ; Foreign ! (and confirm ! (not (gnus-y-or-n-p ! (format "Remove bogus newsgroup: %s " group))))) ! ;; Found a bogus newsgroup. ! (push group bogus))) ! ;; Remove all bogus subscribed groups by first killing them, and ! ;; then removing them from the list of killed groups. ! (while bogus ! (when (setq entry (gnus-gethash (setq group (pop bogus)) ! gnus-newsrc-hashtb)) ! (gnus-group-change-level entry gnus-level-killed) ! (setq gnus-killed-list (delete group gnus-killed-list)))) ! ;; Then we remove all bogus groups from the list of killed and ! ;; zombie groups. They are removed without confirmation. ! (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) ! killed) ! (while dead-lists ! (setq killed (symbol-value (car dead-lists))) ! (while killed ! (unless (gnus-active (setq group (pop killed))) ! ;; The group is bogus. ! ;; !!!Slow as hell. ! (set (car dead-lists) ! (delete group (symbol-value (car dead-lists)))))) ! (setq dead-lists (cdr dead-lists)))) ! (run-hooks 'gnus-check-bogus-groups-hook) ! (gnus-message 5 "Checking bogus newsgroups...done")))) ! ! (defun gnus-check-duplicate-killed-groups () ! "Remove duplicates from the list of killed groups." ! (interactive) ! (let ((killed gnus-killed-list)) ! (while killed ! (gnus-message 9 "%d" (length killed)) ! (setcdr killed (delete (car killed) (cdr killed))) ! (setq killed (cdr killed))))) ! ! ;; We want to inline a function from gnus-cache, so we cheat here: ! (eval-when-compile ! (provide 'gnus) ! (setq gnus-directory (or (getenv "SAVEDIR") "~/News/")) ! (require 'gnus-cache)) ! ! (defun gnus-get-unread-articles-in-group (info active &optional update) ! (when active ! ;; Allow the backend to update the info in the group. ! (when (and update ! (gnus-request-update-info ! info (gnus-find-method-for-group (gnus-info-group info)))) ! (gnus-activate-group (gnus-info-group info) nil t)) ! (let* ((range (gnus-info-read info)) ! (num 0)) ! ;; If a cache is present, we may have to alter the active info. ! (when (and gnus-use-cache info) ! (inline (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) ! (setq num (- (1+ (cdr active)) (car active)))) ! ((not (listp (cdr range))) ! ;; Fix a single (num . num) range according to the ! ;; active hash table. ! ;; Fix by Carsten Bormann . ! (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) ! (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) ! ;; Compute number of unread articles. ! (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) ! (t ! ;; 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 (cadr range)) (cadr range)) ! (caadr range)))) ! (if (numberp (car range)) ! (setcar range ! (cons (car range) ! (or (and (numberp (cadr range)) ! (cadr range)) ! (cdadr range)))) ! (setcdr (car range) ! (or (and (numberp (nth 1 range)) (nth 1 range)) ! (cdadr range)))) ! (setcdr range (cddr range))) ! ;; Adjust the first element to be the same as the lower limit. ! (if (and (not (atom (car range))) ! (< (cdar 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 (cadr srange)) ! (cadr srange)) ! (caadr srange)) (cdr active))) ! (setq srange (cdr srange))) ! (if (cdr srange) ! ;; Nuke all remaining illegal elements. ! (setcdr srange nil)) ! ! ;; Adjust the final element. ! (if (and (not (atom (car srange))) ! (> (cdar srange) (cdr active))) ! (setcdr (car srange) (cdr active)))) ! ;; Compute the number of unread articles. ! (while range ! (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) ! (cdar range))) ! (or (and (atom (car range)) (car range)) ! (caar range))))) ! (setq range (cdr range))) ! (setq num (max 0 (- (cdr active) num))))) ! ;; Set the number of unread articles. ! (when info ! (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) ! num))) ! ! ;; 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 method) ! (gnus-message 5 "Checking new news...") ! ! (while newsrc ! (setq active (gnus-active (setq group (gnus-info-group ! (setq info (pop newsrc)))))) ! ! ;; Check newsgroups. If the user doesn't want to check them, or ! ;; they can't be checked (for instance, if the news server can't ! ;; be reached) we just set the number of unread articles in this ! ;; newsgroup to t. This means that Gnus thinks that there are ! ;; unread articles, but it has no idea how many. ! (if (and (setq method (gnus-info-method info)) ! (not (gnus-server-equal ! gnus-select-method ! (setq method (gnus-server-get-method nil method)))) ! (not (gnus-secondary-method-p method))) ! ;; These groups are foreign. Check the level. ! (when (<= (gnus-info-level info) foreign-level) ! (setq active (gnus-activate-group group 'scan)) ! (unless (inline (gnus-virtual-group-p group)) ! (inline (gnus-close-group group))) ! (when (fboundp (intern (concat (symbol-name (car method)) ! "-request-update-info"))) ! (inline (gnus-request-update-info info method)))) ! ;; These groups are native or secondary. ! (when (and (<= (gnus-info-level info) level) ! (not gnus-read-active-file)) ! (setq active (gnus-activate-group group 'scan)) ! (inline (gnus-close-group group)))) ! ! ;; Get the number of unread articles in the group. ! (if active ! (inline (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))) ! ! (gnus-message 5 "Checking new news...done"))) ! ! ;; Create a hash table out of the newsrc alist. The `car's of the ! ;; alist elements are used as keys. ! (defun gnus-make-hashtable-from-newsrc-alist () ! (let ((alist gnus-newsrc-alist) ! (ohashtb gnus-newsrc-hashtb) ! prev) ! (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) ! (setq alist ! (setq prev (setq gnus-newsrc-alist ! (if (equal (caar gnus-newsrc-alist) ! "dummy.group") ! gnus-newsrc-alist ! (cons (list "dummy.group" 0 nil) alist))))) ! (while alist ! (gnus-sethash ! (caar alist) ! (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) ! prev) ! gnus-newsrc-hashtb) ! (setq prev alist ! alist (cdr alist))))) ! ! (defun gnus-make-hashtable-from-killed () ! "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 (setq list (pop lists)) ! (setq list (symbol-value list)) ! (while list ! (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) ! ! (defun gnus-activate-group (group &optional scan dont-check method) ! ;; Check whether a group has been activated or not. ! ;; If SCAN, request a scan of that group as well. ! (let ((method (or method (gnus-find-method-for-group group))) ! active) ! (and (gnus-check-server method) ! ;; We escape all bugs and quit here to make it possible to ! ;; continue if a group is so out-there that it reports bugs ! ;; and stuff. ! (progn ! (and scan ! (gnus-check-backend-function 'request-scan (car method)) ! (gnus-request-scan group method)) ! t) ! (condition-case () ! (gnus-request-group group dont-check method) ! ; (error nil) ! (quit nil)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! ;; Parse the result we got from `gnus-request-group'. ! (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. ! active)))))) ! ! (defun gnus-update-read-articles (group unread) ! "Update the list of read and ticked articles in GROUP using the ! UNREAD and TICKED lists. ! Note: UNSELECTED has to be sorted over `<'. ! Returns whether the updating was successful." ! (let* ((active (or gnus-newsgroup-active (gnus-active group))) ! (entry (gnus-gethash group gnus-newsrc-hashtb)) ! (info (nth 2 entry)) ! (prev 1) ! (unread (sort (copy-sequence unread) '<)) ! read) ! (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)) ! (setq unread (cdr unread))) ! ;; Remove any expired article numbers ! (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 ! (cons prev (1- (car unread)))) read))) ! (setq prev (1+ (car unread))) ! (setq unread (cdr unread))) ! (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)) ! t))) ! ! (defun gnus-make-articles-unread (group articles) ! "Mark ARTICLES in GROUP as unread." ! (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) ! (gnus-gethash (gnus-group-real-name group) ! gnus-newsrc-hashtb)))) ! (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)))) ! ! ;; Enter all dead groups into the hashtb. ! (defun gnus-update-active-hashtb-from-killed () ! (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0))) ! (lists (list gnus-killed-list gnus-zombie-list)) ! killed) ! (while lists ! (setq killed (car lists)) ! (while killed ! (gnus-sethash (car killed) nil hashtb) ! (setq killed (cdr killed))) ! (setq lists (cdr lists))))) ! ! (defun gnus-get-killed-groups () ! "Go through the active hashtb and mark all unknown groups as killed." ! ;; First make sure active file has been read. ! (unless (gnus-read-active-file-p) ! (let ((gnus-read-active-file t)) ! (gnus-read-active-file))) ! (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) ! ;; Go through all newsgroups that are known to Gnus - enlarge kill list. ! (mapatoms ! (lambda (sym) ! (let ((groups 0) ! (group (symbol-name sym))) ! (if (or (null group) ! (gnus-gethash group gnus-killed-hashtb) ! (gnus-gethash group gnus-newsrc-hashtb)) ! () ! (let ((do-sub (gnus-matches-options-n group))) ! (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)) ! ! ;; Get the active file(s) from the backend(s). ! (defun gnus-read-active-file () ! (gnus-group-set-mode-line) ! (let ((methods ! (append ! (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) ! ;; Also read from the archive server. ! (when (gnus-archive-server-wanted-p) ! (list "archive")))) ! list-type) ! (setq gnus-have-read-active-file nil) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (while methods ! (let* ((method (if (stringp (car methods)) ! (gnus-server-get-method nil (car methods)) ! (car methods))) ! (where (nth 1 method)) ! (mesg (format "Reading active file%s via %s..." ! (if (and where (not (zerop (length where)))) ! (concat " from " where) "") ! (car method)))) ! (gnus-message 5 mesg) ! (when (gnus-check-server method) ! ;; 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 info) ! (while (setq info (pop newsrc)) ! (when (gnus-server-equal ! (gnus-find-method-for-group ! (gnus-info-group info) info) ! gmethod) ! (push (gnus-group-real-name (gnus-info-group info)) ! groups))) ! (when groups ! (gnus-check-server method) ! (setq list-type (gnus-retrieve-groups groups method)) ! (cond ! ((not list-type) ! (gnus-error ! 1.2 "Cannot read partial active file from %s server." ! (car method))) ! ((eq list-type 'active) ! (gnus-active-to-gnus-format method gnus-active-hashtb)) ! (t ! (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) ! (t ! (if (not (gnus-request-list method)) ! (unless (equal method gnus-message-archive-method) ! (gnus-error 1 "Cannot read active file from %s server." ! (car method))) ! (gnus-message 5 mesg) ! (gnus-active-to-gnus-format method gnus-active-hashtb) ! ;; We mark this active file as read. ! (push method gnus-have-read-active-file) ! (gnus-message 5 "%sdone" mesg)))))) ! (setq methods (cdr methods)))))) ! ! ;; Read an active file and place the results in `gnus-active-hashtb'. ! (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) ! (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))))))) ! ;; 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 ! (goto-char (point-min)) ! (delete-matching-lines gnus-ignored-newsgroups))) ! ;; Make the group names readable as a lisp expression even if they ! ;; contain special characters. ! ;; Fix by Luc Van Eycken . ! (goto-char (point-max)) ! (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))) ! (let ((prefix (gnus-group-prefixed-name "" method))) ! (goto-char (point-min)) ! (while (and (not (eobp)) ! (progn (insert prefix) ! (zerop (forward-line 1))))))) ! ;; Store the active file in a hash table. ! (goto-char (point-min)) ! (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) ! (while (not (eobp)) ! (condition-case nil ! (progn ! (narrow-to-region (point) (gnus-point-at-eol)) ! (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) ?=) ! (= (following-char) ?x) ! (= (following-char) ?j))))) ! (set group (cons min max)) ! (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)))) ! (widen) ! (forward-line 1))) ! ;; And if we do not care about moderation, we use this loop, ! ;; which is faster. ! (let (group max min) ! (while (not (eobp)) ! (condition-case () ! (progn ! (narrow-to-region (point) (gnus-point-at-eol)) ! ;; group gets set to a symbol interned in the hash table ! ;; (what a hack!!) - jwz ! (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) ?=) ! (= (following-char) ?x) ! (= (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)))))) ! ! (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))) ! (gnus-group-prefixed-name "" method)))) ! ! (goto-char (point-min)) ! ;; We split this into to separate loops, one with the prefix ! ;; and one without to speed the reading up somewhat. ! (if prefix ! (let (min max opoint group) ! (while (not (eobp)) ! (condition-case () ! (progn ! (read cur) (read cur) ! (setq min (read cur) ! max (read cur) ! opoint (point)) ! (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))) ! (let (min max group) ! (while (not (eobp)) ! (condition-case () ! (if (= (following-char) ?2) ! (progn ! (read cur) (read cur) ! (setq min (read cur) ! max (read cur)) ! (set (setq group (let ((obarray hashtb)) (read cur))) ! (cons min max)))) ! (error (and group (symbolp group) (set group nil)))) ! (forward-line 1)))))) ! ! (defun gnus-read-newsrc-file (&optional force) ! "Read startup file. ! If FORCE is non-nil, the .newsrc file is read." ! ;; Reset variables that might be defined in the .newsrc.eld file. ! (let ((variables gnus-variable-list)) ! (while variables ! (set (car variables) nil) ! (setq variables (cdr variables)))) ! (let* ((newsrc-file gnus-current-startup-file) ! (quick-file (concat newsrc-file ".el"))) ! (save-excursion ! ;; We always load the .newsrc.eld file. If always contains ! ;; 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 (and (file-exists-p gnus-current-startup-file) ! (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 ! ;; .newsrc.eld file exists, it has already been read, and ! ;; the `gnus-newsrc-hashtb' has been created. While reading ! ;; the .newsrc file, Gnus will only use the information it ! ;; can find there for changing the data already read - ! ;; ie. reading the .newsrc file will not trash the data ! ;; already read (except for read articles). ! (save-excursion ! (gnus-message 5 "Reading %s..." newsrc-file) ! (set-buffer (find-file-noselect newsrc-file)) ! (buffer-disable-undo (current-buffer)) ! (gnus-newsrc-to-gnus-format) ! (kill-buffer (current-buffer)) ! (gnus-message 5 "Reading %s...done" newsrc-file))) ! ! ;; Read any slave files. ! (unless gnus-slave ! (gnus-master-read-slave-newsrc)) ! ! ;; Convert old to new. ! (gnus-convert-old-newsrc)))) ! ! (defun gnus-continuum-version (version) ! "Return VERSION as a floating point number." ! (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) ! (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) ! (let* ((alpha (and (match-beginning 1) (match-string 1 version))) ! (number (match-string 2 version)) ! major minor least) ! (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) ! (setq major (string-to-number (match-string 1 number))) ! (setq minor (string-to-number (match-string 2 number))) ! (setq least (if (match-beginning 3) ! (string-to-number (match-string 3 number)) ! 0)) ! (string-to-number ! (if (zerop major) ! (format "%s00%02d%02d" ! (cond ! ((member alpha '("(ding)" "d")) "4.99") ! ((member alpha '("September" "s")) "5.01") ! ((member alpha '("Red" "r")) "5.03")) ! minor least) ! (format "%d.%02d%02d" major minor least)))))) ! ! (defun gnus-convert-old-newsrc () ! "Convert old newsrc into the new format, if needed." ! (let ((fcv (and gnus-newsrc-file-version ! (gnus-continuum-version gnus-newsrc-file-version)))) ! (cond ! ;; No .newsrc.eld file was loaded. ! ((null fcv) nil) ! ;; Gnus 5 .newsrc.eld was loaded. ! ((< fcv (gnus-continuum-version "September Gnus v0.1")) ! (gnus-convert-old-ticks))))) ! ! (defun gnus-convert-old-ticks () ! (let ((newsrc (cdr gnus-newsrc-alist)) ! marks info dormant ticked) ! (while (setq info (pop newsrc)) ! (when (setq marks (gnus-info-marks info)) ! (setq dormant (cdr (assq 'dormant marks)) ! ticked (cdr (assq 'tick marks))) ! (when (or dormant ticked) ! (gnus-info-set-read ! info ! (gnus-add-to-range ! (gnus-info-read info) ! (nconc (gnus-uncompress-range dormant) ! (gnus-uncompress-range ticked))))))))) ! ! (defun gnus-read-newsrc-el-file (file) ! (let ((ding-file (concat file "d"))) ! ;; We always, always read the .eld file. ! (gnus-message 5 "Reading %s..." ding-file) ! (let (gnus-newsrc-assoc) ! (condition-case nil ! (load ding-file t t t) ! (error ! (gnus-error 1 "Error in %s" ding-file))) ! (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 ! (defun gnus-read-old-newsrc-el-file (file) ! (let (newsrc killed marked group m info) ! (prog1 ! (let ((gnus-killed-assoc nil) ! gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) ! (prog1 ! (condition-case nil ! (load file t t t) ! (error nil)) ! (setq newsrc gnus-newsrc-assoc ! killed gnus-killed-assoc ! marked gnus-marked-assoc))) ! (setq gnus-newsrc-alist nil) ! (while (setq group (pop newsrc)) ! (if (setq info (gnus-get-info (car group))) ! (progn ! (gnus-info-set-read info (cddr 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))) ! (push (setq info ! (list (car group) ! (if (nth 1 group) gnus-level-default-subscribed ! gnus-level-default-unsubscribed) ! (cddr group))) ! gnus-newsrc-alist)) ! ;; Copy marks into info. ! (when (setq m (assoc (car group) marked)) ! (unless (nthcdr 3 info) ! (nconc info (list nil))) ! (gnus-info-set-marks ! info (list (cons 'tick (gnus-compress-sequence ! (sort (cdr m) '<) t)))))) ! (setq newsrc killed) ! (while newsrc ! (setcar newsrc (caar newsrc)) ! (setq newsrc (cdr newsrc))) ! (setq gnus-killed-list killed)) ! ;; The .el file version of this variable does not begin with ! ;; "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))) ! (and (not (string-match "\n$" gnus-newsrc-options)) ! (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) ! ;; Finally, if we read some options lines, we parse them. ! (or (string= gnus-newsrc-options "") ! (gnus-newsrc-parse-options gnus-newsrc-options)))) ! ! (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)) ! (real-file (concat file "-" (nth 1 gnus-select-method)))) ! (if (or (file-exists-p real-file) ! (file-exists-p (concat real-file ".el")) ! (file-exists-p (concat real-file ".eld"))) ! real-file file))) ! ! (defun gnus-newsrc-to-gnus-format () ! (setq gnus-newsrc-options "") ! (setq gnus-newsrc-options-n nil) ! ! (or gnus-active-hashtb ! (setq gnus-active-hashtb (make-vector 4095 0))) ! (let ((buf (current-buffer)) ! (already-read (> (length gnus-newsrc-alist) 1)) ! group subscribed options-symbol newsrc Options-symbol ! symbol reads num1) ! (goto-char (point-min)) ! ;; We intern the symbol `options' in the active hashtb so that we ! ;; 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 ! ;; already exist in that hashtb, so this will save some string ! ;; space. ! (narrow-to-region ! (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 ! ;; This concating is quite inefficient, but since our ! ;; thorough studies show that approx 99.37% of all ! ;; .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) ! (progn (beginning-of-line) (point))) ! (point))))) ! (forward-line -1)) ! (symbol ! ;; Group names can be just numbers. ! (when (numberp symbol) ! (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) ! (or (boundp symbol) (set symbol nil)) ! ;; It was a group name. ! (setq subscribed (= (following-char) ?:) ! group (symbol-name symbol) ! reads nil) ! (if (eolp) ! ;; If the line ends here, this is clearly a buggy line, so ! ;; we put point a the beginning of line and let the cond ! ;; below do the error handling. ! (beginning-of-line) ! ;; We skip to the beginning of the ranges. ! (skip-chars-forward "!: \t")) ! ;; 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 ! ;; faster than save-restriction/narrow, and save-restriction ! ;; produces a garbage object. ! (setq num1 (progn ! (narrow-to-region (match-beginning 0) (match-end 0)) ! (read buf))) ! (widen) ! ;; If the next character is a dash, then this is a range. ! (if (= (following-char) ?-) ! (progn ! ;; We read the upper bound of the range. ! (forward-char 1) ! (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)) ! (widen))) ! ;; It was just a simple number, so we add it to the ! ;; list of ranges. ! (setq reads (cons num1 reads))) ! ;; If the next char in ?\n, then we have reached the end ! ;; of the line and return nil. ! (/= (following-char) ?\n)) ! ((= (following-char) ?\n) ! ;; End of line, so we end. ! 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-error 3.1 "Mangled line: %s" ! (buffer-substring (gnus-point-at-bol) ! (gnus-point-at-eol))))) ! nil)) ! ;; Skip past ", ". Spaces are illegal in these ranges, but ! ;; we allow them, because it's a common mistake to put a ! ;; space after the comma. ! (skip-chars-forward ", ")) ! ! ;; 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) ! (if info ! ;; There is an entry for this file in the alist. ! (progn ! (gnus-info-set-read info (nreverse reads)) ! ;; We update the level very gently. In fact, we ! ;; only change it if there's been a status change ! ;; from subscribed to unsubscribed, or vice versa. ! (setq level (gnus-info-level info)) ! (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) ! () ! ;; We now have two newsrc lists - `newsrc', which is what we ! ;; 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) ! (while rc ! (or (null (nth 4 (car rc))) ; It's a native group. ! (assoc (caar rc) newsrc) ; It's already in the alist. ! (if (setq entry (assoc (caar prev) newsrc)) ! (setcdr (setq mentry (memq entry newsrc)) ! (cons (car rc) (cdr mentry))) ! (setq newsrc (cons (car rc) newsrc)))) ! (setq prev rc ! rc (cdr rc))))) ! ! (setq gnus-newsrc-alist newsrc) ! ;; We make the newsrc hashtb. ! (gnus-make-hashtable-from-newsrc-alist) ! ! ;; Finally, if we read some options lines, we parse them. ! (or (string= gnus-newsrc-options "") ! (gnus-newsrc-parse-options gnus-newsrc-options)))) ! ! ;; Parse options lines to find "options -n !all rec.all" and stuff. ! ;; The return value will be a list on the form ! ;; ((regexp1 . ignore) ! ;; (regexp2 . subscribe)...) ! ;; When handling new newsgroups, groups that match a `ignore' regexp ! ;; will be ignored, and groups that match a `subscribe' regexp will be ! ;; 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 ! (gnus-set-work-buffer) ! (insert (regexp-quote options)) ! ;; First we treat all continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\n[ \t]+" nil t) ! (replace-match " " t t)) ! ;; Then we transform all "all"s into ".+"s. ! (goto-char (point-min)) ! (while (re-search-forward "\\ball\\b" nil t) ! (replace-match ".+" t t)) ! (goto-char (point-min)) ! ;; We remove all other options than the "-n" ones. ! (while (re-search-forward "[ \t]-[^n][^-]*" nil t) ! (replace-match " ") ! (forward-char -1)) ! (goto-char (point-min)) ! ! ;; 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))) ! (gnus-point-at-eol))) ! ;; Search for all "words"... ! (while (re-search-forward "[^ \t,\n]+" eol t) ! (if (= (char-after (match-beginning 0)) ?!) ! ;; 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) ! "Save .newsrc file." ! ;; Note: We cannot save .newsrc file if all newsgroups are removed ! ;; from the variable gnus-newsrc-alist. ! (when (and (or gnus-newsrc-alist gnus-killed-list) ! gnus-current-startup-file) ! (save-excursion ! (if (and (or gnus-use-dribble-file gnus-slave) ! (not force) ! (or (not gnus-dribble-buffer) ! (not (buffer-name gnus-dribble-buffer)) ! (zerop (save-excursion ! (set-buffer gnus-dribble-buffer) ! (buffer-size))))) ! (gnus-message 4 "(No changes need to be saved)") ! (run-hooks 'gnus-save-newsrc-hook) ! (if gnus-slave ! (gnus-slave-save-newsrc) ! ;; Save .newsrc. ! (when gnus-save-newsrc-file ! (gnus-message 5 "Saving %s..." gnus-current-startup-file) ! (gnus-gnus-to-newsrc-format) ! (gnus-message 5 "Saving %s...done" gnus-current-startup-file)) ! ;; Save .newsrc.eld. ! (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")) ! (setq default-directory (file-name-directory buffer-file-name)) ! (gnus-add-current-to-buffer-list) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) ! (gnus-gnus-to-quick-newsrc-format) ! (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) ! (gnus-group-set-mode-line))))) ! ! (defun gnus-gnus-to-quick-newsrc-format () ! "Insert Gnus variables such as gnus-newsrc-alist in lisp format." ! (insert ";; Gnus startup file.\n") ! (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n") ! (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. ! (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) ! ;; Peel off the "dummy" group. ! (gnus-newsrc-alist (cdr gnus-newsrc-alist)) ! variable) ! ;; Insert the variables into the file. ! (while variables ! (when (and (boundp (setq variable (pop variables))) ! (symbol-value variable)) ! (insert "(setq " (symbol-name variable) " '") ! (prin1 (symbol-value variable) (current-buffer)) ! (insert ")\n"))))) ! ! (defun gnus-gnus-to-newsrc-format () ! ;; Generate and save the .newsrc file. ! (save-excursion ! (set-buffer (create-file-buffer gnus-current-startup-file)) ! (let ((newsrc (cdr gnus-newsrc-alist)) ! (standard-output (current-buffer)) ! info ranges range method) ! (setq buffer-file-name gnus-current-startup-file) ! (setq default-directory (file-name-directory buffer-file-name)) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! ;; Write options. ! (if gnus-newsrc-options (insert gnus-newsrc-options)) ! ;; Write subscribed and unsubscribed. ! (while (setq info (pop newsrc)) ! ;; Don't write foreign groups to .newsrc. ! (when (or (null (setq method (gnus-info-method info))) ! (equal method "native") ! (gnus-server-equal method gnus-select-method)) ! (insert (gnus-info-group info) ! (if (> (gnus-info-level info) gnus-level-subscribed) ! "!" ":")) ! (when (setq ranges (gnus-info-read info)) ! (insert " ") ! (if (not (listp (cdr ranges))) ! (if (= (car ranges) (cdr ranges)) ! (princ (car ranges)) ! (princ (car ranges)) ! (insert "-") ! (princ (cdr ranges))) ! (while (setq range (pop ranges)) ! (if (or (atom range) (= (car range) (cdr range))) ! (princ (or (and (atom range) range) (car range))) ! (princ (car range)) ! (insert "-") ! (princ (cdr range))) ! (if ranges (insert ","))))) ! (insert "\n"))) ! (make-local-variable 'version-control) ! (setq version-control 'never) ! ;; 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. ! (if gnus-modtime-botch ! (delete-file gnus-startup-file) ! (clear-visited-file-modtime)) ! (run-hooks 'gnus-save-standard-newsrc-hook) ! (save-buffer) ! (kill-buffer (current-buffer))))) ! ! ! ;;; ! ;;; Slave functions. ! ;;; ! ! (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) ! "-slave-"))) ! t)) ! file) ! (if (not slave-files) ! () ; There are no slave files to read. ! (gnus-message 7 "Reading slave newsrcs...") ! (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) ! (or (< (caar f1) (caar f2)) ! (< (nth 1 (car f1)) (nth 1 (car f2))))))) ! (while slave-files ! (erase-buffer) ! (setq file (nth 1 (car slave-files))) ! (insert-file-contents file) ! (if (condition-case () ! (progn ! (eval-buffer (current-buffer)) ! t) ! (error ! (gnus-error 3.2 "Possible error in %s" file) ! nil)) ! (or gnus-slave ; Slaves shouldn't delete these files. ! (condition-case () ! (delete-file file) ! (error nil)))) ! (setq slave-files (cdr slave-files)))) ! (gnus-message 7 "Reading slave newsrcs...done")))) ! ! ! ;;; ! ;;; Group description. ! ;;; ! ! (defun gnus-read-all-descriptions-files () ! (let ((methods (cons gnus-select-method ! (nconc ! (when (gnus-archive-server-wanted-p) ! (list "archive")) ! gnus-secondary-select-methods)))) ! (while methods ! (gnus-read-descriptions-file (car methods)) ! (setq methods (cdr methods))) ! t)) ! (defun gnus-read-descriptions-file (&optional method) ! (let ((method (or method gnus-select-method)) ! group) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! ;; 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) ! ((not (gnus-request-list-newsgroups method)) ! (gnus-message 1 "Couldn't read newsgroups descriptions") ! nil) ! (t ! (save-excursion ! (save-restriction ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (when (or (search-forward "\n.\n" nil t) ! (goto-char (point-max))) ! (beginning-of-line) ! (narrow-to-region (point-min) (point))) ! ;; 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))) ! (let ((prefix (gnus-group-prefixed-name "" method))) ! (goto-char (point-min)) ! (while (and (not (eobp)) ! (progn (insert prefix) ! (zerop (forward-line 1))))))) ! (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 ! ;; hash table. ! (read nntp-server-buffer)) ! (error 0))) ! (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") ! t)))) ! ! (defun gnus-group-get-description (group) ! "Get the description of a group by sending XGTITLE to the server." ! (when (gnus-request-group-description group) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") ! (match-string 1))))) ! ! ;;; ! ;;; Buffering of read articles. ! ;;; ! (defvar gnus-backlog-buffer " *Gnus Backlog*") ! (defvar gnus-backlog-articles nil) ! (defvar gnus-backlog-hashtb nil) ! ! (defun gnus-backlog-buffer () ! "Return the backlog buffer." ! (or (get-buffer gnus-backlog-buffer) ! (save-excursion ! (set-buffer (get-buffer-create gnus-backlog-buffer)) ! (buffer-disable-undo (current-buffer)) ! (setq buffer-read-only t) ! (gnus-add-current-to-buffer-list) ! (get-buffer gnus-backlog-buffer)))) ! ! (defun gnus-backlog-setup () ! "Initialize backlog variables." ! (unless gnus-backlog-hashtb ! (setq gnus-backlog-hashtb (make-vector 1023 0)))) ! ! (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) ! ! (defun gnus-backlog-shutdown () ! "Clear all backlog variables and buffers." ! (when (get-buffer gnus-backlog-buffer) ! (kill-buffer gnus-backlog-buffer)) ! (setq gnus-backlog-hashtb nil ! gnus-backlog-articles nil)) ! ! (defun gnus-backlog-enter-article (group number buffer) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) ! b) ! (if (memq ident gnus-backlog-articles) ! () ; It's already kept. ! ;; Remove the oldest article, if necessary. ! (and (numberp gnus-keep-backlog) ! (>= (length gnus-backlog-articles) gnus-keep-backlog) ! (gnus-backlog-remove-oldest-article)) ! (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) ! ;; Insert the new article. ! (save-excursion ! (set-buffer (gnus-backlog-buffer)) ! (let (buffer-read-only) ! (goto-char (point-max)) ! (or (bolp) (insert "\n")) ! (setq b (point)) ! (insert-buffer-substring buffer) ! ;; Tag the beginning of the article with the ident. ! (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) ! (defun gnus-backlog-remove-oldest-article () ! (save-excursion ! (set-buffer (gnus-backlog-buffer)) ! (goto-char (point-min)) ! (if (zerop (buffer-size)) ! () ; The buffer is empty. ! (let ((ident (get-text-property (point) 'gnus-backlog)) ! buffer-read-only) ! ;; Remove the ident from the list of articles. ! (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))))))) ! ! (defun gnus-backlog-remove-article (group number) ! "Remove article NUMBER in GROUP from the backlog." ! (when (numberp number) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) ! beg end) ! (when (memq ident gnus-backlog-articles) ! ;; It was in the backlog. ! (save-excursion ! (set-buffer (gnus-backlog-buffer)) ! (let (buffer-read-only) ! (when (setq beg (text-property-any ! (point-min) (point-max) 'gnus-backlog ! ident)) ! ;; 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))) ! (delete-region beg end) ! ;; Return success. ! t))))))) ! ! (defun gnus-backlog-request-article (group number buffer) ! (when (numberp number) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) ! beg end) ! (when (memq ident gnus-backlog-articles) ! ;; 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. ! (ignore ! (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) ! ;; 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) ! (insert-buffer-substring gnus-backlog-buffer beg end) ! t))))) ;; Allow redefinition of Gnus functions. --- 733,783 ---- (setq valids (cdr valids))) outs)) ! ;;; User-level commands. ! ;;;###autoload ! (defun gnus-slave-no-server (&optional arg) ! "Read network news as a slave, without connecting to local server" (interactive "P") ! (gnus-no-server arg t)) ! ;;;###autoload ! (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." ! (interactive "P") ! (let ((val (or arg (1- gnus-level-default-subscribed)))) ! (gnus val t slave) ! (make-local-variable 'gnus-group-use-permanent-levels) ! (setq gnus-group-use-permanent-levels val))) ! ;;;###autoload ! (defun gnus-slave (&optional arg) ! "Read news as a slave." ! (interactive "P") ! (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))) ! (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") ! (gnus-1 arg dont-connect slave)) ;; Allow redefinition of Gnus functions. *** pub/rgnus/lisp/message.el Tue Jul 30 21:30:18 1996 --- rgnus/lisp/message.el Mon Jul 29 22:37:02 1996 *************** *** 968,975 **** (file-exists-p message-signature-file)) signature)))) (when signature - ;; Insert the signature. (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert "\n-- \n") --- 968,975 ---- (file-exists-p message-signature-file)) signature)))) (when signature (goto-char (point-max)) + ;; Insert the signature. (unless (bolp) (insert "\n")) (insert "\n-- \n") *** pub/rgnus/lisp/nndb.el Wed Jun 12 22:30:39 1996 --- rgnus/lisp/nndb.el Sun Jul 28 20:30:58 1996 *************** *** 30,35 **** --- 30,39 ---- ;;- ;; Register nndb with known select methods. + (require 'gnus) + (require 'gnus-load) + (require 'nnmail) + (setq gnus-valid-select-methods (cons '("nndb" mail address respool prompt-address) gnus-valid-select-methods)) *** pub/rgnus/lisp/nndoc.el Wed Jun 5 19:17:38 1996 --- rgnus/lisp/nndoc.el Tue Jul 30 21:55:35 1996 *************** *** 67,100 **** (forward (article-begin . "^-+ Start of forwarded message -+\n+") (body-end . "^-+ End of forwarded message -+$") ! (prepare-body . nndoc-unquote-dashes)) (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 . "^ ?$") ! (body-end-function . nndoc-digest-body-end) ! (body-begin . "^ ?$") ! (file-end . "^End of") ! (prepare-body . nndoc-unquote-dashes)) (mime-digest (article-begin . "") (head-end . "^ ?$") (body-end . "") ! (file-end . "")) (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) ! (prepare-body . nndoc-unquote-dashes) (body-end-function . nndoc-digest-body-end) (head-end . "^ ?$") (body-begin . "^ ?\n") ! (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")) (guess (guess . nndoc-guess-type)) (digest --- 67,103 ---- (forward (article-begin . "^-+ Start of forwarded message -+\n+") (body-end . "^-+ End of forwarded message -+$") ! (prepare-body-function . nndoc-unquote-dashes)) (clari-briefs (article-begin . "^ \\*") (body-end . "^\t------*[ \t]^*\n^ \\*") (body-begin . "^\t") (head-end . "^\t") ! (generate-head-function . nndoc-generate-clari-briefs-head) ! (article-transform-function . nndoc-transform-clari-briefs)) (mime-digest (article-begin . "") (head-end . "^ ?$") (body-end . "") ! (file-end . "") ! (subtype digest guess)) (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) ! (prepare-body-function . nndoc-unquote-dashes) (body-end-function . nndoc-digest-body-end) (head-end . "^ ?$") (body-begin . "^ ?\n") ! (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$") ! (subtype digest guess)) ! (slack-digest ! (article-begin . "^------------------------------*[\n \t]+") ! (head-end . "^ ?$") ! (body-end-function . nndoc-digest-body-end) ! (body-begin . "^ ?$") ! (file-end . "^End of") ! (prepare-body-function . nndoc-unquote-dashes) ! (subtype digest guess)) (guess (guess . nndoc-guess-type)) (digest *************** *** 116,124 **** (defvoo nndoc-head-begin-function nil) (defvoo nndoc-body-end nil) (defvoo nndoc-dissection-alist nil) ! (defvoo nndoc-prepare-body nil) ! (defvoo nndoc-generate-head nil) ! (defvoo nndoc-article-transform nil) (defvoo nndoc-status-string "") (defvoo nndoc-group-alist nil) --- 119,127 ---- (defvoo nndoc-head-begin-function nil) (defvoo nndoc-body-end nil) (defvoo nndoc-dissection-alist nil) ! (defvoo nndoc-prepare-body-function nil) ! (defvoo nndoc-generate-head-function nil) ! (defvoo nndoc-article-transform-function nil) (defvoo nndoc-status-string "") (defvoo nndoc-group-alist nil) *************** *** 147,154 **** (when (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)) --- 150,157 ---- (when (setq entry (cdr (assq (setq article (pop articles)) nndoc-dissection-alist))) (insert (format "221 %d Article retrieved.\n" article)) ! (if nndoc-generate-head-function ! (funcall nndoc-generate-head-function article) (insert-buffer-substring nndoc-current-buffer (car entry) (nth 1 entry))) (goto-char (point-max)) *************** *** 176,185 **** (insert-buffer-substring nndoc-current-buffer (nth 2 entry) (nth 3 entry)) (goto-char beg) ! (when nndoc-prepare-body ! (funcall nndoc-prepare-body)) ! (when nndoc-article-transform ! (funcall nndoc-article-transform article)) t)))) (deffoo nndoc-request-group (group &optional server dont-check) --- 179,188 ---- (insert-buffer-substring nndoc-current-buffer (nth 2 entry) (nth 3 entry)) (goto-char beg) ! (when nndoc-prepare-body-function ! (funcall nndoc-prepare-body-function)) ! (when nndoc-article-transform-function ! (funcall nndoc-article-transform-function article)) t)))) (deffoo nndoc-request-group (group &optional server dont-check) *************** *** 269,333 **** ;; Return whether we managed to select a file. nndoc-current-buffer)) ! ;; MIME (RFC 1341) digest hack by Ulrik Dickow . ! (defun nndoc-guess-digest-type () ! "Guess what digest type the current document is." ! (let ((case-fold-search t) ; We match a bit too much, keep it simple. ! boundary-id b-delimiter entry) ! (goto-char (point-min)) ! (cond ! ;; MIME digest. ! ((and ! (re-search-forward ! (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" ! "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") ! nil t) ! (match-beginning 1)) ! (setq boundary-id (match-string 1) ! b-delimiter (concat "\n--" boundary-id "[\n \t]+")) ! (setq entry (assq 'mime-digest nndoc-type-alist)) ! (setcdr entry ! (list ! (cons 'head-end "^ ?$") ! (cons 'body-begin "^ ?\n") ! (cons 'article-begin b-delimiter) ! (cons 'body-end-function 'nndoc-digest-body-end) ! ; (cons 'body-end ! ; (concat "\n--" boundary-id "\\(--\\)?[\n \t]+")) ! (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) ! 'mime-digest) ! ;; Standard digest. ! ((and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) ! (re-search-forward ! (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) ! 'standard-digest) ! ;; Stupid digest. ! (t ! 'slack-digest)))) ! ! (defun nndoc-guess-type () ! "Guess what document type is in the current buffer." ! (goto-char (point-min)) ! (cond ! ((looking-at message-unix-mail-delimiter) ! 'mbox) ! ((looking-at "\^A\^A\^A\^A$") ! 'mmdf) ! ((looking-at "^Path:.*\n") ! 'news) ! ((looking-at "#! *rnews") ! '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) ! (t ! 'digest))) (defun nndoc-set-delims () "Set the nndoc delimiter variables according to the type of the document." --- 272,280 ---- ;; Return whether we managed to select a file. nndoc-current-buffer)) ! ;;; ! ;;; Deciding what document type we have ! ;;; (defun nndoc-set-delims () "Set the nndoc delimiter variables according to the type of the document." *************** *** 336,356 **** 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 nndoc-body-begin-function nndoc-head-begin-function))) (while vars (set (pop vars) nil))) ! (let* (defs guess) ;; Guess away until we find the real file type. (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)) guess (assq 'guess defs)) ! (setq nndoc-article-type (funcall (cdr guess)))) ;; Set the nndoc variables. (while defs (set (intern (format "nndoc-%s" (caar defs))) (cdr (pop defs)))))) (defun nndoc-search (regexp) (prog1 (re-search-forward regexp nil t) --- 283,453 ---- 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-function nndoc-article-transform-function ! nndoc-generate-head-function nndoc-body-begin-function nndoc-head-begin-function))) (while vars (set (pop vars) nil))) ! (let (defs) ;; Guess away until we find the real file type. (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)) guess (assq 'guess defs)) ! (setq nndoc-article-type (nndoc-guess-type nndoc-article-type))) ;; Set the nndoc variables. (while defs (set (intern (format "nndoc-%s" (caar defs))) (cdr (pop defs)))))) + (defun nndoc-guess-type (subtype) + (let ((alist nndoc-type-alist) + results result entry) + (while (and (not result) + (setq entry (pop alist))) + (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) + (goto-char (point-min)) + (when (numberp (setq result (funcall (intern + (format "nndoc-%s-type-p" + (car entry)))))) + (push (cons result entry) results) + (setq result nil)))) + (unless (or result results) + (error "Document is not of any recognized type")) + (if result + (car entry) + (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2)))))))) + + ;;; + ;;; Built-in type predicates and functions + ;;; + + (defun nndoc-mbox-type-p () + (when (looking-at message-unix-mail-delimiter) + t)) + + (defun nndoc-mbox-body-end () + (let ((beg (point)) + len end) + (when + (save-excursion + (and (re-search-backward nndoc-article-begin nil t) + (setq end (point)) + (search-forward "\n\n" beg t) + (re-search-backward + "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) + (setq len (string-to-int (match-string 1))) + (search-forward "\n\n" beg t) + (or (= (setq len (+ (point) len)) (point-max)) + (and (< len (point-max)) + (goto-char len) + (looking-at nndoc-article-begin))))) + (goto-char len)))) + + (defun nndoc-mmdf-type-p () + (when (looking-at "\^A\^A\^A\^A$") + t)) + + (defun nndoc-news-type-p () + (when (looking-at "^Path:.*\n") + t)) + + (defun nndoc-rnews-type-p () + (when (looking-at "#! *rnews") + t)) + + (defun nndoc-rnews-body-end () + (and (re-search-backward nndoc-article-begin nil t) + (forward-line 1) + (goto-char (+ (point) (string-to-int (match-string 1)))))) + + (defun nndoc-babyl-type-p () + (when (re-search-forward "\^_\^L *\n" nil t) + t)) + + (defun nndoc-babyl-body-begin () + (re-search-forward "^\n" nil t) + (when (looking-at "\*\*\* EOOH \*\*\*") + (re-search-forward "^\n" nil t))) + + (defun nndoc-babyl-head-begin () + (when (re-search-forward "^[0-9].*\n" nil t) + (when (looking-at "\*\*\* EOOH \*\*\*") + (forward-line 1)) + t)) + + (defun nndoc-forward-type-p () + (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) + (not (re-search-forward "^Subject:.*digest" nil t))) + t)) + + (defun nndoc-clari-briefs-type-p () + (when (let ((case-fold-search nil)) + (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) + t)) + + (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 (string-match "[ \t]+$" subject) + (setq subject (substring subject 0 (match-beginning 0))))) + (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"))) + + (defun nndoc-mime-digest-type-p () + (let ((case-fold-search t) + boundary-id b-delimiter entry) + (when (and + (re-search-forward + (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" + "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") + nil t) + (match-beginning 1)) + (setq boundary-id (match-string 1) + b-delimiter (concat "\n--" boundary-id "[\n \t]+")) + (setq entry (assq 'mime-digest nndoc-type-alist)) + (setcdr entry + (list + (cons 'head-end "^ ?$") + (cons 'body-begin "^ ?\n") + (cons 'article-begin b-delimiter) + (cons 'body-end-function 'nndoc-digest-body-end) + (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) + t))) + + (defun nndoc-standard-digest-type-p () + (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) + (re-search-forward + (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) + t)) + + (defun nndoc-digest-body-end () + (and (re-search-forward nndoc-article-begin nil t) + (goto-char (match-beginning 0)))) + + (defun nndoc-slack-digest-type-p () + 0) + + ;;; + ;;; Functions for dissecting the documents + ;;; + (defun nndoc-search (regexp) (prog1 (re-search-forward regexp nil t) *************** *** 407,475 **** (while (re-search-forward "^- -"nil t) (replace-match "-" t t))) ! (defun nndoc-digest-body-end () ! (and (re-search-forward nndoc-article-begin nil t) ! (goto-char (match-beginning 0)))) ! ! (defun nndoc-mbox-body-end () ! (let ((beg (point)) ! len end) ! (when ! (save-excursion ! (and (re-search-backward nndoc-article-begin nil t) ! (setq end (point)) ! (search-forward "\n\n" beg t) ! (re-search-backward ! "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) ! (setq len (string-to-int (match-string 1))) ! (search-forward "\n\n" beg t) ! (or (= (setq len (+ (point) len)) (point-max)) ! (and (< len (point-max)) ! (goto-char len) ! (looking-at nndoc-article-begin))))) ! (goto-char len)))) ! ! (defun nndoc-rnews-body-end () ! (and (re-search-backward nndoc-article-begin nil t) ! (forward-line 1) ! (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 (string-match "[ \t]+$" subject) ! (setq subject (substring subject 0 (match-beginning 0))))) ! (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"))) ! ! (defun nndoc-babyl-body-begin () ! (re-search-forward "^\n" nil t) ! (when (looking-at "\*\*\* EOOH \*\*\*") ! (re-search-forward "^\n" nil t))) ! ! (defun nndoc-babyl-head-begin () ! (when (re-search-forward "^[0-9].*\n" nil t) ! (when (looking-at "\*\*\* EOOH \*\*\*") ! (forward-line 1)) ! t)) (provide 'nndoc) --- 504,526 ---- (while (re-search-forward "^- -"nil t) (replace-match "-" t t))) ! ;;;###autoload ! (defun nndoc-add-type (definition &optional position) ! "Add document DEFINITION to the list of nndoc document definitions. ! If POSITION is nil or `last', the definition will be added ! as the last checked definition, if t or `first', add as the ! first definition, and if any other symbol, add after that ! symbol in the alist." ! (cond ! ((or (null position) (eq position 'last)) ! (setq nndoc-type-alist (nconc nndoc-type-alist (list definition)))) ! ((or (eq position t) (eq position 'first)) ! (push definition nndoc-type-alist)) ! (t ! (let ((list (memq (assq position nndoc-type-alist)))) ! (unless list ! (error "No such position: %s" position)) ! (setcdr list (cons definition (cdr list))))))) (provide 'nndoc) *** pub/rgnus/lisp/nnheader.el Sat Jul 6 05:45:11 1996 --- rgnus/lisp/nnheader.el Mon Jul 29 21:03:15 1996 *************** *** 269,282 **** (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) (buffer-disable-undo (current-buffer)) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. t)) - ;;; Various functions the backends use. --- 269,282 ---- (defun nnheader-init-server-buffer () "Initialize the Gnus-backend communication buffer." (save-excursion ! (unless (gnus-buffer-live-p nntp-server-buffer) ! (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) (set-buffer nntp-server-buffer) (buffer-disable-undo (current-buffer)) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. t)) ;;; Various functions the backends use. *** pub/rgnus/lisp/nnkiboze.el Tue May 21 19:37:45 1996 --- rgnus/lisp/nnkiboze.el Sun Jul 28 09:02:06 1996 *************** *** 88,94 **** 'nov)))))) (deffoo nnkiboze-open-server (newsgroups &optional something) ! (gnus-make-directory nnkiboze-directory) (nnheader-init-server-buffer)) (deffoo nnkiboze-server-opened (&optional server) --- 88,94 ---- 'nov)))))) (deffoo nnkiboze-open-server (newsgroups &optional something) ! (make-directory nnkiboze-directory t) (nnheader-init-server-buffer)) (deffoo nnkiboze-server-opened (&optional server) *** pub/rgnus/lisp/nntp.el Tue Jul 30 19:55:02 1996 --- rgnus/lisp/nntp.el Tue Jul 30 22:38:49 1996 *************** *** 1,8 **** ;;; 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 ;; Keywords: news ;; This file is part of GNU Emacs. --- 1,7 ---- ;;; nntp.el --- nntp access for Gnus ;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc. ! ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. *************** *** 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: --- 17,24 ---- ;; 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: *************** *** 28,34 **** (require 'nnheader) (require 'nnoo) ! (eval-when-compile (require 'cl)) (nnoo-declare nntp) --- 26,32 ---- (require 'nnheader) (require 'nnoo) ! (require 'gnus-util) (nnoo-declare nntp) *************** *** 38,66 **** (eval-when-compile (require 'cl)) ! (eval-and-compile ! (autoload 'cancel-timer "timer") ! (autoload 'telnet "telnet" nil t) ! (autoload 'telnet-send-input "telnet" nil t) ! (autoload 'timezone-parse-date "timezone")) ! ! (defvoo nntp-server-hook nil ! "*Hooks for the NNTP server. ! If the kanji code of the NNTP server is different from the local kanji ! code, the correct kanji code of the buffer associated with the NNTP ! server must be specified as follows: ! ! \(setq nntp-server-hook ! (function ! (lambda () ! ;; Server's Kanji code is EUC (NEmacs hack). ! (make-local-variable 'kanji-fileio-code) ! (setq kanji-fileio-code 0)))) ! If you'd like to change something depending on the server in this ! hook, use the variable `nntp-address'.") ! (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this --- 36,48 ---- (eval-when-compile (require 'cl)) ! (defvoo nntp-address nil ! "Address of the physical nntp server.") ! (defvoo nntp-port-number "nntp" ! "Port number on the physical nntp server.") ! (defvoo nntp-server-opened-hook nil "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this *************** *** 81,87 **** You probably don't want to do that, though.") ! (defvoo 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. --- 63,69 ---- You probably don't want to do that, though.") ! (defvoo nntp-open-connection-function 'nntp-open-network-stream "*Function used for connecting to a remote system. It will be called with the address of the remote system. *************** *** 92,98 **** NNTP server available there (see nntp-rlogin-parameters).") (defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") ! "*Parameters to `nntp-open-rlogin'. That function may be used as `nntp-open-server-function'. In that case, this list will be used as the parameter list given to rsh.") --- 74,80 ---- NNTP server available there (see nntp-rlogin-parameters).") (defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") ! "*Parameters to `nntp-open-login'. That function may be used as `nntp-open-server-function'. In that case, this list will be used as the parameter list given to rsh.") *************** *** 111,122 **** (defvoo nntp-telnet-passwd nil "Password to use to log in via telnet with.") - (defvoo nntp-address nil - "*The name of the NNTP server.") - - (defvoo nntp-port-number "nntp" - "*Port number to connect to.") - (defvoo nntp-end-of-line "\r\n" "String to use on the end of lines when talking to the NNTP server. This is \"\\r\\n\" by default, but should be \"\\n\" when --- 93,98 ---- *************** *** 127,148 **** If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") - (defvoo nntp-buggy-select (memq system-type '(fujitsu-uts)) - "*t if your select routine is buggy. - If the select routine signals error or fall into infinite loop while - waiting for the server response, the variable must be set to t. In - case of Fujitsu UTS, it is set to T since `accept-process-output' - doesn't work properly.") - (defvoo nntp-maximum-request 400 "*The maximum number of the requests sent to the NNTP server at one time. If Emacs hangs up while retrieving headers, set the variable to a lower value.") - (defvoo nntp-debug-read 10000 - "*Display '...' every 10Kbytes of a message being received if it is non-nil. - If it is a number, dots are displayed per the number.") - (defvoo nntp-nov-is-evil nil "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") --- 103,113 ---- *************** *** 161,176 **** "*Number of seconds to wait before an nntp connection times out. If this variable is nil, which is the default, no timers are set.") - (defvoo nntp-command-timeout nil - "*Number of seconds to wait for a response when sending a command. - If this variable is nil, which is the default, no timers are set.") - - (defvoo nntp-retry-on-break nil - "*If non-nil, re-send the command when the user types `C-g'.") - - (defvoo nntp-news-default-headers nil - "*If non-nil, override `mail-default-headers' when posting news.") - (defvoo nntp-prepare-server-hook nil "*Hook run before a server is opened. If can be used to set up a server remotely, for instance. Say you --- 126,131 ---- *************** *** 179,230 **** then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to.") - (defvoo nntp-async-number 5 - "*How many articles should be prefetched when in asynchronous mode.") - (defvoo nntp-warn-about-losing-connection t "*If non-nil, beep when a server closes connection.") ! (defconst nntp-version "nntp 4.0" ! "Version numbers of this version of NNTP.") - (defvar nntp-server-buffer nil - "Buffer associated with the NNTP server process.") - - (defvoo nntp-server-process nil - "The NNTP server process. - You'd better not use this variable in NNTP front-end program, but - instead use `nntp-server-buffer'.") - - (defvoo nntp-status-string nil - "Save the server response message.") - - (defvar nntp-opened-connections nil - "All (possibly) opened connections.") - - (defvoo nntp-server-xover 'try) - (defvoo nntp-server-list-active-group 'try) - (defvoo nntp-current-group "") (defvoo nntp-server-type nil) ! (defvoo nntp-async-process nil) ! (defvoo nntp-async-buffer nil) ! (defvoo nntp-async-articles nil) ! (defvoo nntp-async-fetched nil) ! (defvoo nntp-async-group-alist nil) ;;; Interface functions. (nnoo-define-basics nntp) (deffoo nntp-retrieve-headers (articles &optional group server fetch-old) "Retrieve the headers of ARTICLES." ! (nntp-possibly-change-server group server) (save-excursion ! (set-buffer nntp-server-buffer) (erase-buffer) (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) --- 134,166 ---- then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to.") (defvoo nntp-warn-about-losing-connection t "*If non-nil, beep when a server closes connection.") ! ;;; Internal variables. (defvoo nntp-server-type nil) + (defvar nntp-connection-alist nil) + (defvar nntp-status-string "") + (defconst nntp-version "nntp 5.0") + (defvar nntp-inhibit-erase nil) ! (defvar nntp-server-xover 'try) ! (defvar nntp-server-list-active-group 'try) + ;;; Interface functions. (nnoo-define-basics nntp) (deffoo nntp-retrieve-headers (articles &optional group server fetch-old) "Retrieve the headers of ARTICLES." ! (nntp-possibly-change-group group server) (save-excursion ! (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) (erase-buffer) (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) *************** *** 236,246 **** (let ((number (length articles)) (count 0) (received 0) - (message-log-max nil) (last-point (point-min))) ;; Send HEAD command. (while articles ! (nntp-send-strings-to-server "HEAD" (if (numberp (car articles)) (int-to-string (car articles)) ;; `articles' is either a list of article numbers --- 172,182 ---- (let ((number (length articles)) (count 0) (received 0) (last-point (point-min))) ;; Send HEAD command. (while articles ! (nntp-send-command ! nil "HEAD" (if (numberp (car articles)) (int-to-string (car articles)) ;; `articles' is either a list of article numbers *************** *** 265,272 **** (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% received 20)) ! (nnheader-message 7 "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) (nntp-accept-response)))) ;; Wait for text of last command. (goto-char (point-max)) --- 201,208 ---- (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% received 20)) ! (message "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) (nntp-accept-response)))) ;; Wait for text of last command. (goto-char (point-max)) *************** *** 278,284 **** (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (nnheader-message 7 "NNTP: Receiving headers...done")) ;; Now all of replies are received. Fold continuation lines. (nnheader-fold-continuation-lines) --- 214,220 ---- (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (message "NNTP: Receiving headers...done")) ;; Now all of replies are received. Fold continuation lines. (nnheader-fold-continuation-lines) *************** *** 286,588 **** (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t)) 'headers)))) ! (deffoo nntp-retrieve-groups (groups &optional server) ! "Retrieve group info on GROUPS." ! (nntp-possibly-change-server nil server) ! (save-excursion ! (set-buffer nntp-server-buffer) ! ;; The first time this is run, this variable is `try'. So we ! ;; try. ! (when (eq nntp-server-list-active-group 'try) ! (nntp-try-list-active (car groups))) ! (erase-buffer) ! (let ((count 0) ! (received 0) ! (last-point (point-min)) ! (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) ! (while groups ! ;; Send the command to the server. ! (nntp-send-strings-to-server command (car groups)) ! (setq groups (cdr groups)) ! (setq count (1+ count)) ! ;; Every 400 requests we have to read the stream in ! ;; order to avoid deadlocks. ! (when (or (null groups) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (nntp-accept-response)))) ! ;; Wait for the reply from the final command. ! (when nntp-server-list-active-group ! (goto-char (point-max)) ! (re-search-backward "^[0-9]" nil t) ! (when (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response)))) ! ;; Now all replies are received. We remove CRs. ! (goto-char (point-min)) ! (while (search-forward "\r" nil t) ! (replace-match "" t t)) ! (if (not nntp-server-list-active-group) ! 'group ! ;; We have read active entries, so we just delete the ! ;; superfluos gunk. ! (goto-char (point-min)) ! (while (re-search-forward "^[.2-5]" nil t) ! (delete-region (match-beginning 0) ! (progn (forward-line 1) (point)))) ! 'active)))) (deffoo nntp-open-server (server &optional defs connectionless) - "Open the virtual server SERVER. - If CONNECTIONLESS is non-nil, don't attempt to connect to any physical - servers." (nnheader-init-server-buffer) - ;; Called with just a port number as the defs. - (when (or (stringp (car defs)) - (numberp (car defs))) - (setq defs `((nntp-port-number ,(car defs))))) - (unless (assq 'nntp-address defs) - (setq defs (append defs `((nntp-address ,server))))) - (nnoo-change-server 'nntp server defs) (if (nntp-server-opened server) t ! (or (nntp-server-opened server) ! connectionless ! (prog2 ! (run-hooks 'nntp-prepare-server-hook) ! (nntp-open-server-semi-internal nntp-address nntp-port-number) ! (nnheader-insert ""))))) (deffoo nntp-close-server (&optional server) ! "Close connection to SERVER." ! (nntp-possibly-change-server nil server t) ! (unwind-protect ! (progn ! ;; Un-set default sentinel function before closing connection. ! (and nntp-server-process ! (eq 'nntp-default-sentinel ! (process-sentinel nntp-server-process)) ! (set-process-sentinel nntp-server-process nil)) ! ;; We cannot send QUIT command unless the process is running. ! (when (nntp-server-opened server) ! (nntp-send-command nil "QUIT") ! ;; Give the QUIT time to arrive. ! (sleep-for 1))) ! (nntp-close-server-internal server))) ! ! (deffoo nntp-request-close () ! "Close all server connections." ! (let (proc) ! (while nntp-opened-connections ! (when (setq proc (pop nntp-opened-connections)) ! ;; Un-set default sentinel function before closing connection. ! (when (eq 'nntp-default-sentinel (process-sentinel proc)) ! (set-process-sentinel proc nil)) ! (condition-case () ! (process-send-string proc (concat "QUIT" nntp-end-of-line)) ! (error nil)) ! ;; Give the QUIT time to reach the server before we close ! ;; down the process. ! (sleep-for 1) ! (delete-process proc))) ! (and nntp-async-buffer ! (buffer-name nntp-async-buffer) ! (kill-buffer nntp-async-buffer)) ! (let ((alist (cddr (assq 'nntp nnoo-state-alist))) ! entry) ! (while (setq entry (pop alist)) ! (and (setq proc (cdr (assq 'nntp-async-buffer entry))) ! (buffer-name proc) ! (kill-buffer proc)))) ! (nnoo-close-server 'nntp) ! (setq nntp-async-group-alist nil ! nntp-async-articles nil))) ! ! (deffoo nntp-server-opened (&optional server) ! "Say whether a connection to SERVER has been opened." ! (and (nnoo-current-server-p 'nntp server) ! nntp-server-buffer ! (buffer-name nntp-server-buffer) ! nntp-server-process ! (memq (process-status nntp-server-process) '(open run)))) ! ! (deffoo nntp-status-message (&optional server) ! "Return server status as a string." ! (if (and nntp-status-string ! ;; NNN MESSAGE ! (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" ! nntp-status-string)) ! (substring nntp-status-string (match-beginning 1) (match-end 1)) ! ;; Empty message if nothing. ! (or nntp-status-string ""))) ! ! (deffoo nntp-request-article (id &optional group server buffer) ! "Request article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) ! ! (let (found) ! ! ;; First we see whether we can get the article from the async buffer. ! (when (and (numberp id) ! nntp-async-articles ! (memq id nntp-async-fetched)) ! (save-excursion ! (set-buffer nntp-async-buffer) ! (let ((opoint (point)) ! (art (if (numberp id) (int-to-string id) id)) ! beg end) ! (when (and (or (re-search-forward (concat "^2.. +" art) nil t) ! (progn ! (goto-char (point-min)) ! (re-search-forward (concat "^2.. +" art) opoint t))) ! (progn ! (beginning-of-line) ! (setq beg (point) ! end (re-search-forward "^\\.\r?\n" nil t)))) ! (setq found t) ! (save-excursion ! (set-buffer (or buffer nntp-server-buffer)) ! (erase-buffer) ! (insert-buffer-substring nntp-async-buffer beg end) ! (let ((nntp-server-buffer (current-buffer))) ! (nntp-decode-text))) ! (delete-region beg end) ! (when nntp-async-articles ! (nntp-async-fetch-articles id)))))) ! ! (if found ! id ! ;; The article was not in the async buffer, so we fetch it now. ! (unwind-protect ! (progn ! (if buffer (set-process-buffer nntp-server-process buffer)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer)) ! (art (or (and (numberp id) (int-to-string id)) id))) ! (prog1 ! (and (nntp-send-command ! ;; A bit odd regexp to ensure working over rlogin. ! "^\\.\r?\n" "ARTICLE" art) ! (if (numberp id) ! (cons nntp-current-group id) ! ;; We find out what the article number was. ! (nntp-find-group-and-number))) ! (nntp-decode-text) ! (and nntp-async-articles (nntp-async-fetch-articles id))))) ! (when buffer ! (set-process-buffer nntp-server-process nntp-server-buffer)))))) ! ! (deffoo nntp-request-body (id &optional group server) ! "Request body of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) ! (prog1 ! ;; If NEmacs, end of message may look like: "\256\215" (".^M") ! (nntp-send-command ! "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) ! (nntp-decode-text))) ! ! (deffoo nntp-request-head (id &optional group server) ! "Request head of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) ! (prog1 ! (when (nntp-send-command ! "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id)) ! (if (numberp id) id ! ;; We find out what the article number was. ! (nntp-find-group-and-number))) ! (nntp-decode-text) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (nnheader-fold-continuation-lines)))) ! ! (deffoo nntp-request-stat (id &optional group server) ! "Request STAT of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) ! (nntp-send-command ! "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) ! ! (deffoo nntp-request-type (group &optional article) ! 'news) ! ! (deffoo nntp-request-group (group &optional server dont-check) ! "Select GROUP." ! (nntp-possibly-change-server nil server) ! (setq nntp-current-group ! (when (nntp-send-command "^2.*\r?\n" "GROUP" group) ! group))) ! ! (deffoo nntp-request-asynchronous (group &optional server articles) ! "Enable pre-fetch in GROUP." ! (when nntp-async-articles ! (nntp-async-request-group group)) ! (when nntp-async-number ! (if (not (or (nntp-async-server-opened) ! (nntp-async-open-server))) ! ;; Couldn't open the second connection ! (progn ! (message "Can't open second connection to %s" nntp-address) ! (ding) ! (setq nntp-async-articles nil) ! (sit-for 2)) ! ;; We opened the second connection (or it was opened already). ! (setq nntp-async-articles articles) ! (setq nntp-async-fetched nil) ! ;; Clear any old data. ! (save-excursion ! (set-buffer nntp-async-buffer) ! (erase-buffer)) ! ;; Select the correct current group on this server. ! (nntp-async-send-strings "GROUP" group) ! t))) ! ! (deffoo nntp-list-active-group (group &optional server) ! "Return the active info on GROUP (which can be a regexp." ! (nntp-possibly-change-server group server) ! (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) ! ! (deffoo nntp-request-group-description (group &optional server) ! "Get the description of GROUP." ! (nntp-possibly-change-server nil server) ! (prog1 ! (nntp-send-command "^.*\r?\n" "XGTITLE" group) ! (nntp-decode-text))) ! ! (deffoo nntp-close-group (group &optional server) ! "Close GROUP." ! (setq nntp-current-group nil) ! t) (deffoo nntp-request-list (&optional server) ! "List all active groups." ! (nntp-possibly-change-server nil server) ! (prog1 ! (nntp-send-command "^\\.\r?\n" "LIST") ! (nntp-decode-text))) (deffoo nntp-request-list-newsgroups (&optional server) ! "Get descriptions on all groups on SERVER." ! (nntp-possibly-change-server nil server) ! (prog1 ! (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS") ! (nntp-decode-text))) (deffoo nntp-request-newgroups (date &optional server) ! "List groups that have arrived since DATE." ! (nntp-possibly-change-server nil server) (let* ((date (timezone-parse-date date)) (time-string (format "%s%02d%02d %s%s%s" --- 222,299 ---- (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t)) + (copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'headers)))) + (deffoo nntp-request-article (article &optional group server buffer) + (nntp-possibly-change-group group server) + (when (nntp-send-command-and-decode + "\r\n\\.\r\n" "ARTICLE" + (if (numberp article) (int-to-string article) article)) + (when buffer + (save-excursion + (set-buffer nntp-server-buffer) + (copy-to-buffer buffer (point-min) (point-max))) + t))) ! (deffoo nntp-request-body (article &optional group server) ! (nntp-possibly-change-group group server) ! (nntp-send-command ! "\r\n\\.\r\n" "BODY" ! (if (numberp article) (int-to-string article) article))) ! (deffoo nntp-request-group (group &optional server dont-check) ! (nntp-possibly-change-group nil server) ! (when (nntp-send-command "^2.*\r\n" "GROUP" group) ! (let ((entry (nntp-find-connection-entry nntp-server-buffer))) ! (setcar (cddr entry) group)))) ! (deffoo nntp-close-group (group &optional server) ! t) ! (deffoo nntp-server-opened (&optional server) ! "Say whether a connection to SERVER has been opened." ! (and (nnoo-current-server-p 'nntp server) ! nntp-server-buffer ! (gnus-buffer-live-p nntp-server-buffer) ! (nntp-find-connection nntp-server-buffer))) (deffoo nntp-open-server (server &optional defs connectionless) (nnheader-init-server-buffer) (if (nntp-server-opened server) t ! (when (or (stringp (car defs)) ! (numberp (car defs))) ! (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) ! (unless (assq 'nntp-address defs) ! (setq defs (append defs (list (list 'nntp-address server))))) ! (nnoo-change-server 'nntp server defs) ! (unless connectionless ! (or (nntp-find-connection nntp-server-buffer) ! (nntp-open-connection nntp-server-buffer))))) (deffoo nntp-close-server (&optional server) ! (nntp-possibly-change-group nil server t) ! (let (process) ! (while (setq process (car (pop nntp-connection-alist))) ! (when (memq (process-status process) '(open run)) ! (set-process-sentinel process nil) ! (set-process-filter process nil) ! (nntp-send-string process "QUIT")) ! (when (buffer-name (process-buffer process)) ! (kill-buffer (process-buffer process)))) ! (nnoo-close-server 'nntp))) (deffoo nntp-request-list (&optional server) ! (nntp-possibly-change-group nil server) ! (nntp-send-command "\r\n\\.\r\n" "LIST")) (deffoo nntp-request-list-newsgroups (&optional server) ! (nntp-possibly-change-group nil server) ! (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS")) (deffoo nntp-request-newgroups (date &optional server) ! (nntp-possibly-change-group nil server) (let* ((date (timezone-parse-date date)) (time-string (format "%s%02d%02d %s%s%s" *************** *** 594,651 **** (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) (nntp-decode-text)))) - (deffoo nntp-request-list-distributions (&optional server) - "List distributions." - (nntp-possibly-change-server nil server) - (prog1 - (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS") - (nntp-decode-text))) - - (deffoo nntp-request-last (&optional group server) - "Decrease the current article pointer." - (nntp-possibly-change-server group server) - (nntp-send-command "^[23].*\r?\n" "LAST")) - - (deffoo nntp-request-next (&optional group server) - "Advance the current article pointer." - (nntp-possibly-change-server group server) - (nntp-send-command "^[23].*\r?\n" "NEXT")) - - (deffoo nntp-request-post (&optional server) - "Post the current buffer." - (nntp-possibly-change-server nil server) - (when (nntp-send-command "^[23].*\r?\n" "POST") - (nnheader-insert "") - (nntp-encode-text) - (nntp-send-region-to-server (point-min) (point-max)) - ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not - ;; appended to end of the status message. - (nntp-wait-for-response "^[23].*\n"))) ! ;;; Internal functions. (defun nntp-send-mode-reader () "Send the MODE READER command to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will make innd servers spawn an nnrpd process to allow actual article reading." ! (nntp-send-command "^.*\r?\n" "MODE READER")) (defun nntp-send-nosy-authinfo () "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (read-string "NNTP user name: ")) ! (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" (read-string "NNTP password: "))) (defun nntp-send-authinfo () "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) ! (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" (read-string "NNTP password: "))) (defun nntp-send-authinfo-from-file () --- 305,338 ---- (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) (nntp-decode-text)))) ! (deffoo nntp-asynchronous-p () ! t) ! ! ;;; Hooky functions. (defun nntp-send-mode-reader () "Send the MODE READER command to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will make innd servers spawn an nnrpd process to allow actual article reading." ! (nntp-send-command "^.*\r\n" "MODE READER")) (defun nntp-send-nosy-authinfo () "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (nntp-send-command "^.*\r\n" "AUTHINFO USER" (read-string "NNTP user name: ")) ! (nntp-send-command "^.*\r\n" "AUTHINFO PASS" (read-string "NNTP password: "))) (defun nntp-send-authinfo () "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name)) ! (nntp-send-command "^.*\r\n" "AUTHINFO PASS" (read-string "NNTP password: "))) (defun nntp-send-authinfo-from-file () *************** *** 659,927 **** (erase-buffer) (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) ! (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" (buffer-substring (point) (progn (end-of-line) (point)))) (kill-buffer (current-buffer))))) ! (defun nntp-default-sentinel (proc status) ! "Default sentinel function for NNTP server process." ! (let ((servers (cddr (assq 'nntp nnoo-state-alist))) ! server) ! ;; Go through the alist of server names and find the name of the ! ;; server that the process that sent the signal is connected to. ! ;; If you get my drift. ! (if (equal proc nntp-server-process) ! (setq server nntp-address) ! (while (and servers ! (not (equal proc (cdr (assq 'nntp-server-process ! (car servers)))))) ! (setq servers (cdr servers))) ! (setq server (caar servers))) ! (when (and server ! nntp-warn-about-losing-connection) ! (nnheader-message 3 "nntp: Connection closed to server %s" server) ! (setq nntp-current-group "") ! (ding)))) ! ! (defun nntp-kill-connection (server) ! "Choke the connection to SERVER." ! (let ((proc (cdr (assq 'nntp-server-process ! (assoc server (cddr ! (assq 'nntp nnoo-state-alist))))))) ! (when proc ! (delete-process (process-name proc))) ! (nntp-close-server server) ! (nnheader-report ! 'nntp (message "Connection timed out to server %s" server)) ! (ding) ! (sit-for 1))) ! ! ;; Encoding and decoding of NNTP text. ! ! (defun nntp-decode-text () ! "Decode text transmitted by NNTP. ! 0. Delete status line. ! 1. Delete `^M' at end of line. ! 2. Delete `.' at end of buffer (end of text mark). ! 3. Delete `.' at beginning of line." ! (save-excursion ! (set-buffer nntp-server-buffer) ! ;; Insert newline at end of buffer. ! (goto-char (point-max)) ! (or (bolp) (insert "\n")) ! ;; Delete status line. ! (delete-region (goto-char (point-min)) (progn (forward-line 1) (point))) ! ;; Delete `^M's. ! (while (search-forward "\r" nil t) ! (replace-match "" t t)) ! ;; Delete `.' at end of the buffer (end of text mark). ! (goto-char (point-max)) ! (forward-line -1) ! (when (looking-at "^\\.\n") ! (delete-region (point) (progn (forward-line 1) (point)))) ! ;; Replace `..' at beginning of line with `.'. ! (goto-char (point-min)) ! ;; (replace-regexp "^\\.\\." ".") ! (while (search-forward "\n.." nil t) ! (delete-char -1)))) ! (defun nntp-encode-text () ! "Encode text in current buffer for NNTP transmission. ! 1. Insert `.' at beginning of line. ! 2. Insert `.' at end of buffer (end of text mark)." ! (save-excursion ! ;; Replace `.' at beginning of line with `..'. ! (goto-char (point-min)) ! (while (re-search-forward "^\\." nil t) ! (insert ".")) ! (goto-char (point-max)) ! ;; Insert newline at end of buffer. ! (or (bolp) (insert "\n")) ! ;(goto-char (point-min)) ! ;(while (not (eobp)) ! ; (end-of-line) ! ; (insert "\r") ! ; (forward-line 1)) ! ;; Insert `.' at end of buffer (end of text mark). ! (goto-char (point-max)) ! (insert "." nntp-end-of-line))) ! ! ;;; ! ;;; Synchronous Communication with NNTP servers. ! ;;; ! ! (defvar nntp-retry-command) ! ! (defun nntp-send-command (response cmd &rest args) ! "Wait for server RESPONSE after sending CMD and optional ARGS to server." ! (let ((timer ! (and nntp-command-timeout ! (nnheader-run-at-time ! nntp-command-timeout nil 'nntp-kill-command ! (nnoo-current-server 'nntp)))) ! (nntp-retry-command t) ! result) (unwind-protect (save-excursion ! (while nntp-retry-command ! (setq nntp-retry-command nil) ! ;; Clear communication buffer. ! (set-buffer nntp-server-buffer) ! (widen) ! (erase-buffer) ! (if nntp-retry-on-break ! (condition-case () ! (progn ! (apply 'nntp-send-strings-to-server cmd args) ! (setq result ! (if response ! (nntp-wait-for-response response) ! t))) ! (quit (setq nntp-retry-command t))) ! (apply 'nntp-send-strings-to-server cmd args) ! (setq result ! (if response ! (nntp-wait-for-response response) ! t)))) ! result) ! (when timer ! (nnheader-cancel-timer timer))))) ! ! (defun nntp-kill-command (server) ! "Kill and restart the connection to SERVER." ! (let ((proc (cdr (assq ! 'nntp-server-process ! (assoc server (cddr (assq 'nntp nnoo-state-alist))))))) ! (when proc ! (delete-process (process-name proc))) ! (nntp-close-server server) ! (nntp-open-server server) ! (when nntp-current-group ! (nntp-request-group nntp-current-group)) ! (setq nntp-retry-command t))) ! ! (defun nntp-send-command-old (response cmd &rest args) ! "Wait for server RESPONSE after sending CMD and optional ARGS to server." ! (save-excursion ! ;; Clear communication buffer. ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (apply 'nntp-send-strings-to-server cmd args) ! (if response ! (nntp-wait-for-response response) ! t))) ! (defun nntp-wait-for-response (regexp &optional slow) ! "Wait for server response which matches REGEXP." (save-excursion ! (let ((status t) ! (wait t) ! (dotnum 0) ;Number of "." being displayed. ! (dotsize ;How often "." displayed. ! (if (numberp nntp-debug-read) nntp-debug-read 10000))) ! (set-buffer nntp-server-buffer) ! ;; Wait for status response (RFC977). ! ;; 1xx - Informative message. ! ;; 2xx - Command ok. ! ;; 3xx - Command ok so far, send the rest of it. ! ;; 4xx - Command was correct, but couldn't be performed for some ! ;; reason. ! ;; 5xx - Command unimplemented, or incorrect, or a serious ! ;; program error occurred. ! (nntp-accept-response) ! (while wait ! (goto-char (point-min)) ! (if slow (progn ! (cond ((re-search-forward "^[23][0-9][0-9]" nil t) ! (setq wait nil)) ! ((re-search-forward "^[45][0-9][0-9]" nil t) ! (setq status nil) ! (setq wait nil)) ! (t (nntp-accept-response))) ! (if (not wait) (delete-region (point-min) ! (progn (beginning-of-line) ! (point))))) ! (cond ((looking-at "[23]") ! (setq wait nil)) ! ((looking-at "[45]") ! (setq status nil) ! (setq wait nil)) ! (t (nntp-accept-response))))) ! ;; Save status message. ! (end-of-line) ! (setq nntp-status-string ! (nnheader-replace-chars-in-string ! (buffer-substring (point-min) (point)) ?\r ? )) ! (when status ! (setq wait t) ! (while wait (goto-char (point-max)) ! (if (bolp) (forward-line -1) (beginning-of-line)) ! (if (looking-at regexp) ! (setq wait nil) ! (when nntp-debug-read ! (let ((newnum (/ (buffer-size) dotsize)) ! (message-log-max nil)) ! (unless (= dotnum newnum) ! (setq dotnum newnum) ! (nnheader-message 7 "NNTP: Reading %s" ! (make-string dotnum ?.))))) ! (nntp-accept-response))) ! ;; Remove "...". ! (when (and nntp-debug-read (> dotnum 0)) ! (message "")) ! ;; Successfully received server response. ! t)))) ! ! ;;; ! ;;; Low-Level Interface to NNTP Server. ! ;;; ! (defun nntp-find-group-and-number () ! (save-excursion ! (save-restriction ! (set-buffer nntp-server-buffer) ! (narrow-to-region (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point-max))) ! (goto-char (point-min)) ! ;; We first find the number by looking at the status line. ! (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ") ! (string-to-int ! (buffer-substring (match-beginning 1) ! (match-end 1))))) ! group newsgroups xref) ! (and number (zerop number) (setq number nil)) ! ;; Then we find the group name. ! (setq group ! (cond ! ;; If there is only one group in the Newsgroups header, ! ;; then it seems quite likely that this article comes ! ;; from that group, I'd say. ! ((and (setq newsgroups (mail-fetch-field "newsgroups")) ! (not (string-match "," newsgroups))) ! newsgroups) ! ;; If there is more than one group in the Newsgroups ! ;; header, then the Xref header should be filled out. ! ;; We hazard a guess that the group that has this ! ;; article number in the Xref header is the one we are ! ;; looking for. This might very well be wrong if this ! ;; article happens to have the same number in several ! ;; groups, but that's life. ! ((and (setq xref (mail-fetch-field "xref")) ! number ! (string-match (format "\\([^ :]+\\):%d" number) xref)) ! (substring xref (match-beginning 1) (match-end 1))) ! (t ""))) ! (when (string-match "\r" group) ! (setq group (substring group 0 (match-beginning 0)))) ! (cons group number))))) (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (erase-buffer) --- 346,579 ---- (erase-buffer) (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) ! (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command ! "^.*\r\n" "AUTHINFO PASS" (buffer-substring (point) (progn (end-of-line) (point)))) (kill-buffer (current-buffer))))) ! ;;; Internal functions. ! (defun nntp-send-command (wait-for &rest strings) ! "Send STRINGS to server and wait until WAIT-FOR returns." ! (unless nnheader-callback-function ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer))) ! (nntp-retrieve-data ! (mapconcat 'identity strings " ") ! nntp-address nntp-port-number nntp-server-buffer ! wait-for nnheader-callback-function)) ! ! (defun nntp-send-command-and-decode (wait-for &rest strings) ! "Send STRINGS to server and wait until WAIT-FOR returns." ! (unless nnheader-callback-function ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer))) ! (nntp-retrieve-data ! (mapconcat 'identity strings " ") ! nntp-address nntp-port-number nntp-server-buffer ! wait-for nnheader-callback-function t)) ! ! (defun nntp-find-connection (buffer) ! "Find the connection delivering to BUFFER." ! (let ((alist nntp-connection-alist) ! (buffer (if (stringp buffer) (get-buffer buffer) buffer)) ! process entry) ! (while (setq entry (pop alist)) ! (when (eq buffer (cadr entry)) ! (setq process (car entry) ! alist nil))) ! (when process ! (if (memq (process-status process) '(open run)) ! process ! (when (buffer-name (process-buffer process)) ! (kill-buffer (process-buffer process))) ! (setq nntp-connection-alist (delq entry nntp-connection-alist)) ! nil)))) ! ! (defun nntp-find-connection-entry (buffer) ! "Return the entry for the connection to BUFFER." ! (assq (nntp-find-connection buffer) nntp-connection-alist)) ! ! (defun nntp-open-connection (buffer) ! "Open a connection to PORT on ADDRESS delivering output to BUFFER." ! (run-hooks 'nntp-prepare-server-hook) ! (let* ((pbuffer (save-excursion ! (set-buffer ! (generate-new-buffer ! (format " *server %s %s %s*" ! nntp-address nntp-port-number ! (buffer-name (get-buffer buffer))))) ! (buffer-disable-undo (current-buffer)) ! (current-buffer))) ! (process (funcall nntp-open-connection-function pbuffer))) ! (when process ! (process-kill-without-query process) ! (nntp-wait-for process "^.*\r\n" buffer) ! (if (memq (process-status process) '(open run)) ! (prog1 ! (caar (push (list process buffer nil) ! nntp-connection-alist)) ! (nntp-read-server-type) ! (run-hooks 'nntp-server-opened-hook)) ! (when (buffer-name (process-buffer process)) ! (kill-buffer (process-buffer process))) ! nil)))) + (defun nntp-open-network-stream (buffer) + (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) ! (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. ! (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))))))) ! ! (defvar nntp-tmp-first) ! (defvar nntp-tmp-wait-for) ! (defvar nntp-tmp-callback) ! (defvar nntp-tmp-buffer) ! ! (defun nntp-make-process-filter (wait-for callback buffer decode) ! `(lambda (proc string) ! (let ((nntp-tmp-wait-for ,wait-for) ! (nntp-tmp-callback ,callback) ! (nntp-tmp-buffer ,buffer)) ! (nntp-process-filter proc string)))) ! ! (defun nntp-process-filter (proc string) ! (let ((old-buffer (current-buffer))) (unwind-protect + (let (point) + (set-buffer (process-buffer proc)) + ;; Insert the text, moving the process-marker. + (setq point (goto-char (process-mark proc))) + (insert string) + (set-marker (process-mark proc) (point)) + (if (and (= point (point-min)) + (string-match "^45" string)) + (progn + (nntp-snarf-error-message) + (set-process-filter proc nil) + (funcall nntp-tmp-callback nil)) + (setq nntp-tmp-first nil) + (if (re-search-backward nntp-tmp-wait-for nil t) + (progn + (if (buffer-name (get-buffer nntp-tmp-buffer)) + (save-excursion + (set-buffer (get-buffer nntp-tmp-buffer)) + (insert-buffer-substring (process-buffer proc)))) + (set-process-filter proc nil) + (erase-buffer) + (funcall nntp-tmp-callback t))))) + (set-buffer old-buffer)))) + + (defun nntp-retrieve-data (command address port buffer + &optional wait-for callback decode) + "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." + (let ((process (or (nntp-find-connection buffer) + (nntp-open-connection buffer)))) + (if (not process) + (nnheader-report 'nntp "Couldn't open connection to %a" address) + (unless nntp-inhibit-erase (save-excursion ! (set-buffer (process-buffer process)) ! (erase-buffer))) ! (nntp-send-string process command) ! (cond ! ((eq callback 'ignore) ! t) ! ((and callback wait-for) ! (set-process-filter ! process (nntp-make-process-filter wait-for callback buffer decode)) ! t) ! (wait-for ! (set-process-filter process nil) ! (nntp-wait-for process wait-for buffer decode)) ! (t t))))) ! ! (defun nntp-send-string (process string) ! "Send STRING to PROCESS." ! (process-send-string process (concat string nntp-end-of-line))) ! (defun nntp-wait-for (process wait-for buffer &optional decode) ! "Wait for WAIT-FOR to arrive from PROCESS." (save-excursion ! (set-buffer (process-buffer process)) ! (goto-char (point-min)) ! (while (not (looking-at "[2345]")) ! (nntp-accept-process-output process) ! (goto-char (point-min))) ! (prog1 ! (if (looking-at "[345]") (progn ! (nntp-snarf-error-message) ! nil) (goto-char (point-max)) ! (while (not (re-search-backward wait-for nil t)) ! (nntp-accept-process-output process) ! (goto-char (point-max))) ! (nntp-decode-text (not decode)) ! (save-excursion ! (set-buffer buffer) ! (insert-buffer-substring (process-buffer process)) ! t)) ! (erase-buffer)))) ! ! (defun nntp-snarf-error-message () ! "Save the error message in the current buffer." ! (setq nntp-status-string (buffer-string))) ! (defun nntp-accept-process-output (process) ! "Wait for output from PROCESS and message some dots." ! (save-excursion ! (set-buffer nntp-server-buffer) ! (message "nntp reading%s" (make-string (/ (point-max) 100) ?.)) ! (accept-process-output process 1))) ! (defun nntp-accept-response () ! "Wait for output from the process that outputs to BUFFER." ! (nntp-accept-process-output (nntp-find-connection nntp-server-buffer))) ! (defun nntp-possibly-change-group (group server &optional connectionless) ! (when server ! (or (nntp-server-opened server) ! (nntp-open-server server nil connectionless))) ! ! (unless connectionless ! (or (nntp-find-connection nntp-server-buffer) ! (nntp-open-connection nntp-server-buffer))) ! ! (when group ! (let ((entry (nntp-find-connection-entry nntp-server-buffer))) ! (when (not (equal group (caddr entry))) ! (nntp-request-group group))))) ! ! (defun nntp-decode-text (&optional cr-only) ! "Decode the text in the current buffer." ! (goto-char (point-min)) ! (while (search-forward "\r" nil t) ! (delete-char -1)) ! (unless cr-only ! (goto-char (point-max)) ! (forward-line -1) ! (when (looking-at ".\n") ! (delete-char 2)) ! (goto-char (point-min)) ! (delete-region (point) (progn (forward-line 1) (point))) ! (while (search-forward "\n.." nil t) ! (delete-char -1)))) (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (erase-buffer) *************** *** 940,946 **** (max 1 (- (car articles) fetch-old)) 1) (car articles)) ! (nntp-last-element articles) 'wait) (goto-char (point-min)) (when (looking-at "[1-5][0-9][0-9] ") --- 592,598 ---- (max 1 (- (car articles) fetch-old)) 1) (car articles)) ! (last articles) 'wait) (goto-char (point-min)) (when (looking-at "[1-5][0-9][0-9] ") *************** *** 961,967 **** (let ((count 0) (received 0) (last-point (point-min)) ! (buf (current-buffer)) first) ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we --- 613,620 ---- (let ((count 0) (received 0) (last-point (point-min)) ! (buf nntp-server-buffer) ! ;;(process-buffer (nntp-find-connection (current-buffer)))) first) ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we *************** *** 982,988 **** ;; order to avoid deadlocks. (when (or (null articles) ;All requests have been sent. (zerop (% count nntp-maximum-request))) ! (accept-process-output nntp-server-process 1) ;; On some Emacs versions the preceding function has ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reproduce, because it only --- 635,641 ---- ;; order to avoid deadlocks. (when (or (null articles) ;All requests have been sent. (zerop (% count nntp-maximum-request))) ! (accept-process-output) ;; On some Emacs versions the preceding function has ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reproduce, because it only *************** *** 995,1001 **** (setq received (1+ received))) (setq last-point (point)) (< received count)) ! (accept-process-output nntp-server-process) (set-buffer buf))))) (when nntp-server-xover --- 648,654 ---- (setq received (1+ received))) (setq last-point (point)) (< received count)) ! (accept-process-output) (set-buffer buf))))) (when nntp-server-xover *************** *** 1014,1038 **** (while (search-forward "\r" nil t) (delete-char -1)) (goto-char (point-min)) ! (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] "))))) nntp-server-xover) (defun nntp-send-xover-command (beg end &optional wait-for-reply) "Send the XOVER command to the server." ! (let ((range (format "%d-%d" (or beg 1) (or end beg 1)))) (if (stringp nntp-server-xover) ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply ! (nntp-send-command "^\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. ! (nntp-send-strings-to-server nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ;; We try them all until we get at positive response. (while (and commands (eq nntp-server-xover 'try)) ! (nntp-send-command "^\\.\r?\n" (car commands) range) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) --- 667,697 ---- (while (search-forward "\r" nil t) (delete-char -1)) (goto-char (point-min)) ! (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ") ! ;(save-excursion ! ; (set-buffer nntp-server-buffer) ! ; (insert-buffer-substring buf)) ! ;(erase-buffer) ! )))) nntp-server-xover) (defun nntp-send-xover-command (beg end &optional wait-for-reply) "Send the XOVER command to the server." ! (let ((range (format "%d-%d" beg end)) ! (nntp-inhibit-erase t)) (if (stringp nntp-server-xover) ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply ! (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range) ;; We do not wait for the reply. ! (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ;; We try them all until we get at positive response. (while (and commands (eq nntp-server-xover 'try)) ! (nntp-send-command "\r\n\\.\r\n" (car commands) range) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) *************** *** 1053,1218 **** (setq nntp-server-xover nil))) nntp-server-xover)))) ! (defun nntp-send-strings-to-server (&rest strings) ! "Send STRINGS to the server." ! (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line))) ! ;; We open the nntp server if it is down. ! (or (nntp-server-opened (nnoo-current-server 'nntp)) ! (nntp-open-server (nnoo-current-server 'nntp)) ! (error "Couldn't open server: " (nntp-status-message))) ! ;; Send the strings. ! (process-send-string nntp-server-process cmd) ! t)) ! ! (defun nntp-send-region-to-server (begin end) ! "Send the current buffer region (from BEGIN to END) to the server." ! (save-excursion ! (let ((cur (current-buffer))) ! ;; Copy the buffer over to the send buffer. ! (nnheader-set-temp-buffer " *nntp send*") ! (insert-buffer-substring cur begin end) ! (save-excursion ! (set-buffer cur) ! (erase-buffer)) ! ;; `process-send-region' does not work if the text to be sent is very ! ;; large, so we send it piecemeal. ! (let ((last (point-min)) ! (size 100)) ;Size of text sent at once. ! (while (and (/= last (point-max)) ! (memq (process-status nntp-server-process) '(open run))) ! (process-send-region ! nntp-server-process ! last (setq last (min (+ last size) (point-max)))) ! ;; Read any output from the server. May be unnecessary. ! (accept-process-output))) ! (kill-buffer (current-buffer))))) ! ! (defun nntp-open-server-semi-internal (server &optional service) ! "Open SERVER. ! If SERVER is nil, use value of environment variable `NNTPSERVER'. ! If SERVICE, use this as the port number." ! (nnheader-insert "") ! (let ((server (or server (getenv "NNTPSERVER"))) ! (status nil) ! (timer ! (and nntp-connection-timeout ! (nnheader-run-at-time nntp-connection-timeout ! nil 'nntp-kill-connection server)))) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (setq nntp-status-string "") ! (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address) ! (cond ((and server (nntp-open-server-internal server service)) ! (setq nntp-address server) ! (setq status ! (condition-case nil ! (nntp-wait-for-response "^[23].*\r?\n" 'slow) ! (error nil) ! ;(quit nil) ! )) ! (unless status ! (nntp-close-server-internal server) ! (nnheader-report ! 'nntp "Couldn't open connection to %s" ! (if (and nntp-address ! (not (equal nntp-address ""))) ! nntp-address server))) ! (when nntp-server-process ! (set-process-sentinel ! nntp-server-process 'nntp-default-sentinel) ! ;; You can send commands at startup like AUTHINFO here. ! ;; Added by Hallvard B Furuseth ! (run-hooks 'nntp-server-opened-hook))) ! ((null server) ! (nnheader-report 'nntp "NNTP server is not specified.")) ! (t ; We couldn't open the server. ! (nnheader-report 'nntp (buffer-string)))) ! (when timer ! (nnheader-cancel-timer timer)) ! (message "") ! (unless status ! (nnoo-close-server 'nntp server) ! (setq nntp-async-number nil)) ! status))) ! ! (defvar nntp-default-directories '("~" "/tmp" "/") ! "Directories to as current directory in the nntp server buffer.") ! ! (defun nntp-open-server-internal (server &optional service) ! "Open connection to news server on SERVER by SERVICE (default is nntp)." ! (let (proc) ! (save-excursion ! (set-buffer nntp-server-buffer) ! ;; Make sure we have a valid current directory for the ! ;; nntp server buffer. ! (unless (file-exists-p default-directory) ! (let ((dirs nntp-default-directories)) ! (while dirs ! (when (file-exists-p (car dirs)) ! (setq default-directory (car dirs) ! dirs nil)) ! (setq dirs (cdr dirs))))) ! (cond ! ((and (setq proc ! (condition-case nil ! (funcall nntp-open-server-function server) ! (error nil))) ! (memq (process-status proc) '(open run))) ! (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) ! (condition-case () ! (nntp-read-server-type) ! (error ! (nnheader-report 'nntp "Couldn't open server %s" server) ! (nntp-close-server))) ! nntp-server-process) ! (t ! (nnheader-report 'nntp "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" t) ! (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 ! "nntpd" nntp-server-buffer server nntp-port-number)) ! ! (defun nntp-open-rlogin (server) ! "Open a connection to SERVER using rsh." ! (let ((proc (if nntp-rlogin-user-name ! (start-process ! "nntpd" nntp-server-buffer "rsh" ! server "-l" nntp-rlogin-user-name ! (mapconcat 'identity ! nntp-rlogin-parameters " ")) ! (start-process ! "nntpd" nntp-server-buffer "rsh" server ! (mapconcat 'identity ! nntp-rlogin-parameters " "))))) ! proc)) (defun nntp-wait-for-string (regexp) "Wait until string arrives in the buffer." (let ((buf (current-buffer))) (goto-char (point-min)) (while (not (re-search-forward regexp nil t)) ! (accept-process-output nntp-server-process) (set-buffer buf) (goto-char (point-min))))) --- 712,725 ---- (setq nntp-server-xover nil))) nntp-server-xover)))) ! ;;; Alternative connection methods. (defun nntp-wait-for-string (regexp) "Wait until string arrives in the buffer." (let ((buf (current-buffer))) (goto-char (point-min)) (while (not (re-search-forward regexp nil t)) ! (accept-process-output (nntp-find-connection nntp-server-buffer)) (set-buffer buf) (goto-char (point-min))))) *************** *** 1256,1388 **** (delete-region (point) (point-max))) proc))) ! (defun nntp-close-server-internal (&optional server) ! "Close connection to news server." ! (nntp-possibly-change-server nil server) ! (if nntp-server-process ! (delete-process nntp-server-process)) ! (setq nntp-server-process nil) ! ;(setq nntp-address "") ! ) ! ! (defun nntp-accept-response () ! "Read response of server. ! It is well-known that the communication speed will be much improved by ! defining this function as macro." ! ;; To deal with server process exiting before ! ;; accept-process-output is called. ! ;; Suggested by Jason Venner . ! ;; This is a copy of `nntp-default-sentinel'. ! (let ((buf (current-buffer))) ! (prog1 ! (if (or (not nntp-server-process) ! (not (memq (process-status nntp-server-process) '(open run)))) ! (error "nntp: Process connection closed; %s" (nntp-status-message)) ! (if nntp-buggy-select ! (progn ! ;; We cannot use `accept-process-output'. ! ;; Fujitsu UTS requires messages during sleep-for. ! ;; I don't know why. ! (nnheader-message 5 "NNTP: Reading...") ! (sleep-for 1) ! (nnheader-message 5 "")) ! (condition-case errorcode ! (accept-process-output nntp-server-process 1) ! (error ! (cond ((string-equal "select error: Invalid argument" ! (nth 1 errorcode)) ! ;; Ignore select error. ! nil) ! (t ! (signal (car errorcode) (cdr errorcode)))))))) ! (set-buffer buf)))) ! ! (defun nntp-last-element (list) ! "Return last element of LIST." ! (while (cdr list) ! (setq list (cdr list))) ! (car list)) ! ! (defun nntp-possibly-change-server (newsgroup server &optional connectionless) ! "Check whether the virtual server needs changing." ! (when (and server ! (not (nntp-server-opened server))) ! ;; This virtual server isn't open, so we (re)open it here. ! (nntp-open-server server nil t)) ! (when (and newsgroup ! (not (equal newsgroup nntp-current-group))) ! ;; Set the proper current group. ! (nntp-request-group newsgroup server))) ! ! (defun nntp-try-list-active (group) ! (nntp-list-active-group group) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (cond ((looking-at "5[0-9]+") ! (setq nntp-server-list-active-group nil)) ! (t ! (setq nntp-server-list-active-group t))))) ! ! (defun nntp-async-server-opened () ! (and nntp-async-process ! (memq (process-status nntp-async-process) '(open run)))) ! (defun nntp-async-open-server () ! (save-excursion ! (set-buffer (generate-new-buffer " *async-nntp*")) ! (setq nntp-async-buffer (current-buffer)) ! (buffer-disable-undo (current-buffer))) ! (let ((nntp-server-process nil) ! (nntp-server-buffer nntp-async-buffer)) ! (nntp-open-server-semi-internal nntp-address nntp-port-number) ! (if (not (setq nntp-async-process nntp-server-process)) ! (progn ! (setq nntp-async-number nil)) ! (set-process-buffer nntp-async-process nntp-async-buffer)))) ! ! (defun nntp-async-fetch-articles (article) ! (if (stringp article) ! () ! (let ((articles (cdr (memq (assq article nntp-async-articles) ! nntp-async-articles))) ! (max (cond ((numberp nntp-async-number) ! nntp-async-number) ! ((eq nntp-async-number t) ! (length nntp-async-articles)) ! (t 0))) ! nart) ! (while (and (>= (setq max (1- max)) 0) ! articles) ! (or (memq (setq nart (caar articles)) nntp-async-fetched) ! (progn ! (nntp-async-send-strings "ARTICLE " (int-to-string nart)) ! (setq nntp-async-fetched (cons nart nntp-async-fetched)))) ! (setq articles (cdr articles)))))) ! ! (defun nntp-async-send-strings (&rest strings) ! (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line))) ! (or (nntp-async-server-opened) ! (nntp-async-open-server) ! (error (nntp-status-message))) ! (process-send-string nntp-async-process cmd))) ! ! (defun nntp-async-request-group (group) ! (if (equal group nntp-current-group) ! () ! (let ((asyncs (assoc group nntp-async-group-alist))) ! ;; A new group has been selected, so we push the current state ! ;; of async articles on an alist, and pull the old state off. ! (setq nntp-async-group-alist ! (cons (list nntp-current-group ! nntp-async-articles nntp-async-fetched ! nntp-async-process) ! (delq asyncs nntp-async-group-alist))) ! (and asyncs ! (progn ! (setq nntp-async-articles (nth 1 asyncs)) ! (setq nntp-async-fetched (nth 2 asyncs)) ! (setq nntp-async-process (nth 3 asyncs))))))) (provide 'nntp) --- 763,787 ---- (delete-region (point) (point-max))) proc))) ! (defun nntp-open-rlogin (server) ! "Open a connection to SERVER using rsh." ! (let ((proc (if nntp-rlogin-user-name ! (start-process ! "nntpd" nntp-server-buffer "rsh" ! server "-l" nntp-rlogin-user-name ! (mapconcat 'identity ! nntp-rlogin-parameters " ")) ! (start-process ! "nntpd" nntp-server-buffer "rsh" server ! (mapconcat 'identity ! nntp-rlogin-parameters " "))))) ! proc)) ! (defun nntp-find-connection-buffer (buffer) ! "Return the process connection buffer tied to BUFFER." ! (let ((process (nntp-find-connection buffer))) ! (when process ! (process-buffer process)))) (provide 'nntp) *** pub/rgnus/lisp/parse-time.el Tue Jul 30 22:59:31 1996 --- rgnus/lisp/parse-time.el Fri May 10 02:42:14 1996 *************** *** 0 **** --- 1,195 ---- + ;;; parse-time.el --- Parsing time strings + + ;; Copyright (C) 1996 by Free Software Foundation, Inc. + + ;; Author: Erik Naggum + ;; Keywords: util + + ;; 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, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; With the introduction of the `encode-time', `decode-time', and + ;; `format-time-string' functions, dealing with time became simpler in + ;; Emacs. However, parsing time strings is still largely a matter of + ;; heuristics and no common interface has been designed. + + ;; `parse-time-string' parses a time in a string and returns a list of 9 + ;; values, just like `decode-time', where unspecified elements in the + ;; string are returned as nil. `encode-time' may be applied on these + ;; valuse to obtain an internal time value. + + ;;; Code: + + (require 'cl) ;and ah ain't kiddin' 'bout it + + (put 'parse-time-syntax 'char-table-extra-slots 0) + + (defvar parse-time-syntax (make-char-table 'parse-time-syntax)) + (defvar parse-time-digits (make-char-table 'parse-time-syntax)) + + (unless (aref parse-time-digits ?0) + (loop for i from ?0 to ?9 + do (set-char-table-range parse-time-digits i (- i ?0)))) + + (unless (aref parse-time-syntax ?0) + (loop for i from ?0 to ?9 + do (set-char-table-range parse-time-syntax i ?0)) + (loop for i from ?A to ?Z + do (set-char-table-range parse-time-syntax i ?A)) + (loop for i from ?a to ?z + do (set-char-table-range parse-time-syntax i ?a)) + (set-char-table-range parse-time-syntax ?+ 1) + (set-char-table-range parse-time-syntax ?- -1) + (set-char-table-range parse-time-syntax ?: ?d) + ) + + (defsubst digit-char-p (char) + (aref parse-time-digits char)) + + (defsubst parse-time-string-chars (char) + (aref parse-time-syntax char)) + + (put 'parse-error 'error-conditions '(parse-error error)) + (put 'parse-error 'error-message "Parsing error") + + (defsubst parse-integer (string &optional start end) + "[CL] Parse and return the integer in STRING, or nil if none." + (let ((integer 0) + (digit 0) + (index (or start 0)) + (end (or end (length string)))) + (when (< index end) + (let ((sign (aref string index))) + (if (or (eq sign ?+) (eq sign ?-)) + (setq sign (parse-time-string-chars sign) + index (1+ index)) + (setq sign 1)) + (while (and (< index end) + (setq digit (digit-char-p (aref string index)))) + (setq integer (+ (* integer 10) digit) + index (1+ index))) + (if (/= index end) + (signal 'parse-error `("not an integer" ,(substring string (or start 0) end))) + (* sign integer)))))) + + (defun parse-time-tokenize (string) + "Tokenize STRING into substrings." + (let ((start nil) + (end (length string)) + (all-digits nil) + (list ()) + (index 0) + (c nil)) + (while (< index end) + (while (and (< index end) ;skip invalid characters + (not (setq c (parse-time-string-chars (aref string index))))) + (incf index)) + (setq start index all-digits (eq c ?0)) + (while (and (< (incf index) end) ;scan valid characters + (setq c (parse-time-string-chars (aref string index)))) + (setq all-digits (and all-digits (eq c ?0)))) + (if (<= index end) + (push (if all-digits (parse-integer string start index) + (substring string start index)) + list))) + (nreverse list))) + + (defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) + ("Apr" . 4) ("May" . 5) ("Jun" . 6) + ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) + ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) + (defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) + ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) + (defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0) + ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t) + ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t) + ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t) + ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t)) + "(zoneinfo seconds-off daylight-savings-time-p)") + + (defvar parse-time-rules + `(((6) parse-time-weekdays) + ((3) (1 31)) + ((4) parse-time-months) + ((5) (1970 2038)) + ((2 1 0) + ,#'(lambda () (and (stringp elt) + (= (length elt) 8) + (= (aref elt 2) ?:) + (= (aref elt 5) ?:))) + [0 2] [3 5] [6 8]) + ((8 7) parse-time-zoneinfo + ,#'(lambda () (car val)) + ,#'(lambda () (cadr val))) + ((8) + ,#'(lambda () + (and (stringp elt) + (= 5 (length elt)) + (or (= (aref elt 0) ?+) (= (aref elt 0) ?-)))) + ,#'(lambda () (* 60 (+ (parse-integer elt 3 5) + (* 60 (parse-integer elt 1 3))) + (if (= (aref elt 0) ?-) -1 1)))) + ((5 4 3) + ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-))) + [0 4] [5 7] [8 10]) + ((2 1) + ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:))) + [0 2] [3 5]) + ((5) (70 99) ,#'(lambda () (+ 1900 elt)))) + "(slots predicate extractor...)") + + (defun parse-time-string (string) + "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). + The values are identical to those of `decode-time', but any values that are + unknown are returned as nil." + (let ((time (list nil nil nil nil nil nil nil nil nil nil)) + (temp (parse-time-tokenize string))) + (while temp + (let ((elt (pop temp)) + (rules parse-time-rules) + (exit nil)) + (while (and (not (null rules)) (not exit)) + (let* ((rule (pop rules)) + (slots (pop rule)) + (predicate (pop rule)) + (val)) + (if (and (not (nth (car slots) time)) ;not already set + (setq val (cond ((and (consp predicate) + (not (eq (car predicate) 'lambda))) + (and (numberp elt) + (<= (car predicate) elt) + (<= elt (cadr predicate)) + elt)) + ((symbolp predicate) + (cdr (assoc elt (symbol-value predicate)))) + ((funcall predicate))))) + (progn + (setq exit t) + (while slots + (let ((new-val (and rule + (let ((this (pop rule))) + (if (vectorp this) + (parse-integer elt (aref this 0) (aref this 1)) + (funcall this)))))) + (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))) + time)) + + (provide 'parse-time) + + ;;; parse-time.el ends here *** pub/rgnus/lisp/ChangeLog Tue Jul 30 19:54:59 1996 --- rgnus/lisp/ChangeLog Tue Jul 30 22:36:57 1996 *************** *** 1,5 **** --- 1,14 ---- + Tue Jul 30 22:34:11 1996 Lars Magne Ingebrigtsen + + * nntp.el (nntp-find-connection-buffer): New function. + (nntp-retrieve-headers): Use it. + Tue Jul 30 00:00:28 1996 Lars Magne Ingebrigtsen + * nndoc.el (nndoc-add-type): New function. + (nndoc-guess-type): New function. + (nndoc-set-delims): New definition. + * nntp.el (nntp-open-server): Init server buffer. * gnus.el (gnus-group-prefixed-name): Do the right thing with nil *************** *** 7,1853 **** (gnus-group-rename-group): Would act oddly when renaming native groups. ! Sat Jul 27 17:46:42 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-check-news-syntax): Use signature ! separator. ! ! * gnus.el (gnus-group-make-group): Beep at "" methods. ! (gnus-group-make-group): Don't prefix native groups. ! ! * nnmail.el (nnmail-move-inbox): Bug out on movemail errors. ! ! * gnus-cache.el (gnus-cache-file-name): Would bug out on group ! names containing slashes. ! ! * gnus-topic.el (gnus-topic-check-topology): Make sure all groups ! in topics are living. ! ! * nntp.el (nntp-send-strings-to-server): Give a better error ! message. ! ! Sat Jul 27 17:33:22 1996 Teddy ! ! * nntp.el (nntp-open-rlogin): Change parameter order. ! ! Sat Jul 27 17:19:47 1996 Lars Magne Ingebrigtsen ! ! * gnus-topic.el (gnus-topic-check-topology): Make sure all ! topologies have alists. ! ! Wed Jul 24 08:23:26 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-group-jump-to-group): Don't activate group. ! ! Wed Jul 24 07:47:47 1996 Katsumi Yamaoka ! ! * message.el (message-rename-buffer): Rename autosave name. ! ! Wed Jul 24 06:24:07 1996 Lars Magne Ingebrigtsen ! ! * gnus-vis.el (gnus-group-make-menu-bar): Moved Misc menu last. ! (gnus-summary-make-menu-bar): Ditto. ! ! Sat Jul 20 00:59:22 1996 Lars Magne Ingebrigtsen ! ! * smiley.el (smiley-buffer): Only do smilies under X. ! ! * gnus.el (gnus-make-directory): Beep on nil dirs. ! (gnus-article-archive-name): Prepend the save directory. ! ! Fri Jul 19 23:08:52 1996 Hallvard B. Furuseth ! ! * message.el (message-y-or-n-p): Doc fix. ! ! Fri Jul 19 02:12:58 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.37 is released. ! ! Fri Jul 19 00:31:22 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-subscribe-newsgroup): Add new groups to top-level ! topic. ! (gnus-group-make-archive-group): Add a to-address group param. ! ! * gnus-topic.el (gnus-topic-hide-topic): Doc fix. ! (gnus-topic-select-group): Doc fix. ! (gnus-topic-rename): Keep point nearby. ! ! * gnus.el (gnus-group-goto-group): More efficient (and more ! correct) implementation. ! (gnus-group-sort-function): Doc fix. ! (gnus-group-edit-buffer): Changed to defvar. ! (gnus-group-edit-group-done): Use new name. ! (gnus-group-edit-group): Include name of group in grup buffer ! name. ! ! * nnfolder.el (nnfolder-save-mail): Handle babylish ">From" ! lines. ! * nnmbox.el (nnmbox-request-accept-article): Ditto. ! ! Thu Jul 18 23:50:31 1996 Lars Magne Ingebrigtsen ! ! * nnmail.el (nnmail-move-inbox): Don't substitute in command ! name. ! ! * gnus-xmas.el (gnus-xmas-modeline-glyph): New variable. ! ! Thu Jul 18 16:35:22 1996 Lars Magne Ingebrigtsen ! ! * custom.el (custom-facep): Didn't work under non-X Emacs. ! ! Thu Jul 18 00:02:32 1996 Lars Magne Ingebrigtsen ! ! * nntp.el (nntp-open-telnet): Use more permissive regexps. ! ! * gnus-uu.el (gnus-uu-uustrip-article): `cd' to make gnus-uu work ! under NT. ! ! Mon Jul 15 18:11:13 1996 Jan Vroonhof ! ! * smiley.el (smiley-regexp-alist): Don't match important parts of URLs ! (smiley-nosey-regexp-alist): New variable. ! ! Wed Jul 17 23:48:50 1996 Mark Borges ! ! * messagexmas.el (nnheader): Required. ! ! Wed Jul 17 02:02:25 1996 Michael Cook ! ! * nnmail.el (nnmail-split-abbrev-alist): New default. ! ! Wed Jul 17 00:27:13 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-mode-abbrev-table): New variable. ! (message-mode): New variable. ! ! Wed Jul 17 00:05:00 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.36 is released. ! ! Tue Jul 16 20:05:49 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-send-mail): Bugged out under Emacs. ! (message-send-news): Ditto. ! ! * nntp.el (nntp-retrieve-headers-with-xover): Would hang ! sometimes. ! ! Sun Jul 14 20:01:26 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.35 is released. ! ! Sun Jul 14 18:21:14 1996 Lars Magne Ingebrigtsen ! ! * gnus-uu.el (gnus-uu-mark-over): Would bug out. ! ! * smiley.el (smiley-regexp-alist): New definition didn't work. ! ! Sun Jul 14 16:52:31 1996 Lars Magne Ingebrigtsen ! ! * gnus.el ((provide 'gnus)): Make sure `gnus-directory' is set ! when compiling. ! ! Sun Jul 14 15:38:21 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: autoload `gnus-copy-article-buffer'. ! ! * message.el (message-do-send-housekeeping): Kill a superfluous ! buffers. ! ! * gnus-picon.el (gnus-article-display-picons): Don't bug out on ! nil addresses. ! ! * custom.el ((fboundp 'plist-get)): Removed. ! ((fboundp 'add-to-list)): Removed. ! ! Sun Jul 14 15:30:27 1996 Martin Buchholz ! ! * gnus.el: Many typo fixes. ! ! Thu Jul 11 18:06:24 1996 Lars Magne Ingebrigtsen ! ! * nntp.el (nntp-retrieve-headers-with-xover): ! `accept-process-output' from `nntp-server-process'. ! ! Tue Jul 9 07:51:31 1996 Lars Magne Ingebrigtsen ! ! * gnus-vis.el (gnus-group-make-menu-bar): Un-randomize. ! ! Mon Jul 8 09:53:39 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-decode-rfc1522): Goto point-min before decoding. ! ! Mon Jul 8 08:53:50 1996 Nat Makarevitch ! ! * smiley.el (smiley-regexp-alist): New definition. ! ! Sun Jul 7 13:33:44 1996 Sudish Joseph ! ! * nnmail.el (nnmail-split-fancy-syntax-table): `%' should have ! punctuation syntax to support the %-hack in addresses. ! ! Sat Jul 6 08:11:41 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.34 is released. ! ! Sat Jul 6 05:46:12 1996 Lars Magne Ingebrigtsen ! ! * nnheader.el (nnheader-re-read-dir): Would sometimes bug out. ! ! Fri Jul 5 03:14:43 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-toggle-threads): Message the state. ! ! Thu Jul 4 07:52:07 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.33 is released. ! ! Thu Jul 4 06:08:11 1996 Lars Magne Ingebrigtsen ! ! * nntp.el (nntp-open-telnet): Working function. ! (nntp-telnet-parameters, (nntp-telnet-user-name, ! nntp-telnet-passwd): New variables. ! ! * gnus.el (gnus-summary-prepare-threads): Would infloop. ! (gnus-summary-isearch-article): Don't go to the start of the ! article. ! ! Thu Jul 4 05:44:22 1996 Steven L. Baur ! ! * gnus.el (gnus-article-hide-pem): New command and keystroke. ! ! Thu Jul 4 05:00:58 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-local-variables): Init reffed to 0. ! (gnus-set-global-variables): Set reffed. ! ! Wed Jul 3 06:15:28 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-reffed-article-number): Make buffer-local. ! ! Wed Jul 3 03:17:42 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-article-setup-buffer): Make the original buffer go ! away on exit. ! ! * message.el (message-reply): Insert proper number of commas. ! (message-tokenize-header): Tokenize properly. ! ! Wed Jul 3 03:01:59 1996 Joe Wells ! ! * gnus.el (gnus-check-new-newsgroups): Doc fix. ! ! Wed Jul 3 02:58:09 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.33 is released. ! ! Wed Jul 3 00:27:35 1996 Jan Vroonhof ! ! * nnheader.el (nnheader-re-read-dir): Prefer efs over ange-ftp. ! ! Sun Jun 30 23:19:38 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.32 is released. ! ! Sun Jun 30 21:57:31 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-check-bogus-groups-hook): New hook. ! ! Sun Jun 30 21:54:46 1996 Joe Wells ! ! * gnus-topic.el (gnus-topic-clean-alist): New function. ! ! Sun Jun 30 20:00:18 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-group-next-unread-group): Allow silence. ! ! * gnus-cache.el (gnus-cache-possibly-alter-active): Would check ! the obarray. ! ! * gnus.el (gnus-summary-read-group): Don't signal an error when ! including expunged articles. ! ! * gnus-vis.el (gnus-header-button-alist): Would include ":". ! ! * message.el (message-reply): Inhibit point-motion hooks. ! ! * gnus.el (gnus-compile): Mark the .newsrc.eld file as dirty. ! ! * gnus-scomo.el: Renamed to "score-mode". ! ! Sat Jun 29 01:03:19 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.30 is released. ! ! Sat Jun 29 00:23:44 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-article-read-summary-keys): Deal with message ! composition more gracefully. ! ! Fri Jun 28 23:58:37 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-group-describe-group): Re-read when given a ! prefix. ! ! Fri Jun 28 23:34:17 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-group-kill-level): Put groups on killed list. ! ! * nnfolder.el (nnfolder-read-folder): Would bug out when group not ! in active file. ! ! Fri Jun 28 22:42:49 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el (gnus-summary-score-entry): Get rid of text ! props. ! ! * gnus.el (gnus-article-read-summary-keys): Allow `A RET' to work ! properly. ! (gnus-summary-limit): Inhibit marking low-scored articles as ! read. ! ! * gnus-msg.el (gnus-article-mail): Reply from the right address. ! (gnus-article-mail): Yank properly. ! ! * gnus.el (gnus-article-mode-map): Entry for info find node. ! (gnus-summary-describe-briefly): Display proper message. ! ! * smiley.el (smiley-circle-color): Doc fix. ! ! * gnus.el (gnus-summary-prepare-threads): Would display expunged ! articles after a dummy line. ! (gnus-group-faq-directory): Doc fix. ! (gnus-summary-mode): Clear moved inboxes. ! ! Fri Jun 28 21:48:27 1996 Steven L. Baur ! ! * earcon.el: New file. ! ! * gnus-sound.el: New file. ! ! Fri Jun 28 04:02:25 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.29 is released. ! ! Thu Jun 27 23:14:54 1996 Lars Magne Ingebrigtsen ! ! * browse-url.el: Removed from distribution. ! ! * nnmh.el (nnmh-request-group): Re-read dir. ! ! Thu Jun 27 23:13:17 1996 Andy Norman ! ! * nnheader.el (nnheader-re-read-dir): New function. ! ! Thu Jun 27 21:50:16 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-next-article): Would stall on canceled ! articles. ! (gnus-dribble-enter): Would bury the wrong buffer. ! ! * gnus-score.el (gnus-score-followup-thread, ! gnus-score-followup-article): Would switch to wrong buffer. ! ! * gnus.el (gnus-adjust-marked-articles): Possible fix for killed ! articles. ! (gnus-subscribe-hierarchically): Kill .newsrc buffer. ! ! * gnus-nocem.el (gnus-nocem-check-article): Would not search ! properly. ! ! Thu Jun 27 21:50:16 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.28 is released. ! ! Thu Jun 27 23:33:18 1996 Lars Magne Ingebrigtsen ! ! * nnmail.el (nnmail-get-spool-files): Wouldn't get much mail. ! ! Thu Jun 27 19:26:42 1996 Lars Magne Ingebrigtsen ! ! * nnheader.el (nnheader-find-etc-directory): New function. ! ! * gnus.el (gnus-dribble-enter): Bury the buffer. ! (gnus-buffer-configuration): Redundant entry. ! (message): Don't require. ! (gnus-archive-server-wanted-p): Be even more strict in when touse ! the archive server. ! ! Thu Jun 27 19:16:56 1996 Katsumi Yamaoka ! ! * nnheader.el (nnheader-file-size): New function. ! ! Wed Jun 26 22:14:45 1996 Alastair Burt ! ! * gnus.el (gnus-group-kill-level): Applied `car' to an integer. ! ! Wed Jun 26 21:53:34 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.27 is released. ! ! Wed Jun 26 20:40:39 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-edit-article-done): Don't beep after a ! `C-u e'. ! ! * message.el (message-autosave-directory): New default value. ! ! * gnus-cache.el (gnus-cache-open): Don't create cache things ! unconditionally. ! ! * gnus.el (gnus-server-status): New function. ! (gnus-group-get-new-news-this-group): Better error message. ! (gnus-clear-system): Clear state alist. ! (gnus-error): Doc fix. ! ! * nnmail.el (nnmail-get-spool-files): Use the spool file even when ! using procmail. ! ! Wed Jun 26 20:36:40 1996 Philippe Troin ! ! * gnus.el (gnus-thread-total-score-1): New version. ! ! Wed Jun 26 20:31:25 1996 Lars Magne Ingebrigtsen ! ! * nnspool.el (nnspool-find-id): Quote the Message-ID. ! ! * message.el (message-check-news-syntax): Would respond to ! i-have-a-mi-etc in References. ! ! Wed Jun 26 19:59:27 1996 Nat Makarevitch ! ! * smiley.el (smiley-regexp-alist): New definition. ! ! Wed Jun 26 17:45:00 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-reply): Name the message buffer "wide ! reply..." if following up on a mail group. ! ! * gnus.el (gnus-auto-subscribed-groups): Doc fix. ! (gnus-options-subscribe): Doc fix. ! ! * smiley.el (smiley-buffer): Autoload. ! (messagexmas): Required. ! ! * gnus.el (gnus-message-archive-group): Moved here. ! (gnus-archive-server-wanted-p): New function used throughout. ! (gnus-message-archive-group): Default to nil. ! ! Tue Jun 25 21:15:41 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.3 is released. ! ! Tue Jun 25 21:13:37 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.26 is released. ! ! Tue Jun 25 20:58:40 1996 Richard Stallman ! ! * gnus-ems.el: Multiply color value by .6 instead of dividing by ! 3. ! ! Tue Jun 25 12:34:24 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-send-news): Disable `existing-groups' check ! when given a prefix. ! ! Mon Jun 24 16:54:26 1996 Alastair Burt ! ! * gnus-vis.el (gnus-summary-highlight-line): `default' mixed up ! with fonts. ! ! Sat Jun 22 13:56:49 1996 Lars Magne Ingebrigtsen ! ! * gnus-cite.el (gnus-cache-close): New function. ! ! Sat Jun 22 11:33:42 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.25 is released. ! ! Sat Jun 22 11:16:57 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-adjust-marked-articles): Would bug out on some ! bookmarks. ! ! Sat Jun 22 11:13:51 1996 Raja R. Harinath ! ! * gnus.el (gnus-summary-save-body-in-file): Saved wrong buffer. ! ! Sat Jun 22 10:57:35 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-thread-total-score-1): Replaced with old, ! non-buggy version. ! ! * gnus-xmas.el ((find-face 'gnus-x-face)): Set proper colors. ! ! Fri Jun 21 18:04:03 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.24 is released. ! ! Fri Jun 21 16:36:03 1996 Christoph Wedler ! ! * gnus-picon.el (gnus-picons-insert-face-if-exists): Total change. ! Didn't conform with the conventions for picon databases. Still a ! bit (MISC must be searched for explicitly), but otherwise we would ! always see the MISC/unknown face. Faster. ! (gnus-article-display-picons): Use accordingly. ! (gnus-group-display-picons): Use accordingly. ! (gnus-picons-try-to-find-face): Optional argument for not using ! `gnus-picons-glyph-alist'--otherwise we would always see the same ! x-face. ! (gnus-picons-display-x-face): Use it. ! (gnus-picons-reverse-domain-path): Deletia. ! ! Fri Jun 21 15:14:33 1996 Lars Magne Ingebrigtsen ! ! * gnus-vis.el (gnus-group-make-menu-bar): Fix the menu bar ! slightly. ! ! * gnus.el (gnus-thread-total-score-1): Didn't count right. ! ! * message.el (message-bounce): Would not skip past all blank ! lines. ! ! * gnus.el (gnus-directory): Removed autoload. ! (gnus-activate-group): Pass the `method' argument on. ! ! Fri Jun 21 09:41:53 1996 Hrvoje Niksic ! ! * gnus-vis.el (gnus-button-alist): Exclude > from mailto button. ! ! Fri Jun 21 09:37:39 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-article-mode-map): `end-of-bnuffer'. :-) ! ! Fri Jun 21 09:34:29 1996 Philippe Troin ! ! * gnus.el (gnus-thread-total-score-1): Don't count non-displayed ! articles. ! ! Fri Jun 21 09:21:11 1996 Lars Magne Ingebrigtsen ! ! * nnheader.el (nnheader-translate-file-chars): Would give faulty ! results on NTs. ! ! Fri Jun 21 09:08:48 1996 Philippe Troin ! ! * gnus-cite.el (gnus-article-hide-citation): Would sometimes bug ! out. ! ! Fri Jun 21 09:01:51 1996 Lars Magne Ingebrigtsen ! ! * gnus-msg.el (gnus-copy-article-buffer): Would include text ! properties on XEmacs. ! ! Thu Jun 20 18:38:07 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-mode): Took `C-n' expansion out. ! ! Thu Jun 20 18:35:22 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.23 is released. ! ! Thu Jun 20 15:43:50 1996 Lars Magne Ingebrigtsen ! ! * gnus-picon.el (gnus-article-display-picons): Use a "\n" ! annotation instead of opening a line. ! ! * gnus.el (gnus-summary-reselect-current-group): Be silent. ! ! * nnml.el (nnml-request-replace-article): Update the Lines header ! before writing the article to disk. ! ! * gnus-vis.el (gnus-button-reply): Use the address in the mailto ! URL. ! ! * nnheader.el (nnheader-translate-file-chars): Would fail on NT. ! (nnheader-directory-files-safe): New function. ! (nnheader-directory-articles): Use it. ! (nnheader-article-to-file-alist): Use it. ! ! * gnus.el (gnus-read-move-group-name): Activate group after ! creating it. ! ! * gnus-cite.el (gnus-article-fill-cited-article): Would bug out on ! empty articles. ! ! * message.el (message-insert-signature): Don't strip trailing ! white space. ! ! * gnus-picon.el (gnus-picons-insert-face-if-exists): Don't insert ! so many bars. ! ! * message.el (message-mode): Define more abbrev keys. ! ! * gnus-picon.el (gnus-article-display-picons): Would bug out on ! some usernames. ! ! * gnus-xmas.el (gnus-xmas-copy-article-buffer): Removed. ! ! Thu Jun 20 09:38:54 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-kill-gnus-frames): New function. ! (gnus-clear-system): Use it. ! (gnus-group-suspend): Ditto. ! ! * message.el (message-check-news-syntax): Better checksumming. ! (message-checksum): Better checksum. ! ! * gnus-salt.el (gnus-tree-minimize): Never delete any other ! windows. ! ! Wed Jun 19 19:44:46 1996 Christoph Wedler ! ! * gnus-picon.el (gnus-article-display-picons): Lowercase username. ! (gnus-picons-reverse-domain-path): Lowercase domain path. ! (gnus-picons-display-article-move-p): New user option. ! (gnus-article-display-picons): Use it. ! (gnus-group-display-picons): Use it. ! ! Wed Jun 19 19:31:56 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.22 is released. ! ! Wed Jun 19 18:53:46 1996 Lars Magne Ingebrigtsen ! ! * gnus-picon.el (gnus-group-display-picons): Insert a bar. ! ! * gnus-xmas.el (gnus-xmas-redefine): On XEmacs 19.13, set ! `shell-command-switch'. ! ! * gnus.el (gnus-summary-work-articles): Use numeric value of ! `C-u'. ! ! Wed Jun 19 18:36:23 1996 Christopher Davis ! ! * message.el (message-mode): Add signature separator. ! (message-insert-signature): Check whether a signature is present. ! ! Wed Jun 19 17:29:07 1996 Lars Magne Ingebrigtsen ! ! * nnmh.el (nnmh-request-move-article): Make sure we change back to ! the right directory. ! ! * gnus-picon.el (gnus-article-display-picons): Make sure the ! buffer is created. ! ! Wed Jun 19 16:58:21 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.21 is released. ! ! Wed Jun 19 15:39:09 1996 Lars Magne Ingebrigtsen ! ! * gnus-picon.el (gnus-picons-glyph-alist): New variable. ! (gnus-picons-try-to-find-face): Use it. ! (gnus-picons-close): New function. ! ! * gnus.el (gnus-group-set-mode-line): After saving the .newsrc, ! mark the group buffer as unmodified. ! (gnus-group-name-to-method): New function. ! (gnus-read-move-group-name): Use it. ! (gnus-info-nodes): Add more modes. ! (gnus-windows-old-to-new): Would produce invalid configurations. ! ! Wed Jun 19 15:36:35 1996 Philippe Troin ! ! * gnus-score.el (gnus-score-load-file): Would bug out on ! directories not ending with a /. ! ! Wed Jun 19 14:46:42 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-article-mode-map): Bind `<' and `>'. ! (gnus-group-expire-articles): Close group after expiring. ! ! * gnus-xmas.el (gnus-xmas-redefine): Don't do the mode-line things ! for XEmacs 19.13. ! ! Wed Jun 19 14:09:21 1996 Chuck Thompson ! ! * gnus-xmas.el (gnus-xmas-summary-recenter): Removed the ! `sit-for'. ! ! Wed Jun 19 13:15:05 1996 Lars Magne Ingebrigtsen ! ! * gnus-picon.el (gnus-picons-get-maximum-picons): Removed. ! (gnus-picons-file-suffixes): New variable. ! (gnus-picons-try-suffixes): New substs. ! (gnus-article-display-picons): Would sometimes insert double ! picons. ! (gnus-picons-try-to-find-face): Insert some air. ! (gnus-picons-insert-face-if-exists): Don't stat so many files. ! ! Tue Jun 18 18:40:36 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.20 is released. ! ! Tue Jun 18 12:24:34 1996 Lars Magne Ingebrigtsen ! ! * gnus-xmas.el (gnus-xmas-group-startup-message): Fix mode line. ! ! * gnus-picon.el (gnus-article-display-picons): When displaying in ! the article buffer, insert picon in separator line. ! (gnus-article-display-picons): Get more picons. ! (gnus-picons-insert-face-if-exists): New implementation. ! (gnus-picons-get-maximum-picons): New variable. ! ! * gnus-xmas.el (gnus-xmas-summary-menu-add): Change order. ! ! * messagexmas.el (message-toolbar): Go to message info. ! ! * gnus-xmas.el (gnus-xmas-mode-line-buffer-identification): New ! function. ! ! * gnus-ems.el (gnus-mode-line-buffer-identification): New alias. ! ! * gnus-xmas.el (gnus-xmas-article-show-hidden-text): New function. ! ! * smiley.el (smiley-regexp-alist): Require whitespace before ! smiley. ! ! * gnus-xmas.el (gnus-xmas-article-display-xface): Use new ! `gnus-x-face' face. ! ! * smiley.el (smiley-end-paren-p): New function. ! (smiley-buffer): Use it. ! ! * gnus.el (gnus-group-update-group-line): Protect against nil ! groups. ! ! * nntp.el (nntp-open-server-semi-internal): Better error message. ! ! * gnus.el (gnus-get-function): Accept a noerror param. ! (gnus-request-head): Use it. ! ! * messagexmas.el (message-xmas-setup-toolbar): Would bug out on ! second run. ! ! Tue Jun 18 09:48:12 1996 Lars Magne Ingebrigtsen ! ! * gnus-xmas.el (gnus-xmas-article-display-xface): Insert X-Face ! after From:. ! (gnus-summary-toolbar): New exit tool. ! ! Tue Jun 18 09:46:57 1996 Chuck Thompson ! ! * custom.el (custom-face-import): Check for face name. ! ! Tue Jun 18 06:23:45 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-execute-command): Use `shell-command-name'. ! ! * gnus-uu.el (gnus-uu-treat-archive): Use `shell-command-switch'. ! ! * gnus.el (gnus-summary-mode-line-format-alist): Would break on ! %U. ! ! * message.el (message-setup): Delete excess line. ! ! * nnmh.el (nnmh-request-list-1): Regexp-quote file name. ! ! Mon Jun 17 04:38:16 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el (gnus-summary-increase-score): Always kill the ! score help buffer. ! (gnus-score-insert-help): Only insert scores on relevant match ! types. ! ! * message.el (message-send-news): Cleanup headers. ! ! * gnus-picon.el (gnus-group-display-picons): Make sure the buffer ! is created. ! ! * smiley.el (annotations): Required. ! ! * nnmail.el (nnmail-move-inbox): Didn't push proper file onto list ! of moved inboxes. ! ! * gnus-msg.el (gnus-copy-article-buffer): Exclude "From " lines. ! ! Sun Jun 16 08:18:18 1996 Barry A. Warsaw ! ! * gnus.el (gnus-read-save-file-name): Better prompting. ! ! Sun Jun 16 01:18:18 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-request-head): Support fetching heads from all ! backends. ! (gnus-read-header): Use it. ! (gnus-header-value): No continuation headers. ! (gnus-summary-mark-article-as-unread): Beep on unmarkable ! articles. ! ! * nnspool.el (nnspool-request-head): Fold continuation lines. ! * nntp.el (nntp-request-head): Ditto. ! ! * gnus.el (gnus-group-delete-group): Dox fix. ! (gnus-summary-prepare-threads): Output saved mark. ! (gnus-summary-reselect-current-group): Ding on ephemeral groups. ! ! * nnmail.el (nnmail-internal-password): Cache password. ! ! * message.el (message-buffer-name): Better non-group news name. ! (message-insert-to): Don't insert ", , ,". ! (message-insert-newsgroups): Ditto. ! ! * gnus-srvr.el (gnus-server-set-status): New function. ! (gnus-server-close-server): Use it. ! (gnus-server-update-server): Update browsed servers. ! ! Sat Jun 15 11:32:14 1996 Lars Magne Ingebrigtsen ! ! * smiley.el (smiley-circle-color): New variable. ! ! * gnus-xmas.el (gnus-xmas-highlight-selected-summary): Only use on ! XEmacs 19.13. ! ! Sat Jun 15 09:07:05 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.18-19 is released. ! ! Sat Jun 15 10:44:16 1996 Lars Magne Ingebrigtsen ! ! * smiley.el: Included in distribution. ! ! Sat Jun 15 06:25:19 1996 Lars Magne Ingebrigtsen ! ! * custom.el (custom-xmas-set-text-properties): Ignore string ! props. ! ! Sat Jun 15 03:12:58 1996 Lars Magne Ingebrigtsen ! ! * nnvirtual.el (nnvirtual-request-update-mark): Would bug out on ! pseudos. ! ! * gnus.el (gnus-read-descriptions-file): Insert prefix for foreign ! groups. ! (gnus-group-describe-group): Just `force' the current group. ! ! Sat Jun 15 02:43:29 1996 Christopher Davis ! ! * message.el (message-mode): Have signature separator be paragraph ! separator. ! ! Sat Jun 15 02:26:08 1996 Lars Magne Ingebrigtsen ! ! * messagexmas.el (message-exchange-point-and-mark): fset to xmas. ! ! Sat Jun 15 01:59:08 1996 lantz moore ! ! * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't insert spaces ! at the end. ! ! Sat Jun 15 01:58:17 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-tokenize-header): Would return empty ! strings. ! ! Thu Jun 13 18:26:34 1996 Christoph Wedler ! ! * gnus-scomo.el (gnus-score-make-menu-bar): Correct Exit function. ! ! * gnus-score.el (gnus-score-edit-file): Correct message. ! ! * gnus-srvr.el (gnus-server-make-menu-bar): Use two symbols for ! two menus. ! ! * gnus-xmas.el (gnus-xmas-score-menu-add): New function. ! (gnus-xmas-redefine): Use it. ! (gnus-xmas-server-menu-add): Add two menus. ! ! * nnfolder.el (nnfolder-generate-active-file): Use other function ! to read file (not sure whether this is OK, but now it worked for ! me, even with VM folders) ! (nnfolder-read-folder): delete oldactive (never used) ! ! Sat Jun 15 00:45:53 1996 Lars Magne Ingebrigtsen ! ! * messagexmas.el (message-xmas-setup-toolbar): If one icon doesn't ! exist, report a failure. ! ! * nnmh.el (nnmh-request-expire-articles): Message errors. ! ! Fri Jun 14 13:06:43 1996 Steven L Baur ! ! * message.el (message-yank-original): Used misnamed wrapper ! function. ! ! * messagexmas.el (message-xmas-exchange-point-and-mark): Used ! misnamed control variable. ! ! Fri Jun 14 06:24:02 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.17 is released. ! ! Fri Jun 14 05:16:14 1996 Lars Magne Ingebrigtsen ! ! * gnus-xmas.el (gnus-xmas-call-region): New function. ! ! * nnheaderxm.el (nnheader-xmas-find-file-noselect): Simplify. ! ! Fri Jun 14 04:30:30 1996 Steven L. Baur ! ! * messagexmas.el (message-xmas-exchange-point-and-mark): New ! function. ! (message-xmas-dont-activate-region): New variable. ! ! Fri Jun 14 02:59:30 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-next-article): Check for nil cmd. ! ! * gnus-xmas.el (gnus-xmas-group-startup-message): Use xbm if that ! is required. ! ! * messagexmas.el (message-xmas-setup-toolbar): Make sure all ! buttons are defined. ! ! * gnus-xmas.el (gnus-summary-mail-toolbar): Add other icons. ! (gnus-summary-toolbar): Add next/prev/catchup icons. ! ! * gnus-xmas.el: Use more native functions. ! ! Thu Jun 13 23:40:45 1996 Steven L. Baur ! ! * messagexmas.el (message-use-toolbar): Check for toolbar ! support. ! ! Thu Jun 13 22:35:43 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el (gnus-newsgroup-score-alist): New function. ! ! * gnus.el (gnus-simplify-buffer-fuzzy): Use folded search. ! ! * message.el (message-tokenize-header): Respect quotes. ! ! * gnus.el (gnus-group-kill-group): Mass killing didn't work. ! ! * gnus-demon.el (gnus-demon-scan-mail): Make sure the server is ! openable. ! ! Thu Jun 13 02:41:11 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.16 is released. ! ! Thu Jun 13 02:28:26 1996 Lars Magne Ingebrigtsen ! ! * nnheader.el (nnheader-insert-nov): Fudge a message-id if ! necessary. ! ! * nnml.el (nnml-request-accept-article): Use it. ! ! * nnmail.el (nnmail-check-syntax): New function. ! ! * gnus.el (gnus-group-fetch-faq): Would bug out when not called in ! the group buffer. ! (gnus-use-long-file-name): Doc fix. ! (gnus-summary-search-article): Search backward from where we left ! off. ! ! * gnus-xmas.el (gnus-xmas-server-menu-add): New function. ! (gnus-xmas-browse-menu-add): Ditto. ! ! Wed Jun 12 18:32:57 1996 Christoph Wedler ! ! * gnus-srvr.el (gnus-server-make-menu-bar): Use ! `gnus-server-deny-server' ! ! Wed Jun 12 23:02:19 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-send-rename-function): New variable. ! (message-do-send-housekeeping): Use it. ! ! Wed Jun 12 22:53:32 1996 Richard Mlynarik ! ! * message.el (message-make-fqdn): Make sure `user-mail-address' ! and `mail-host-address' looks like a full address. ! ! Wed Jun 12 22:06:39 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-generate-new-buffers): Extended syntax. ! (message-buffer-name): Use it. ! (message-make-fqdn): Checked `user-mail-address' directly. ! (message-check-news-syntax): Check for misconfiguration. ! ! * nnmail.el (nnmail-move-inbox): Use it. ! ! Wed Jun 12 22:06:10 1996 Richard Pieri ! ! * nnmail.el (nnmail-read-password): New function. ! ! Wed Jun 12 21:59:40 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-send): Make buffer read/write before ! sending. ! ! * gnus-score.el (gnus-score-edit-current-scores): Correct ! message. ! ! Wed Jun 12 19:31:50 1996 Lars Magne Ingebrigtsen ! ! * gnus-msg.el (gnus-inews-insert-archive-gcc): If ":" in name, ! just use name. ! (gnus-message-archive-group): Doc fix. ! ! * nnmail.el (nnmail-split-it): Regexp bogosity. ! ! * gnus-vis.el (gnus-button-alist): Have "news:" rule come before ! URL rule. ! ! * message.el (message-setup): Really be read-only. ! ! * gnus.el (gnus-summary-import-article): Use message. ! ! Tue Jun 11 10:04:55 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-make-fqdm): Use `mail-host-address' before ! `user-mail-address'. ! (message-make-fqdn): Typo is function name. ! ! * nndb.el: Make byte-compiler silent. ! ! Tue Jun 11 02:29:33 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.15 is released. ! ! * gnus-score.el (gnus-score-find-trace): Erase contents first. ! ! * nntp.el (nntp-send-region-to-server): Make sure the server is ! up. ! ! * gnus.el (gnus-summary-edit-article-done): Reversed parameters. ! ! * nnheaderxm.el: Renamed. ! ! * nnmail.el ((eq system-type 'windows-nt)): Moved here. ! ! Tue Jun 11 02:11:30 1996 Lars Magne Ingebrigtsen ! ! * nnmail.el (nnmail-pop-password): New variable. ! (nnmail-pop-password-required): New variable. ! (nnmail-move-inbox): Use them. ! ! Mon Jun 10 21:40:13 1996 Lars Magne Ingebrigtsen ! ! * gnus-xmas.el (gnus-xmas-summary-recenter): Don't sit-for on ! XEmacs 19.13. ! ! * gnus-picon.el (gnus-group-display-picons): `set-to-buffer'? ! ! * gnus.el (gnus-articles-to-read): Don't prompt for scored unless ! there are many unscored ones. ! (gnus-read-move-group-name): Prompt when group doesn't exist. ! (gnus-output-to-file): New implementation. ! (gnus-summary-save-article): Would duplicate while saving. ! (gnus-summary-save-article): Prompts wouldn't be remembered. ! (gnus-article-hide-headers): Inhibit point motion hooks. ! ! Mon Jun 10 05:20:24 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.14 is released. ! ! * gnus-cus.el (()): Display X face by default. ! ! * gnus-xmas.el (gnus-article-x-face-command): New default. ! ! * gnus-ems.el: Moved x-face. ! ! * gnus-xmas.el (gnus-xmas-article-display-xface): New function. ! ! Mon Jun 10 03:08:10 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.13 is released. ! ! * gnus-cus.el (()): Changed LemonChiffon to Turquoise. ! ! * message.el (message-signature-setup-hook): New hook. ! ! * gnus-xmas.el (gnus-xmas-summary-recenter): `sit-for' for right ! height. ! ! Mon Jun 10 00:02:15 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-article-check-hidden-text): New definition. ! (gnus-hidden-arg): New function. ! (gnus-article-hide-headers): Don't toggle when called ! non-interactively. ! ! * messagexmas.el (message-xmas-setup-toolbar): Use xbms. ! ! * gnus-score.el (gnus-score-file-regexp): Regexp-quote suffixes. ! (gnus-score-load-file): Wouldn't set `adapt-file' right. ! ! * gnus-xmas.el (gnus-xmas-logo-color-alist): Removed double "##". ! ! * gnus-score.el (gnus-score-find-bnews): Deal with "++". ! ! Sun Jun 9 22:18:05 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el (gnus-score-find-trace): Don't error, just beep. ! ! * gnus-cite.el (gnus-cite-minimum-match-count): Changed default to ! 2. ! ! Sun Jun 9 05:48:18 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-message-archive-method): Dox fix. ! ! * message.el (message-check-news-syntax): Allow + and _ in group ! names. ! ! * gnus.el (gnus-group-fetch-faq): Didn't allow completion. ! ! Sun Jun 9 05:36:16 1996 Hrvoje Niksic ! ! * message.el (message-ignored-supersedes-headers): New default. ! ! Sun Jun 9 05:17:34 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el (gnus-score-score-files-1): Don't match on "/" in ! file names. ! * nnml.el (nnml-generate-nov-databases-1): Ditto. ! * nnmh.el (nnmh-request-list-1): Ditto. ! * gnus-uu.el (gnus-uu-scan-directory): Ditto. ! ! * nnheaderems.el: Strip CR on windows-nt. ! ! Sun Jun 9 05:15:13 1996 Dave Disser ! ! * gnus-picon.el (gnus-group-display-picons): Set instead of ! switching buffer. ! ! Sun Jun 9 05:08:51 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-article-read-summary-keys): Don't save winconf on ! "|". ! ! * nnmail.el (nnmail-delete-incoming): Changed default. ! ! * gnus.el (gnus-eval-in-buffer-window): Indent correctly. ! ! Sat Jun 8 19:24:24 1996 Lars Magne Ingebrigtsen ! ! * gnus-cite.el (gnus-cite-minimum-match-count): Changed default. ! ! Fri Jun 7 22:08:53 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.12 is released. ! ! * gnus.el (gnus-summary-refer-article): Would bug out when ! referring non-sparse articles. ! ! Fri Jun 7 19:59:45 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.11 is released. ! ! * gnus.el (gnus-summary-save-article): Would set ! `gnus-original-article-buffer' to a bogus value. ! (gnus-header-value): Didn't understand continuation headers! ! (gnus-get-newsgroup-headers): Use new value and pick out ! references when `^'. ! (gnus-number-to-header): New function. ! (gnus-summary-refer-article): Didn't work when sparse articles ! were in action. ! ! Fri Jun 7 17:19:21 1996 Christoph Wedler ! ! * nnheader.el (nnheader-insert-head): Use ! `nnheader-insert-file-contents-literally'. ! (nnheader-mail-file-mbox-p): Ditto. ! ! Fri Jun 7 14:05:28 1996 Jens Lautenbacher ! ! * custom.el ((string-match "XEmacs" emacs-version)): dito ! ! * gnus-vis.el (gnus-group-make-menu-bar): enable customize for XEmacs ! ! Fri Jun 7 19:20:22 1996 Richard Pieri ! ! * nnheaderems.el (nnheader-ms-strip-cr): New function. ! ! Thu Jun 6 18:22:04 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.10 is released. ! ! * message.el (message-header-format-alist): Use ! `message-fill-address' for To and Cc. ! (message-fill-address): New function. ! ! * gnus.el (gnus-article-check-hidden-text): Respect a postive ! arg. ! (gnus-summary-save-article): Remove headers from the original ! article buffer. ! (gnus-article-hide-headers): Delete "From " if wanted. ! ! * nnmail.el (nnmail-load-hook): Run hooks. ! ! Thu Jun 6 14:41:20 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-check-news-syntax): Don't warn on "poster". ! ! Wed Jun 5 20:22:48 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.9 is released. ! ! * message.el (message-setup): Add Mailcrypt magic. ! ! Wed Jun 5 18:01:58 1996 Lars Magne Ingebrigtsen ! ! * gnus-cus.el (()): New colors. ! ! * gnus-xmas.el (gnus-xmas-group-startup-message): Would bug out ! when compiled without XPM support. ! ! Wed Jun 5 17:17:00 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.8 is released. ! ! * nndoc.el (nndoc-type-alist): New babyl head begin. ! (nndoc-babyl-head-begin): New function. ! ! Wed Jun 5 16:26:55 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-save-article): Remove headers. ! ! Wed Jun 5 18:16:55 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-read-old-newsrc-el-file): Would bug out. ! ! Wed Jun 5 12:43:22 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el: `V f' to flush the cache. ! (gnus-score-flush-cache): Save scores before flushing. ! ! * gnus-cite.el (gnus-cite-prefix-regexp): Removed "-" as cite ! prefix. ! ! * gnus.el (gnus-summary-caesar-message): Use message. ! ! * gnus-cite.el (gnus-cite-prefix-regexp): Allow "-" as a cite ! prefix. ! ! * nnvirtual.el (nnvirtual-convert-headers): Wouldn't convert. ! ! * gnus-cus.el (()): Have `gnus-mouse-face' respect gnus-visual. ! ! Wed Jun 5 12:52:15 1996 Lars Magne Ingebrigtsen ! ! * dgnushack.el (custom-file): Changed setq. ! ! Tue Jun 4 13:46:45 1996 Scott Byer ! ! * nnfolder.el (nnfolder-read-folder) Take an additional parameter, ! scanning, which is t when we are only scanning for new news. In ! this case, if the modtime of the file hasn't changed since we last ! scanned it, we don't bother reading the file in, and simply return ! nil. When we do scan it, pay attention to the ! nnfolder-distrust-mbox variable, and only scan forward from the ! last marked message when nil. After scanning, remember the ! modtime of the visited buffer. ! ! * nnfolder.el (nnfolder-save-mail) If nnfolder-current-buffer is ! nil, make sure any open group is closed before changing the group ! - in the case where a group was opened for scanning but not read ! in because it wasn't touched, this forces the read. ! ! * nnfolder.el (nnfolder-possibly-change-group) Take an additional ! optional variable, which indicated if we're scanning. Passes it ! on to nnfolder-read-folder, and is prepared for ! nnfolder-read-folder to return nil for nnfolder-current-buffer. ! If we get a request to change to the currently open group, and ! nnfolder-current-buffer is nil (we're on the tail end of a scan), ! simply return. ! ! * nnfolder.el (nnfolder-request-scan) Inform ! nnfolder-possibly-change-group that we're scanning. ! ! * nnfolder.el (nnfolder-scantime-alist) New internal variable. ! Keep track of the last scantime of each mbox. ! ! * nnfolder.el (nnfolder-distrust-mbox) New variable. When t, ! nnfolder-read-folder reverts to it's old behavior of scanning an ! entire file looking for unmarked messages. When nil (the ! default), scans forward from the last marked message. Unless you ! have an external mailer which inserts new messages in the middle ! of your mailboxes, leave nil. ! ! Wed Jun 5 09:20:38 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-goto-body): Expand abbrev. ! ! Tue Jun 4 17:12:06 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.7 is released. ! ! Tue Jun 4 18:26:24 1996 Christoph Wedler ! ! * message-xms.el (message-xmas-find-glyph-directory): Wouldn't use ! PACKAGE-xmas-glyph-directory even if it is non-nil and a ! directory. ! (message-toolbar): Use special ispell function for messages. Jump ! to info pages for message composition. ! ! Tue Jun 4 17:12:06 1996 Lars Magne Ingebrigtsen ! ! * message.el (rmail): Require. ! ! Tue Jun 4 18:11:46 1996 Lars Magne Ingebrigtsen ! ! * gnus-cus.el (()): Bold group faces. ! ! Tue Jun 4 15:10:20 1996 Lars Magne Ingebrigtsen ! ! * gnus-cus.el (()): Unbold group faces. ! ! * custom.el (custom-face-lookup): Make all parameters optional. ! ! * gnus.el (gnus-thread-total-score): Protect against nil input. ! ! Tue Jun 4 11:11:13 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.6 is released. ! ! * gnus.el (gnus-summary-make-local-variables): Set local variables ! correctly. ! ! Tue Jun 4 07:51:02 1996 Steven L. Baur ! ! * gnus-cus.el (()): New "light' group highlighting. ! ! Tue Jun 4 07:26:10 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-subscribe-hierarchical-interactive): Don't accept ! wrong characters. ! ! * message.el (message-directory): Autoload. ! ! Mon Jun 3 07:30:18 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-make-local-variables): Separated into own ! function. ! (gnus-summary-make-local-variables): Respect global values. ! ! * nnheader.el (sendmail): Unrequired. ! (backquote): Ditto. ! ! * nntp.el (rnews): Unrequired. ! ! * gnus-msg.el (gnus-group-post-news): `C-u a' posts to the group ! under point, `C-u 1 a' prompts, `a' uses an empty group name. ! ! * message.el (message-setup): Make separator read-only. ! ! * gnus-cus.el (()): Define `gnus-group-highlight'. ! ! * gnus-vis.el (gnus-group-highlight): Commented out. ! ! * gnus-topic.el (gnus-topic-yank-group): Yank topics at the end of ! the buffer correctly. ! ! * gnus-score.el (gnus-score-adaptive): Make sure we use the ! buffer-local adaptive score variable. ! ! * gnus-msg.el (gnus-group-post-news): Prompt when given a prefix. ! ! * nnvirtual.el (nnvirtual-catchup-group): Might have corrupted the ! list of component groups. ! ! * gnus-ems.el: Work under OS/2 again. ! ! * gnus.el (gnus-remove-header): New function. ! (gnus-read-header): Use it. ! (gnus-summary-insert-subject): Didn't work when editing articles ! in a non-threaded display. ! (gnus-summary-update-article): Would create multiple root ! threads when editing. ! ! * message.el (message-do-send-housekeeping): Reverse check. ! ! * nnheader.el (backquote): Required. ! ! * gnus.el (backquote): Required. ! ! * message.el (message-make-from): Use the `user-full-name' ! variable. ! ! Sun Jun 2 16:50:49 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-number-of-buffers): New variable. ! (message-generate-new-buffers): Changed default. ! (message-do-send-housekeeping): New function. ! (message-buffer-name): New function. ! ! Sun Jun 2 07:41:20 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.5 is released. ! ! * gnus-topic.el (gnus-topic-remove-group): Only delete first ! instance. ! (gnus-topic-move-group): Ditto. ! (gnus-topic-change-level): Ditto. ! ! * gnus.el (gnus-summary-insert-subject): Do rebuilding of sparse ! articles right. ! (gnus-summary-update-article): Do updating of referred articles ! right. ! (gnus-delete-first): New function. ! ! * gnus-cus.el (()): Color change. ! ! * gnus.el (gnus-version): Accept a prefix to insert. ! ! Sat Jun 1 02:03:42 1996 Lars Magne Ingebrigtsen ! ! * custom.el: Require cl. ! ! * gnus.el (gnus-group-list-matching): `10 A m' to read the active ! file. ! ! * message.el (message-supersede): Don't use ! `mail-strip-quoted-names'. ! (message-cancel-news): Ditto. ! ! * nnfolder.el (nnfolder-retrieve-headers): Don't allow selecting ! empty groups. ! (nnfolder-request-group): Ditto. ! ! Sat Jun 1 01:26:45 1996 Per Abrahamsen ! ! * dgnushack.el (custom-file): Nix out. ! ! Sat Jun 1 01:24:28 1996 Massimo Campostrini ! ! * gnus-cus.el (()): Wrong number of arguments. ! ! Fri May 31 08:32:38 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Removed obsolete autoloads. ! ! * gnus-demon.el (gnus-demon-init): Use `nnheader-run-at-time'. ! ! * gnus.el (gnus-group-catchup-current): Warn. ! ! * gnus-srvr.el (gnus-browse-foreign-server): Message better. ! ! * gnus-topic.el (gnus-topic-change-level): Make sure we're in the ! group buffer. ! ! * gnus-srvr.el (gnus-server-exit-hook): New hook. ! (gnus-server-exit): Use it. ! ! * gnus-topic.el (gnus-topic-mode): Update more. ! ! * gnus.el (gnus-group-update-group-hook): New hook. ! (gnus-group-update-group): Use it. ! ! Fri May 31 04:33:16 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.4 is released. ! ! * custom.el (custom-face-lookup): Escape errors. ! ! * gnus-msg.el (gnus-inews-do-gcc): Don't do anything unless Gnus ! is alive. ! ! * custom.el (custom-face-lookup): Wrong number of params. ! ! Fri May 31 00:14:17 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-continuum-version): Also give responses to ! directory names. ! (gnus-summary-update-article): Would bug out on editing articles. ! ! Thu May 30 05:04:07 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.2 is released. ! ! * gnus.el (gnus-article-hide-headers): Show boring headers as ! well. ! ! Tue May 28 15:47:15 1996 Per Abrahamsen ! ! * custom.el ((fboundp 'event-point)): Wrong test. ! ! Thu May 30 03:19:21 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-headers-decode-quoted-printable): Wrong name. ! ! * message.el (message-header-hook): Defvarred. ! ! * gnus-nocem.el (gnus-nocem-verifyer): Couldn't verify that it ! works. ! ! Thu May 30 00:25:46 1996 Lars Magne Ingebrigtsen ! ! * gnus-nocem.el (gnus-nocem-verify-issuer): Widen before ! verifying. ! ! Wed May 29 23:19:46 1996 Lars Magne Ingebrigtsen ! ! * custom.el (custom-xmas-set-text-properties): Changed name. ! ! Wed May 29 23:01:52 1996 Paul D. Smith ! ! * gnus-cus.el: toggle -> sexp. ! ! Wed May 29 23:00:48 1996 Lars Magne Ingebrigtsen ! ! * gnus-msg.el (gnus-inews-add-send-actions): Use `gnus-add-hook'. ! ! Wed May 29 22:52:47 1996 Francois Felix Ingrand ! ! * gnus-topic.el (gnus-topic-remove-group): Would not delete groups ! from topics. ! ! Wed May 29 08:57:20 1996 Lars Magne Ingebrigtsen ! ! * custom.el (custom-face-lookup): Avoid `modify-face' to speed up ! face retrieval on Indys & over slow modem lines. ! ! Wed May 29 05:08:04 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.2 is released. ! ! * custom.el (custom-xmas-add-text-properties, ! custom-xmas-put-text-property): New functions used throughout. ! May now work under XEmacs. ! ! Wed May 29 00:07:13 1996 Lars Magne Ingebrigtsen ! ! * gnus-cite.el (gnus-cite-article): New variable. ! (gnus-cite-parse-maybe): Use it. ! ! * nnspool.el (nnspool-open-server): Refuse opening if the active ! file doesn't exist. ! ! * gnus.el (gnus-read-active-file): Message more. ! ! * nntp.el (nntp-request-article): Wouldn't wait until the entire ! article had arrived. ! ! * nnvirtual.el (nnvirtual-request-group): Make sure that things ! don't recurse endlessly. ! ! * message.el (message-expand-group): Make buffer not read-only. ! ! * gnus-nocem.el (gnus-nocem-verifyer): New variable. ! (gnus-nocem-verify-issuer): Use it. ! ! * gnus-xmas.el (gnus-xmas-logo-color-alist): New variable. ! (gnus-xmas-logo-color-style): New variable. ! (gnus-xmas-logo-colors): Use them. ! ! Tue May 28 00:28:38 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el (gnus-score-followup): Would infloop on exact ! matches. ! ! * message.el (message-forward): Insert separator at the start of ! the line. ! ! * nnfolder.el (nnfolder-save-buffer): New function. ! (nnfolder-save-buffer-hook): New variable. ! ! * message.el (message-mode-hook): Defined variable. ! ! * nntp.el (nntp-request-close): Remove the sentinel before closing ! connection. ! ! * gnus.el (gnus-group-mode): Add to local hook. ! (gnus-continuum-version): Would return wrong answer for non-alpha ! releases. ! (gnus-version-number): New variable. ! (gnus-version): Use it. ! ! * gnus-msg.el (gnus-inews-add-send-actions): Add to local hook. ! ! * gnus-xmas.el (gnus-xmas-add-hook): New function. ! ! * gnus-ems.el (gnus-add-hook): New alias. ! ! Tue May 28 00:23:17 1996 Joao Cachopo ! ! * gnus-salt.el (gnus-binary-mode): Would put wrong minor mode ! keymap into alist. ! ! Tue May 28 00:18:19 1996 Thor Kristoffersen ! ! * nntp.el (nntp-close-server): Supply parameter to ! `nntp-server-opened'. ! ! Sun May 26 20:29:02 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-article-sort-by-date): Inline. ! ! * nnmail.el (nnmail-find-file): Don't insert literally. ! ! * message.el (message-send-mail-with-mh): Save before sending. ! ! * gnus-cite.el (gnus-article-hide-citation): Would bug out. ! ! * gnus-topic.el (gnus-topic-grok-active): Could only be run once. ! ! * message.el (message-check-news-syntax): Don't warn on long ! signatures on forwarded articles. ! ! * gnus.el (gnus-request-article-this-buffer): Put un-numbered ! articles into the original buffer as well. ! ! Sun May 26 03:51:38 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: Gnus v5.2.1 is released. ! ! * gnus.el: Gnus v5.2.0 is released. ! ! * gnus.el: September Gnus v0.96 is released. ! ! * nnheader-ems.el: Raw-file confusion. ! ! * gnus-xmas.el (gnus-xmas-logo-colors): New variable. ! (gnus-xmas-group-startup-message): Use it. ! ! Sun May 26 02:35:48 1996 Lars Magne Ingebrigtsen ! ! * nnheader-ems.el: Bind nnheader-insert-raw-file-contents. ! ! * gnus.el: 0.95 is released. ! ! Sun May 26 02:34:01 1996 Bart Robinson ! ! * gnus.el (gnus-save-newsrc-file): Make the backups go to the ! right directory. ! ! Sun May 26 00:04:38 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-cut-thread): Wouldn't cut properly with ! old-fetched and dormant articles. ! ! Sat May 25 22:49:51 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-search-article): Continue from where we ! were. ! (gnus-summary-insert-subject): Wouldn't insert when old-fetched ! articles. ! (gnus-cut-threads): Would display too many threads when both ! sparse & ancient articles were present. ! (gnus-invisible-cut-children): New function. ! ! Fri May 24 17:56:19 1996 Andy Norman ! ! * nnheader-ems.el (nnheader-xmas-find-file-noselect): Use ! `nnheader-insert-file-contents-literally'. ! ! Fri May 24 17:51:46 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-find-prev): With point at eob, would ! select the next-to-last article. ! ! Fri May 24 17:25:48 1996 Magnus Hammerin ! ! * gnus.el (gnus-group-mode): Use `gnus-make-local-hook'. ! (gnus-sortable-date): Typo. ! ! Fri May 24 17:24:15 1996 ISO-2022-JP ! ! * gnus.el (gnus-narrow-to-signature): Didn't work. ! ! Fri May 24 21:27:49 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: 0.94 is released. ! ! * nnvirtual.el (nnvirtual-request-group): Don't include itself in ! its component groups. ! ! * gnus.el (gnus-summary-mark-below): Changed default. ! ! Fri May 24 19:29:17 1996 Lars Magne Ingebrigtsen ! ! * message.el (message-check-news-syntax): Check invalid Newsgroups ! syntax. ! (message-mode-menu): Added spellcheck. ! ! * nntp.el (nntp-wait-for-response): Peel off ^Ms. ! ! * message.el (message-fix-before-sending): New function. ! (message-send): Use it. ! (message-check-news-syntax): Check for invalid group names. ! ! * gnus.el (gnus-summary-number-of-articles-in-thread): Return 0 if ! not included. ! ! Thu May 23 23:32:43 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: September Gnus v0.93 is released. ! ! * nnbabyl.el (nnbabyl-read-mbox): Would bogously increase the ! number in groups. ! ! Thu May 23 21:06:47 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: September Gnus v0.92 is released. ! ! * gnus-soup.el (gnus-soup-add-article): Would remove Xrefs from ! packet. ! ! * gnus.el (gnus-summary-catchup-to-here): Don't show hidden ! threads. ! ! * nnmail.el (nnmail-moved-inboxes): New variable. ! (nnmail-move-inbox): Use it. ! ! * gnus-uu.el (gnus-uu-decode-uu): Optional argument. ! ! * nnbabyl.el (nnbabyl-insert-lines): Don't insert negative Lines ! headers. ! ! Thu May 23 19:28:15 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-summary-insert-pseudos): Would create contiguous ! mouse-face areas. ! ! * nnheader-ems.el: New file. ! (nnheader-xmas-run-at-time): New function. ! (nnheader-xmas-cancel-timer): Ditto. ! (nnheader-xmas-insert-file-contents-literally): Moved here. ! ! * gnus.el (gnus-read-move-group-name): Bind ! minibuffer-confirm-incomplete. ! ! Thu May 23 15:20:47 1996 Lars Magne Ingebrigtsen ! ! * nntp.el (nntp-request-close): Give the QUIT time to reach the ! server before closing the connection. ! (nntp-close-server): Ditto. ! ! * gnus.el (gnus-summary-exit): Run the exit hook with point on the ! group being exited. ! ! Thu May 23 15:03:16 1996 ! ! * gnus.el (gnus-narrow-to-signature): Mimeish new definition. ! ! Thu May 23 15:03:16 1996 Lars Magne Ingebrigtsen ! ! * nnfolder.el (nnfolder-close-group): Don't read the buffer when ! closing down. ! ! * gnus.el (gnus-group-exit): Prompt even when the server is down. ! ! Wed May 22 21:56:56 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: September Gnus v0.91 is released. ! ! * gnus.el (gnus-setup-news): Slave Gnusii should clear the dribble ! buffer. ! ! Wed May 22 22:32:21 1996 Lars Magne Ingebrigtsen ! ! * gnus-score.el (gnus-summary-set-score): Moved here. ! (gnus-summary-raise-score): Would bug out on nil arguments. ! ! * message-xmas.el (message-toolbar): Changed. ! ! * gnus-xmas.el (gnus-summary-mail-toolbar): New toolbar. ! (gnus-xmas-setup-summary-toolbar): Use it. ! ! Wed May 22 19:24:04 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-message-archive-method): Buggy definition. ! (gnus-summary-prepare-threads): Don't mark ancient as low-scored. ! (gnus-summary-prepare-unthreaded): Ditto. ! ! Wed May 22 02:14:42 1996 Lars Magne Ingebrigtsen ! ! * gnus.el (gnus-save-hidden-threads): New macro. ! (gnus-hidden-threads-configuration): New function. ! (gnus-restore-hidden-threads-configuration): New function. ! (gnus-summary-search-article): Use it. ! ! * gnus-picon.el (gnus-picons-reverse-domain-path): New definition. ! ! * message.el: Required wrong file under XEmacs. ! ! * gnus-gl.el (bbb-get-predictions): Return nil on errors. ! ! * nnfolder.el (nnfolder-close-group): Make sure the buffer is ! alive before killing it. ! ! Tue May 21 20:08:33 1996 Lars Magne Ingebrigtsen ! ! * gnus.el: September Gnus v0.90 is released. ! ! * gnus.el (gnus-dribble-read-file): Don't do modes unless they are ! available. ! ! * gnus-score.el (gnus-summary-score-entry): Wouldn't show ! immediate scorign of followups. ! (gnus-score-save): Use prin1 instead of format. ! ! * gnus-msg.el (gnus-bug-kill-buffer): Bogus. ! ! Tue May 21 18:32:29 1996 Lars Magne Ingebrigtsen ! ! * gnus-vis.el (gnus-button-next-page): New command. ! (gnus-button-prev-page): Ditto. ! ! * gnus-topic.el (gnus-topic-unique): Removed variable. ! (gnus-current-topic): New function. ! (gnus-topic-move-group): Use it. ! (gnus-topic-goto-next-group): Use it. ! ! Tue May 21 11:08:42 1996 Steven L Baur ! ! * gnus-setup.el: Copyright assigned to FSF. ! Tue May 21 17:09:27 1996 Lars Magne Ingebrigtsen ! * message.el (message-fetch-field): New function. ! * gnus.el (gnus-directory): New variable. ! * message.el (message-directory): New variable. ! * nnmail.el (nnmail-insert-lines): Make sure point is at the ! beginning of the line. ! (nnmail-directory): New variable. ! * gnus.el (gnus-mode-string-quote): New function. ! (gnus-set-mode-line): Use it. ! Tue May 21 10:34:26 1996 Lars Magne Ingebrigtsen ! * gnus-msg.el (gnus-inews-do-gcc): Use message narrow to headers. ! (gnus-inews-do-gcc): Find the right archive method. ! * gnus.el (gnus-select-newsgroup): Check whether the group can be ! requested first. ! (gnus-no-server): Nonsensical. ! (gnus-group-mark-group): Go past topic lines. ! (gnus-server-to-method): Would return nil on select methods. ! * gnus-topic.el (gnus-topic-mode): Don't check topology unless we ! have the newsrc alist. ! (gnus-topic-check-topology): Wouldn't check topology properly. ! * nnsoup.el (nnsoup-request-list): Make sure the active file is ! read first. ! * gnus.el (gnus-sortable-date): Simplified. ! (gnus-group-set-mode-line): Remove the ":" if the server is "". ! Tue May 21 10:13:28 1996 Jack Vinson ! * message.el (message-rename-buffer): New command and keystroke. ! Mon May 20 10:15:12 1996 Lars Magne Ingebrigtsen ! * gnus.el (gnus-summary-search-article): New implementation; set ! point in the article buffer to the match. ! (gnus-parent-headers): New function. ! (gnus-dd-mmm): Protect against broken dates. ! * gnus-topic.el (gnus-topic-unread): New function. ! (gnus-topic-update-topic-line): Use it. ! * gnus.el (gnus-group-list-active): Protect against unbound ! symbols. --- 16,62 ---- (gnus-group-rename-group): Would act oddly when renaming native groups. ! Mon Jul 29 14:17:30 1996 Lars Magne Ingebrigtsen ! * gnus-load.el (gnus-startup-hook): Removed hilit removal. ! * gnus-async.el: New file. ! * gnus-int.el (gnus-asynchronous-p): New function. ! * nntp.el: Replaced with new, asynchronous version. ! Mon Jul 29 11:48:07 1996 Paul Franklin ! * gnus-sum.el (gnus-pdf-simplify-subject): New function. ! (gnus-summary-simplify-subject-query): New command. ! Mon Jul 29 10:05:30 1996 Lars Magne Ingebrigtsen ! * gnus-sum.el (gnus-summary-mode-map): Command for emphasis. ! * gnus-art.el (gnus-article-wash-status): Report emphasis. ! * article.el (article-unhide-text-type): New function. ! (article-emphasize): New function. ! (article-emphasis-alist): New variable. ! * gnus-score.el (gnus-score-headers): Hook into advanced scoring. ! * gnus-logic.el: New file. ! * article.el (article-treat-overstrike): Mark hiding type. ! Mon Jul 29 10:00:52 1996 d. hall ! * gnus-art.el (gnus-article-wash-status): New function. ! Sun Jul 28 15:20:19 1996 Lars Magne Ingebrigtsen ! * article.el (article-hidden-arg): Renamed all variables and ! functions to `article-'. ! * gnus.el: Split file into gnus-start.el, gnus-group.el, ! gnus-sum.el, gnus-art.el, gnus-win.el, gnus-load.el, gnus-util.el, ! gnus-bcklg.el, gnus-spec.el, article.el, and gnus-int.el. *** pub/rgnus/texi/gnus.texi Tue Jul 30 19:55:04 1996 --- rgnus/texi/gnus.texi Tue Jul 30 18:29:38 1996 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Gnus 5.2 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Red Gnus Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 230,236 **** @tex @titlepage ! @title Gnus Manual @author by Lars Magne Ingebrigtsen @page --- 230,236 ---- @tex @titlepage ! @title Red Gnus Manual @author by Lars Magne Ingebrigtsen @page *************** *** 6369,6376 **** @vindex gnus-article-mode-line-format @item gnus-article-mode-line-format This variable is a format string along the same lines as ! @code{gnus-summary-mode-line-format}. It accepts exactly the same ! format specifications as that variable. @vindex gnus-break-pages @item gnus-break-pages --- 6369,6384 ---- @vindex gnus-article-mode-line-format @item gnus-article-mode-line-format This variable is a format string along the same lines as ! @code{gnus-summary-mode-line-format}. It accepts the same ! format specifications as that variable, with one extension: ! ! @table @samp ! @item w ! The @dfn{wash status} of the article. This is a short string with one ! character for each possible article wash operation that may have been ! performed. ! @end table ! @vindex gnus-break-pages @item gnus-break-pages *************** *** 8421,8426 **** --- 8429,8561 ---- and @code{news}. @end table + @menu + * Document Server Internals:: How to add your own document types. + @end menu + + + @node Document Server Internals + @subsubsection Document Server Internals + + Adding new document types to be recognized by @code{nndoc} isn't + difficult. You just have to whip up a definition of what the document + looks like, write a predicate function to recognize that document type, + and then hook into @code{nndoc}. + + First, here's an example document type definition: + + @example + (mmdf + (article-begin . "^\^A\^A\^A\^A\n") + (body-end . "^\^A\^A\^A\^A\n")) + @end example + + The definition is simply a unique @dfn{name} followed by a series of + regexp pseudo-variable settings. Below are the possible + variables---don't be daunted by the number of variables; most document + types can be defined with very few settings: + + @table @code + @item first-article + If present, @code{nndoc} will skip past all text until it finds + something that match this regexp. All text before this will be + totally ignored. + + @item article-begin + This setting has to be present in all document type definitions. It + says what the beginning of each article looks like. + + @item head-begin-function + If present, this should be a function that moves point to the head of + the article. + + @item nndoc-head-begin + If present, this should be a regexp that matches the head of the + article. + + @item nndoc-head-end + This should match the end of the head of the article. It defaults to + @samp{"^$"}---the empty line. + + @item body-begin-function + If present, this function should move point to the beginning of the body + of the article. + + @item body-begin + This should match the beginning of the body of the article. It defaults + to @samp{^\n}. + + @item body-end-function + If present, this function should move point to the end of the body of + the article. + + @item body-end + If present, this should match the end of the body of the article. + + @item nndoc-file-end + If present, this should match the end of the file. All text after this + regexp will be totally ignored. + + @end table + + So, using these variables @code{nndoc} is able to dissect a document + file into a series of articles, each with a head and a body. However, a + few more variables are needed since not all document types are all that + news-like---variables needed to transform the head or the body into + something that's palatable for Gnus: + + @table @code + @item prepare-body-function + If present, this function will be called when requesting an article. It + will be called with point at the start of the body, and is useful if the + document has encoded some parts of its contents. + + @item article-transform-function + If present, this function is called when requesting an article. It's + meant to be used how more wide-ranging transformation of both head and + body of the article. + + @item generate-head-function + If present, this function is called to generate a head that Gnus can + understand. It is called with the article number as a parameter, and is + expected to generate a nice head for the article in question. It is + called when requesting the headers of all articles. + + @end table + + Let's look at the most complicated example I can come up with---standard + digests: + + @example + (standard-digest + (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) + (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) + (prepare-body-function . nndoc-unquote-dashes) + (body-end-function . nndoc-digest-body-end) + (head-end . "^ ?$") + (body-begin . "^ ?\n") + (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$") + (subtype digest guess)) + @end example + + We see that all text before a 70-width line of dashes is ignored; all + text after a line that starts with that @samp{^End of} is also ignored; + each article begins with a 30-width line of dashes; the line separating + the head from the body may contain a single spcae; and that the body is + run through @code{nndoc-unquote-dashes} before being delivered. + + To hook your own document definition into @code{nndoc}, use the + @code{nndoc-add-type} function. It takes two parameters---the first is + the definition itself and the second (optional) parameter says where in + the document type definition alist to put this definition. The alist is + traversed sequentially, and @code{nndoc-TYPE-type-p} is called for each + type. So @code{nndoc-mmdf-type-p} is called to see whether a document + is of @code{mmdf} type, and so on. These type predicates should return + @code{nil} if the document is not of the correct type; @code{t} if it is + of the correct type; and a number if the document might be of the + correct type. A high number means high probability; a low number means + low probability with @samp{0} being the lowest legal number. + @node SOUP @subsection SOUP *************** *** 8832,8837 **** --- 8967,8973 ---- * Global Score Files:: Earth-spanning, ear-splitting score files. * Kill Files:: They are still here, but they can be ignored. * GroupLens:: Getting predictions on what you like to read. + * Advanced Scoring:: Using logical expressions to build score rules. @end menu *************** *** 10044,10049 **** --- 10180,10351 ---- @end table + @node Advanced Scoring + @section Advanced Scoring + + Scoring on Subjects and From headers is nice enough, but what if you're + really interested in what a person has to say only when she's talking + about a particular subject? Or what about if you really don't want to + read what person A has to say when she's following up to person B, but + want to read what she says when she's following up to person C? + + By using advanced scoring rules you may create arbitrarily complex + scoring patterns. + + @menu + * Advanced Scoring Syntax:: A definition. + * Advanced Scoring Examples:: What they look like. + * Advanced Scoring Tips:: Getting the most out of it. + @end menu + + + @node Advanced Scoring Syntax + @subsection Advanced Scoring Syntax + + Ordinary scoring rules have a string as the first element in the rule. + Advanced scoring rules have a list as the first element. The second + element is the score to be applied if the first element evaluated to a + non-@code{nil} value. + + These lists may consist of three logical operators, one redirection + operator, and various match operators. + + Logical operators: + + @table @code + @item & + @itemx and + This logical operator will evaluate each of its arguments until it finds + one that evaluates to @code{false}, and then it'll stop. If all arguments + evaluate to @code{true} values, then this operator will return + @code{true}. + + @item | + @itemx or + This logical operator will evaluate each of its arguments until it finds + one that evaluates to @code{true}. If no arguments are @code{true}, + then this operator will return @code{false}. + + @item ! + @itemx not + @itemx ¬ + This logical operator only takes a single argument. It returns the + inverse of the value of its argument. + + @end table + + There is an @dfn{indirection operator} that will make its arguments + apply to the ancenstors of the current article being scored. For + instance, @code{1-} will make score rules apply to the parent of the + current article. @code{2-} will make score fules apply to the + grandparent of the current article. Alternatively, you can write + @code{^^}, where the number of @code{^}s (carets) say how far back into + the ancestry you want to go. + + Finally, we have the match operators. These are the ones that do the + real work. Match operators are header name strings followed by a match + and a match type. A typical match operator looks like @samp{("from" + "Lars Ingebrigtsen" s)}. The header names are the same as when using + simple scoring, and the match types are also the same. + + + @node Advanced Scoring Example + @subsection Advanced Scoring Example + + Let's say you want to increase the score of articles written by Lars + when he's talking about Gnus: + + @samp + ((& + ("from" "Lars Ingebrigtsen") + ("subject" "Gnus")) + 1000) + @end samp + + Quite simple, huh? + + When he writes long articles, he sometimes has something nice to say: + + @samp + ((& + ("from" "Lars Ingebrigtsen") + (| + ("subject" "Gnus") + ("lines" 100 >))) + 1000) + @end samp + + However, when he responds to things written by Reig Eigil Logge, you + really don't want to read what he's written: + + @samp + ((& + ("from" "Lars Ingebrigtsen") + (1- ("from" "Reig Eigir Logge"))) + -100000) + @end samp + + Everybody that follows up Redmondo when he writes about disappearing + socks should have their scores raised, but only when they talk about + white socks. However, when Lars talks about socks, it's usually not + very interesting: + + @samp + ((& + (1- + (& + ("from" "redmondo@.*no" r) + ("body" "disappearing.*socks" t))) + (! ("from" "Lars Ingebrigtsen")) + ("body" "white.*socks")) + 1000) + @end samp + + The possibilities are endless. + + + @node Advanced Scoring Tips + @subsection Advanced Scoring Tips + + The @code{&} and @code{|} logical operators do short-circuit logic. + That is, they stop processing their arguments when it's clear what the + result of the operation will be. For instance, if one of the arguments + of an @code{&} evaluates to @code{false}, there's no point in evaluating + the rest of the arguments. This means that you should put slow matches + (@samp{body}, @code{header}) last and quick matches (@samp{from}, + @samp{subject}) first. + + The indirection arguments (@code{1-} and so on) will make their + arguments work on previous generations of the thread. If you say + something like: + + @samp + ... + (1- + (1- + ("from" "lars"))) + ... + @end samp + + Then that means "score on the from header of the grandparent of the + current article". An indirection is quite fast, but it's better to say: + + @samp + (1- + (& + ("from" "Lars") + ("subject" "Gnus"))) + @end samp + + than it is to say: + + @samp + (& + (1- ("from" "Lars")) + (1- ("subject" "Gnus"))) + @end samp + + @node Various @chapter Various *************** *** 11139,11144 **** --- 11441,11448 ---- In May 1996 the next Gnus generation (aka. ``September Gnus'') was released under the name ``Gnus 5.2''. + + On July 28th 1996 work on Red Gnus was begun. @menu * Why?:: What's the point of Gnus? *** pub/rgnus/texi/ChangeLog Fri Jul 19 00:43:43 1996 --- rgnus/texi/ChangeLog Mon Jul 29 10:35:26 1996 *************** *** 1,685 **** ! Fri Jul 19 00:41:11 1996 Lars Magne Ingebrigtsen ! * gnus.texi (Listing Groups): Fix. - Thu Jul 18 00:05:03 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Various Various): Addition. - (Startup Files): Addition. - - Wed Jul 17 02:03:39 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Score Commands): Fixed key def. - (Summary Score Commands): Fix. - - Thu Jul 4 05:45:32 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Article Hiding): Addition. - - Wed Jul 3 03:07:08 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Followups To Yourself): Deletia. - - Wed Jun 19 16:30:55 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Censorship): Removed. - - Wed Jun 19 15:03:35 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Group Levels): Addition. - - Sun Jun 16 08:13:44 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Saving Articles): Fix. - - Sat Jun 15 02:09:46 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Article Washing): Addition. - - Fri Jun 14 04:51:17 1996 Lars Magne Ingebrigtsen - - * message.texi: Changed name. - - * gnus.texi: Changed name. - - Wed Jun 12 22:44:25 1996 Lars Magne Ingebrigtsen - - * message.texi (Message Buffers): Addition. - (Message Buffers): Addition. - - Wed Jun 12 19:32:44 1996 Lars Magne Ingebrigtsen - - * gnus.texi: Deletia. - - Mon Jun 10 03:21:04 1996 Lars Magne Ingebrigtsen - - * message.texi (Various Message Variables): Addition. - - Sun Jun 9 23:36:12 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Composing Messages): Reference Message. - - Sun Jun 9 05:43:26 1996 Lars Magne Ingebrigtsen - - * Makefile (all): Don't make refcard by default. - - * gnus.texi (Canceling and Superseding): Delatia. - - Wed Jun 5 20:25:17 1996 Lars Magne Ingebrigtsen - - * message.texi (Message Buffers): Add menu entry. - - Wed Jun 5 09:38:28 1996 Lars Magne Ingebrigtsen - - * message.texi (News Headers): Addition. - - Mon Jun 3 07:37:34 1996 Lars Magne Ingebrigtsen - - * gnus.texi (History): Change. - - * message.texi (Wide Reply): Addition. - - Fri May 31 08:58:16 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Mail and Post Commands): Removed. - (Archived Messages): Addition. - - Fri May 31 03:07:47 1996 Lars Magne Ingebrigtsen - - * message.texi (Message Headers): Typo. - - Tue May 28 21:19:29 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Composing Messages): Deletia. - (Emacs/XEmacs code): New. - - Sun May 26 18:28:19 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Paging the Article): Moved. - - Fri May 24 17:19:58 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Buffer Format): Addition. - - Wed May 22 23:41:28 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Troubleshooting): Addition. - - Tue May 21 12:52:34 1996 Lars Magne Ingebrigtsen - - * gnus.texi: Excised message documentation. - - * message.texi (Various Message): New file. - - Sun May 19 17:54:23 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Mail Variables): Addition. - - Sat May 18 15:05:42 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Message Actions): New. - (Sorting): Separated to own node. - - Thu May 2 16:32:11 1996 Lars Magne Ingebrigtsen - - * gnus.texi: Added message indices. - - Wed Apr 24 23:41:21 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Archived Messages): Addition. - - Wed Apr 24 23:41:21 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Archived Messages): Addition. - - Wed Apr 17 19:10:17 1996 Lars Magne Ingebrigtsen - - * gnus.texi (posting): Update to use message. - - Sat Apr 13 13:53:34 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Writing New Backends): New node. - (Declaring Backends): New node. - (An Example Backend): New node. - (Optional Backend Functions): Fix return values. - - Wed Apr 10 08:36:20 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Message): New chapter. - - Tue Apr 9 23:41:15 1996 Lars Magne Ingebrigtsen - - * gnus.texi (GroupLens): Moved. - - Tue Apr 9 06:50:30 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Contributors): Rewrite. - (Displaying Predictions): Further formatting. - - Tue Apr 9 00:17:33 1996 Brad Miller - - * gnus.texi (GroupLens): New section. - - Mon Apr 8 22:48:46 1996 Wes Hardaker - - * gnus.texi (Picons Pictures): New section. - - Sat Mar 9 07:00:48 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Fancy Mail Splitting): Addition. - - Sat Mar 9 00:32:23 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Buffer Lines): Change. - - Fri Mar 8 20:17:51 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Score Commands): Change. - - Wed Mar 6 21:18:04 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Topic Commands): Addition. - (Kill Files): Addition. - (Summary Maneuvering): Change. - (Summary Maneuvering): Addition. - (Saving Articles): Addition. - - Mon Mar 4 23:16:56 1996 Lars Ingebrigtsen - - * gnus.texi (Compilation ): Change. - - Sun Mar 3 21:56:46 1996 Lars Ingebrigtsen - - * gnus.texi (NNTP): Addition. - (Post): Addition. - - Fri Mar 1 20:52:50 1996 Lars Ingebrigtsen - - * gnus.texi (Customizing Threading): Change. - - Wed Feb 28 04:54:41 1996 Lars Ingebrigtsen - - * gnus.texi (Slow Terminal Connection): Addition. - - Sat Mar 9 07:00:48 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Fancy Mail Splitting): Addition. - - Sat Mar 9 00:32:23 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Buffer Lines): Change. - - Fri Mar 8 20:17:51 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Score Commands): Change. - - Wed Mar 6 21:18:04 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Topic Commands): Addition. - (Kill Files): Addition. - (Summary Maneuvering): Change. - (Summary Maneuvering): Addition. - (Saving Articles): Addition. - - Mon Mar 4 23:16:56 1996 Lars Ingebrigtsen - - * gnus.texi (Compilation ): Change. - - Sun Mar 3 21:56:46 1996 Lars Ingebrigtsen - - * gnus.texi (NNTP): Addition. - (Post): Addition. - - Fri Mar 1 20:52:50 1996 Lars Ingebrigtsen - - * gnus.texi (Customizing Threading): Change. - - Wed Feb 28 04:54:41 1996 Lars Ingebrigtsen - - * gnus.texi (Slow Terminal Connection): Addition. - - Sat Feb 24 01:11:40 1996 Mark Borges - - * gnus.texi: Typo fixes. - - Thu Feb 22 18:44:29 1996 Lars Ingebrigtsen - - * gnus.texi (Choosing Articles): Addition. - - Mon Feb 19 00:17:01 1996 Lars Ingebrigtsen - - * gnus.texi (NoCeM): New. - - Fri Feb 16 12:05:05 1996 Lars Ingebrigtsen - - * gnus.texi (Creating a Virtual Server): New. - - Tue Feb 13 09:37:03 1996 Lars Ingebrigtsen - - * gnus.texi: Added documentation on all missing variables, and - added index entries for all functions, variables and keystrokes. - Moved sections around some more. - - Mon Feb 12 11:56:13 1996 Lars Ingebrigtsen - - * gnus.texi: Rearranged and proof-read some. - - Sun Feb 11 13:56:33 1996 Lars Ingebrigtsen - - * gnus.texi (Mail and Post): Addition. - - Sun Feb 11 04:39:52 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Censorship): New. - - Thu Feb 8 17:34:33 1996 Lars Ingebrigtsen - - * gnus.texi (Topic Commands): Addition. - - Mon Feb 5 05:24:01 1996 Lars Ingebrigtsen - - * gnus.texi (Article Washing): Addition. - - Fri Feb 2 20:41:56 1996 Lars Ingebrigtsen - - * gnus.texi (Reading Mail): Addition. - - Wed Jan 31 20:20:43 1996 Lars Ingebrigtsen - - * gnus.texi (Mail): Addition. - - Sat Jan 27 21:13:34 1996 Lars Ingebrigtsen - - * gnus.texi (Topic Variables): Deletia. - - Fri Jan 26 13:50:23 1996 Lars Ingebrigtsen - - * gnus.texi (Customizing Threading): Addition. - (Topic Commands): Addition. - (Topic Variables): Addition. - - Thu Jan 25 18:35:12 1996 Lars Ingebrigtsen - - * gnus.texi (Summary Maneuvering): Addition. - (Mail & Procmail): Addition. - - Tue Jan 23 00:59:48 1996 Lars Ingebrigtsen - - * gnus.texi (Drafts): Addition. - (Group Buffer Format): Addition. - (nndoc): Addition. - (Score File Editing): Addition. - (Drafts): Addition. - - Mon Jan 22 01:17:42 1996 Lars Ingebrigtsen - - * gnus.texi (Expiring Old Mail Articles): Addition. - - Sat Jan 20 01:44:32 1996 Lars Ingebrigtsen - - * gnus.texi (Article Hiding): Addition. - (Group Buffer Format): Addition. - (Article Hiding): Addition. - (Customizing Threading): Addition. - (Marking Groups): Addition. - (Thread Commands): Addition. - - Wed Jan 17 02:26:15 1996 Lars Ingebrigtsen - - * gnus.texi (Group Maintenance): Addition. - (Setting Process Marks): Addition. - (Reading Mail): Addition. - (Mail & Post): Change. - (Post): Addition. - (Listing Groups): Addition. - (Mail): Addition. - (Emacsen): Change. - - 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. - - Tue Dec 19 00:26:02 1995 Lars Ingebrigtsen - - * gnus.texi (Article Hiding): Addition. - (Drafts): Change. - - Sun Dec 17 23:29:01 1995 Lars Ingebrigtsen - - * gnus.texi (Summary Score Commands): Addition. - (Mail Group Commands): Adiition. - (Article Hiding): Addition. - - Sun Dec 17 17:38:20 1995 Lars Magne Ingebrigtsen - - * gnus.texi (Windows Configuration): Addition. - - Sun Dec 17 00:50:00 1995 Lars Ingebrigtsen - - * gnus.texi (Thread Commands): Addition. - (Post): Addition. - (Followups To Yourself): New. - - Sat Dec 16 23:33:49 1995 Lars Ingebrigtsen - - * gnus.texi (Group Parameters): Addition. - - Sat Dec 16 16:54:42 1995 Lars Magne Ingebrigtsen - - * gnus.texi (Ranges): Change. - - Fri Dec 15 13:53:02 1995 Lars Ingebrigtsen - - * gnus.texi (Windows Configuration): Addition, change. - - Thu Dec 14 17:57:19 1995 Lars Ingebrigtsen - - * gnus.texi (Group Parameters): Addition. - (Other Decode Variables): Addition. - - Wed Dec 13 16:13:56 1995 Lars Ingebrigtsen - - * gnus.texi (Selecting a Group): Addition. - (Saving Articles): Addition. - (Score File Format): Addition. - - Tue Dec 12 11:04:14 1995 Lars Ingebrigtsen - - * gnus.texi (Other Marks): Addition; change. - (Exiting the Summary Buffer): Addition. - (Hiding Headers): Addition. - (Score File Format): Addition. - (Article Caching): Addition. - (Misc Group Stuff): Addition. - - Mon Dec 11 09:52:34 1995 Lars Ingebrigtsen - - * gnus.texi (Persistent Articles): New. - (Other Marks): Addition. - (Topic Variables): Deletia. - (New Groups): Addition. - (Subscription Commands): Addition. - (Selecting a Group): Addition. - (Viewing Files): Addition. - (Group Levels): Addition. - - Sun Dec 10 13:51:16 1995 Lars Ingebrigtsen - - * gnus.texi (The Active File): Change. - - Sat Dec 9 16:55:29 1995 Lars Ingebrigtsen - - * gnus.texi (nndoc): Change. - - Fri Dec 8 06:25:29 1995 Lars Ingebrigtsen - - * gnus.texi (Group Buffer Format): Addition. - (Expiring Old Mail Articles): Addition. - (Listing Groups): Addition. - (Group Parameters): Addition. - - Mon Dec 4 05:09:28 1995 Lars Ingebrigtsen - - * gnus.texi (Mail): Addition. - - Sun Dec 3 00:34:35 1995 Lars Magne Ingebrigtsen - - * gnus.texi (Topic Commands): Addition. - - Sat Dec 2 00:53:15 1995 Lars Ingebrigtsen - - * gnus.texi (Topic Commands): Addition. - - Fri Dec 1 02:24:59 1995 Lars Ingebrigtsen - - * gnus.texi (Mail): Addition. - - Wed Nov 29 17:31:53 1995 Lars Ingebrigtsen - - * gnus.texi (Mail): Addition. - - Fri Nov 24 13:38:25 1995 Lars Ingebrigtsen - - * gnus.texi (Formatting Variables): Addition. - - Thu Nov 23 10:37:59 1995 Lars Ingebrigtsen - - * gnus.texi (Listing Groups): Addition. - (Process/Prefix): Addition. - (nndoc): Addition. - - Wed Nov 22 08:57:14 1995 Lars Ingebrigtsen - - * gnus.texi (Topic Commands): New. - (Topic Topology): New. - - Tue Nov 21 16:45:33 1995 Lars Ingebrigtsen - - * gnus.texi (Formatting Variables): New. - - Sat Nov 18 07:21:01 1995 Lars Ingebrigtsen - - * gnus.texi (Group Parameters): Addition. - - Mon Nov 13 00:14:30 1995 Lars Ingebrigtsen - - * gnus.texi (Various File Formats): New. - (Active File Format): New. - (Newsgroups File Format): New. - (nndoc): Addition. - (Group Score): New. - (SOUP Replies): New. - (nnsoup): New. - (SOUP Commands): New. - (@sc{soup}): New. - (Saving Articles): Addition. - - Sun Nov 12 13:17:53 1995 Lars Ingebrigtsen - - * gnus.texi (Various Summary Stuff): Addition. - (Score Variables): Addition. - (Process/Prefix): Addition. - (Selecting a Group): Change. - (Reading Mail): Addition. - - Thu Nov 9 21:30:44 1995 Lars Ingebrigtsen - - * gnus.texi (Posting Server): New. - (nnspool): Addition. - - Mon Nov 6 12:58:11 1995 Lars Ingebrigtsen - - * gnus.texi (Group Topics): Addition. - - Tue Oct 31 22:04:28 1995 Lars Ingebrigtsen - - * gnus.texi (Group Topics): Change. - - Mon Oct 30 19:40:54 1995 Lars Ingebrigtsen - - * gnus.texi (Score Variables): Addition. - - Thu Oct 26 14:56:41 1995 Lars Ingebrigtsen - - * gnus.texi (Limiting): Change. - - Mon Oct 16 12:47:13 1995 Lars Ingebrigtsen - - * gnus.texi (Listing Groups): Addition. - - Sun Oct 15 09:23:55 1995 Lars Ingebrigtsen - - * gnus.texi (Group Topics): Addition. - - Mon Oct 16 12:47:13 1995 Lars Ingebrigtsen - - * gnus.texi (Listing Groups): Addition. - - Sun Oct 15 09:23:55 1995 Lars Ingebrigtsen - - * gnus.texi (Group Topics): Addition. - - Sat Oct 14 13:23:19 1995 Lars Ingebrigtsen - - * gnus.texi (Posting Styles): New. - - Fri Oct 13 02:20:18 1995 Lars Ingebrigtsen - - * gnus.texi (Post): Fix. - - Thu Oct 5 11:58:39 1995 Lars Ingebrigtsen - - * gnus.texi (Compilation & Init File): New. - - Mon Oct 2 10:01:19 1995 Lars Ingebrigtsen - - * gnus.texi (Unavailable Servers): New. - (Article Backlog): New. - (Mail & Post): Addition. - (Saving Articles): Addition. - - Mon Sep 25 00:28:32 1995 Lars Ingebrigtsen - - * gnus.texi (Group Maintenance): Change. - (Group Topics): New. - - Sun Sep 24 02:48:58 1995 Lars Ingebrigtsen - - * gnus.texi (New Groups): Addition. - (Score Variables): Addition. - (Auto Save): Addition. - (Saving Articles): Addition. - (Saving Articles): Addition. - (Saving Articles): Addition. - (Summary Buffer Mode Line): Addition. - (Fetching a Group): New. - (Thread Commands): Addition. - (Article Buttons): New. - (Article Washing): Addition. - - Sat Sep 23 02:53:11 1995 Lars Ingebrigtsen - - * gnus.texi (Optional Backend Functions): Addition. - (Foreign Groups): Addition. - (Startup Files): Addition. - - Fri Sep 22 14:44:26 1995 Lars Ingebrigtsen - - * gnus.texi (Various Various): Addition. - - Thu Sep 21 13:55:16 1995 Lars Ingebrigtsen - - * gnus.texi (Article Washing): Change. - (Selecting a Group): Addition. - (Mail & Post): Change. - (Scoring): Made into a chapter. - - Wed Sep 20 16:14:11 1995 Lars Ingebrigtsen - - * gnus.texi (Drafts): New. - (Thread Commands): Addition. - (Rejected Articles): New. - - Tue Sep 19 00:30:15 1995 Lars Ingebrigtsen - - * gnus.texi (Mail): Addition. - (Mail Group Commands): Addition. - (Group Parameters): Addition. - (Summary Buffer Mode Line): Addition. - (Finding the Parent): Addition. - - Mon Sep 18 11:49:16 1995 Lars Ingebrigtsen - - * gnus.texi (Limiting): New. - (Slave Gnusii): New. - (Setting Process Marks): Addition. - (The Server is Down): Change. - (Article Treatment): New. - (Article Hiding): New. - (Article Washing): New. - (Article Date): New. - (Finding the News): Addition. - (Customizing Threading): Addition. --- 1,8 ---- ! Mon Jul 29 10:12:24 1996 Lars Magne Ingebrigtsen ! * gnus.texi (Misc Article): Addition. ! (Advanced Scoring Tips): New. ! (Advanced Scoring Example): New. ! (Advanced Scoring Syntax): New. ! (Advanced Scoring): New. *** pub/rgnus/GNUS-NEWS Tue Jul 30 22:59:34 1996 --- rgnus/GNUS-NEWS Tue Jul 30 18:43:01 1996 *************** *** 0 **** --- 1,14 ---- + ** Gnus changes. + + *** nntp.el has been totally rewritten in an asynchronous fashion. + + *** Article prefetching functionality has been moved up into + Gnus. + + *** Scoring can now be performed with logical operators like + `and', `or', `not', and parent redirection. + + *** Article washing status can be displayed in the + article mode line. + + *** gnus.el has been split into many smaller files.