Mercurial > emacs
changeset 19969:5f1ab3dd344d
*** empty log message ***
line wrap: on
line diff
--- a/lisp/gnus/gnus-art.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-art.el Wed Sep 24 01:50:24 1997 +0000 @@ -191,7 +191,7 @@ (lambda (spec) (list (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (car (cddr spec)))))) + 2 3 (intern (format "gnus-emphasis-%s" (caddr spec))))) types))) "Alist that says how to fontify certain phrases. Each item looks like this: @@ -397,6 +397,11 @@ :type 'hook :group 'gnus-article-various) +(defcustom gnus-article-hide-pgp-hook nil + "*A hook called after successfully hiding a PGP signature." + :type 'hook + :group 'gnus-article-various) + (defcustom gnus-article-button-face 'bold "Face used for highlighting buttons in the article buffer. @@ -413,9 +418,17 @@ :type 'face :group 'gnus-article-buttons) -(defcustom gnus-signature-face 'italic +(defcustom gnus-signature-face 'gnus-signature-face + "Face used for highlighting a signature in the article buffer. +Obsolete; use the face `gnus-signature-face' for customizations instead." + :type 'face + :group 'gnus-article-highlight + :group 'gnus-article-signature) + +(defface gnus-signature-face + '((((type x)) + (:italic t))) "Face used for highlighting a signature in the article buffer." - :type 'face :group 'gnus-article-highlight :group 'gnus-article-signature) @@ -569,20 +582,20 @@ (defun gnus-article-delete-text-of-type (type) "Delete text of TYPE in the current buffer." (save-excursion - (let ((e (point-min)) - b) - (while (setq b (text-property-any e (point-max) 'article-type type)) - (setq e (text-property-not-all b (point-max) 'article-type type)) - (delete-region b e))))) + (let ((b (point-min))) + (while (setq b (text-property-any b (point-max) 'article-type type)) + (delete-region + b (or (text-property-not-all b (point-max) 'article-type type) + (point-max))))))) (defun gnus-article-delete-invisible-text () "Delete all invisible text in the current buffer." (save-excursion - (let ((e (point-min)) - b) - (while (setq b (text-property-any e (point-max) 'invisible t)) - (setq e (text-property-not-all b (point-max) 'invisible t)) - (delete-region b e))))) + (let ((b (point-min))) + (while (setq b (text-property-any b (point-max) 'invisible t)) + (delete-region + b (or (text-property-not-all b (point-max) 'invisible t) + (point-max))))))) (defun gnus-article-text-type-exists-p (type) "Say whether any text of type TYPE exists in the buffer." @@ -828,33 +841,46 @@ (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)) + (while (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 - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (process-send-region "article-x-face" beg end) - (process-send-eof "article-x-face"))))))))) + (save-excursion + (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 + "article-x-face" nil shell-file-name shell-command-switch + gnus-article-x-face-command)) + (process-send-region "article-x-face" beg end) + (process-send-eof "article-x-face")))))))))) + +(defun gnus-hack-decode-rfc1522 () + "Emergency hack function for avoiding problems when decoding." + (let ((buffer-read-only nil)) + (goto-char (point-min)) + ;; Remove encoded TABs. + (while (search-forward "=09" nil t) + (replace-match " " t t)) + ;; Remove encoded newlines. + (goto-char (point-min)) + (while (search-forward "=10" nil t) + (replace-match " " t t)))) (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) @@ -937,27 +963,28 @@ ;; Hide the "header". (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) (gnus-article-hide-text-type (1+ (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))) - (gnus-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) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pgp)) - (widen)))))) + (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))) + (gnus-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) + (gnus-article-hide-text-type + (match-beginning 0) (match-end 0) 'pgp)) + (widen)) + (run-hooks 'gnus-article-hide-pgp-hook)))))) (defun article-hide-pem (&optional arg) "Toggle hiding of any PEM headers and signatures in the current article. @@ -1101,7 +1128,8 @@ nil))) (eval-and-compile - (autoload 'w3-parse-buffer "w3-parse")) + (autoload 'w3-display "w3-parse") + (autoload 'w3-do-setup "w3" "" t)) (defun gnus-article-treat-html () "Render HTML." @@ -1109,6 +1137,7 @@ (let ((cbuf (current-buffer))) (set-buffer gnus-article-buffer) (let (buf buffer-read-only b e) + (w3-do-setup) (goto-char (point-min)) (narrow-to-region (if (search-forward "\n\n" nil t) @@ -1117,12 +1146,13 @@ (setq e (point-max))) (nnheader-temp-write nil (insert-buffer-substring gnus-article-buffer b e) + (require 'url) (save-window-excursion - (setq buf (car (w3-parse-buffer (current-buffer)))))) + (w3-region (point-min) (point-max)) + (setq buf (buffer-substring-no-properties (point-min) (point-max))))) (when buf (delete-region (point-min) (point-max)) - (insert-buffer-substring buf) - (kill-buffer buf)) + (insert buf)) (widen) (goto-char (point-min)) (set-window-start (get-buffer-window (current-buffer)) (point-min)) @@ -1391,7 +1421,7 @@ (gnus-article-hide-headers 1 t))) (save-window-excursion (if (not gnus-default-article-saver) - (error "No default saver is defined.") + (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. @@ -1452,7 +1482,8 @@ default-name)) ;; A single split name was found ((= 1 (length split-name)) - (let* ((name (car split-name)) + (let* ((name (expand-file-name + (car split-name) gnus-article-save-directory)) (dir (cond ((file-directory-p name) (file-name-as-directory name)) ((file-exists-p name) name) @@ -1718,34 +1749,33 @@ (put 'gnus-article-mode 'mode-class 'special) -(when t - (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 - "e" gnus-article-edit - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug +(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 + "e" gnus-article-edit + "<" beginning-of-buffer + ">" end-of-buffer + "\C-c\C-i" gnus-info-find-node + "\C-c\C-b" gnus-bug - "\C-d" gnus-article-read-summary-keys - "\M-*" gnus-article-read-summary-keys - "\M-#" gnus-article-read-summary-keys - "\M-^" gnus-article-read-summary-keys - "\M-g" gnus-article-read-summary-keys) + "\C-d" gnus-article-read-summary-keys + "\M-*" gnus-article-read-summary-keys + "\M-#" gnus-article-read-summary-keys + "\M-^" gnus-article-read-summary-keys + "\M-g" gnus-article-read-summary-keys) - (substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) +(substitute-key-definition + 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) (defun gnus-article-make-menu-bar () (gnus-turn-off-edit-menu 'article) @@ -2032,7 +2062,8 @@ ;; save it to file. (goto-char (point-max)) (insert "\n") - (append-to-file (point-min) (point-max) file-name)))) + (append-to-file (point-min) (point-max) file-name) + t))) (defun gnus-narrow-to-page (&optional arg) "Narrow the article buffer to a page. @@ -2151,6 +2182,7 @@ (interactive) (if (not (gnus-buffer-live-p gnus-summary-buffer)) (error "There is no summary buffer for this article buffer") + (gnus-article-set-globals) (gnus-configure-windows 'article) (gnus-summary-goto-subject gnus-current-article))) @@ -2442,7 +2474,7 @@ (interactive "P") (when (and (not force) (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing.")) + (error "The current newsgroup does not support article editing")) (gnus-article-edit-article `(lambda () (gnus-summary-edit-article-done @@ -2454,7 +2486,7 @@ (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) (gnus-article-edit-mode) - (set-text-properties (point-min) (point-max) nil) + (gnus-set-text-properties (point-min) (point-max) nil) (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) @@ -2532,14 +2564,14 @@ (defcustom gnus-button-alist `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t gnus-button-message-id 2) - ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*+\\)" 0 t gnus-button-message-id 1) + ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1) ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t gnus-button-fetch-group 4) ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2) ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) - ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 1) - ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2) + ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2) + ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... ("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1) ;; Raw URLs. @@ -2572,6 +2604,7 @@ ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 0 t gnus-button-mailto 0) ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) + ("^Subject:" ,gnus-button-url-regexp 0 t gnus-button-url 0) ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t gnus-button-message-id 3)) @@ -2846,6 +2879,11 @@ ;;; Internal functions: +(defun gnus-article-set-globals () + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-set-global-variables))) + (defun gnus-signature-toggle (end) (save-excursion (set-buffer gnus-article-buffer)
--- a/lisp/gnus/gnus-cache.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-cache.el Wed Sep 24 01:50:24 1997 +0000 @@ -146,7 +146,8 @@ (mail-header-set-number headers (cdr result)))) (let ((number (mail-header-number headers)) file dir) - (when (and (> number 0) ; Reffed article. + (when (and number + (> number 0) ; Reffed article. (or force (and (or (not gnus-uncacheable-groups) (not (string-match @@ -256,15 +257,13 @@ (defun gnus-cache-possibly-alter-active (group active) "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when (equal group "no.norsk") (error "hie")) (when gnus-cache-active-hashtb (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (and cache-active - (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (and cache-active - (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active)))))) + (when cache-active + (when (< (car cache-active) (car active)) + (setcar active (car cache-active))) + (when (> (cdr cache-active) (cdr active)) + (setcdr active (cdr cache-active))))))) (defun gnus-cache-retrieve-headers (articles group &optional fetch-old) "Retrieve the headers for ARTICLES in GROUP." @@ -453,13 +452,20 @@ (defun gnus-cache-articles-in-group (group) "Return a sorted list of cached articles in GROUP." - (let ((dir (file-name-directory (gnus-cache-file-name group 1)))) + (let ((dir (file-name-directory (gnus-cache-file-name group 1))) + articles) (when (file-exists-p dir) - (sort (mapcar (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)) - '<)))) + (setq articles + (sort (mapcar (lambda (name) (string-to-int name)) + (directory-files dir nil "^[0-9]+$" t)) + '<)) + ;; Update the cache active file, just to synch more. + (when articles + (gnus-cache-update-active group (car articles) t) + (gnus-cache-update-active group (car (last articles)))) + articles))) -(defun gnus-cache-braid-nov (group cached) +(defun gnus-cache-braid-nov (group cached &optional file) (let ((cache-buf (get-buffer-create " *gnus-cache*")) beg end) (gnus-cache-save-buffers) @@ -467,7 +473,7 @@ (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents (gnus-cache-file-name group ".overview")) + (insert-file-contents (or file (gnus-cache-file-name group ".overview"))) (goto-char (point-min)) (insert "\n") (goto-char (point-min))) @@ -540,22 +546,21 @@ (gnus) ;; Go through all groups... (gnus-group-mark-buffer) - (gnus-group-universal-argument - nil nil - (lambda () - (interactive) - (gnus-summary-read-group (gnus-group-group-name) nil t) - ;; ... and enter the articles into the cache. - (when (eq major-mode 'gnus-summary-mode) - (gnus-uu-mark-buffer) - (gnus-cache-enter-article) - (kill-buffer (current-buffer))))))) + (gnus-group-iterate nil + (lambda (group) + (let (gnus-auto-select-next) + (gnus-summary-read-group group nil t) + ;; ... and enter the articles into the cache. + (when (eq major-mode 'gnus-summary-mode) + (gnus-uu-mark-buffer) + (gnus-cache-enter-article) + (kill-buffer (current-buffer)))))))) (defun gnus-cache-read-active (&optional force) "Read the cache active file." (gnus-make-directory gnus-cache-directory) - (if (not (and (file-exists-p gnus-cache-active-file) - (or force (not gnus-cache-active-hashtb)))) + (if (or (not (file-exists-p gnus-cache-active-file)) + force) ;; There is no active file, so we generate one. (gnus-cache-generate-active) ;; We simply read the active file. @@ -651,7 +656,7 @@ (defun gnus-cache-move-cache (dir) "Move the cache tree to somewhere else." - (interactive "DMove the cache tree to: ") + (interactive "FMove the cache tree to: ") (rename-file gnus-cache-directory dir)) (provide 'gnus-cache)
--- a/lisp/gnus/gnus-cite.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-cite.el Wed Sep 24 01:50:24 1997 +0000 @@ -100,13 +100,14 @@ :group 'gnus-cite :type 'integer) -(defcustom gnus-cite-attribution-prefix "in article\\|in <" +(defcustom gnus-cite-attribution-prefix + "in article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)," "Regexp matching the beginning of an attribution line." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-attribution-suffix - "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$" + "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ ]*$" "Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite @@ -439,7 +440,8 @@ (setq gnus-cite-prefix-alist nil gnus-cite-attribution-alist nil gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil))))) + gnus-cite-loose-attribution-alist nil + gnus-cite-article nil))))) (defun gnus-article-hide-citation (&optional arg force) "Toggle hiding of all cited text except attribution lines.
--- a/lisp/gnus/gnus-demon.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-demon.el Wed Sep 24 01:50:24 1997 +0000 @@ -152,21 +152,35 @@ "Find out how many seconds to TIME, which is on the form \"17:43\"." (if (not (stringp time)) time - (let* ((date (current-time-string)) - (dv (timezone-parse-date date)) - (tdate (timezone-make-arpa-date - (string-to-number (aref dv 0)) - (string-to-number (aref dv 1)) - (string-to-number (aref dv 2)) time - (or (aref dv 4) "UT"))) - (nseconds (gnus-time-minus - (gnus-encode-date tdate) (gnus-encode-date date)))) - (round - (/ (+ (if (< (car nseconds) 0) - 86400 0) - (* 65536 (car nseconds)) - (nth 1 nseconds)) - gnus-demon-timestep))))) + (let* ((now (current-time)) + ;; obtain NOW as discrete components -- make a vector for speed + (nowParts (apply 'vector (decode-time now))) + ;; obtain THEN as discrete components + (thenParts (timezone-parse-time time)) + (thenHour (string-to-int (elt thenParts 0))) + (thenMin (string-to-int (elt thenParts 1))) + ;; convert time as elements into number of seconds since EPOCH. + (then (encode-time 0 + thenMin + thenHour + ;; If THEN is earlier than NOW, make it + ;; same time tomorrow. Doc for encode-time + ;; says that this is OK. + (+ (elt nowParts 3) + (if (or (< thenHour (elt nowParts 2)) + (and (= thenHour (elt nowParts 2)) + (<= thenMin (elt nowParts 1)))) + 1 0)) + (elt nowParts 4) + (elt nowParts 5) + (elt nowParts 6) + (elt nowParts 7) + (elt nowParts 8))) + ;; calculate number of seconds between NOW and THEN + (diff (+ (* 65536 (- (car then) (car now))) + (- (cadr then) (cadr now))))) + ;; return number of timesteps in the number of seconds + (round (/ diff gnus-demon-timestep))))) (defun gnus-demon () "The Gnus daemon that takes care of running all Gnus handlers." @@ -202,7 +216,7 @@ (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle. ;; So we call the handler. (progn - (funcall (car handler)) + (ignore-errors (funcall (car handler))) ;; And reset the timer. (setcar (nthcdr 1 handler) (gnus-demon-time-to-step @@ -211,24 +225,26 @@ ((null (setq idle (nth 2 handler))) ;; We do nothing. ) - ((not (numberp idle)) + ((and (not (numberp idle)) + (gnus-demon-is-idle-p)) ;; We want to call this handler each and every time that ;; Emacs is idle. - (funcall (car handler))) + (ignore-errors (funcall (car handler)))) (t ;; We want to call this handler only if Emacs has been idle ;; for a specified number of timesteps. (and (not (memq (car handler) gnus-demon-idle-has-been-called)) (< idle gnus-demon-idle-time) + (gnus-demon-is-idle-p) (progn - (funcall (car handler)) + (ignore-errors (funcall (car handler))) ;; Make sure the handler won't be called once more in ;; this idle-cycle. (push (car handler) gnus-demon-idle-has-been-called))))))))) (defun gnus-demon-add-nocem () "Add daemonic NoCeM handling to Gnus." - (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t)) + (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30)) (defun gnus-demon-scan-nocem () "Scan NoCeM groups for NoCeM messages."
--- a/lisp/gnus/gnus-ems.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-ems.el Wed Sep 24 01:50:24 1997 +0000 @@ -34,11 +34,16 @@ (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-2 [down-mouse-2]) +(defvar gnus-mode-line-modified + (if (or gnus-xemacs + (< emacs-major-version 20)) + '("--**-" . "-----") + '("**" "--"))) (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt.el")) + (autoload 'appt-select-lowest-window "appt")) (or (fboundp 'mail-file-babyl-p) (fset 'mail-file-babyl-p 'rmail-file-p)) @@ -70,18 +75,15 @@ (truncate-string valstr (, max-width)) valstr)))) +(defun gnus-encode-coding-string (string system) + string) + (eval-and-compile (if (string-match "XEmacs\\|Lucid" emacs-version) nil (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions.") - - (defvar gnus-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.")) + "Property used for highlighting mouse regions.")) (cond ((string-match "XEmacs\\|Lucid" emacs-version) @@ -171,6 +173,7 @@ (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) (fset 'gnus-max-width-function 'gnus-mule-max-width-function) (fset 'gnus-summary-set-display-table 'ignore) + (fset 'gnus-encode-coding-string 'encode-coding-string) (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting @@ -203,6 +206,15 @@ (boundp 'mark-active) mark-active)) +(defun gnus-add-minor-mode (mode name map) + (if (fboundp 'add-minor-mode) + (add-minor-mode mode name map) + (unless (assq mode minor-mode-alist) + (push `(,mode ,name) minor-mode-alist)) + (unless (assq mode minor-mode-map-alist) + (push (cons mode map) + minor-mode-map-alist)))) + (provide 'gnus-ems) ;; Local Variables:
--- a/lisp/gnus/gnus-gl.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-gl.el Wed Sep 24 01:50:24 1997 +0000 @@ -851,11 +851,8 @@ (when (and menu-bar-mode (gnus-visual-p 'grouplens-menu 'menu)) (gnus-grouplens-make-menu-bar)) - (unless (assq 'gnus-grouplens-mode minor-mode-alist) - (push '(gnus-grouplens-mode " GroupLens") minor-mode-alist)) - (unless (assq 'gnus-grouplens-mode minor-mode-map-alist) - (push (cons 'gnus-grouplens-mode gnus-grouplens-mode-map) - minor-mode-map-alist)) + (gnus-add-minor-mode + 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map) (run-hooks 'gnus-grouplens-mode-hook)))) (provide 'gnus-gl)
--- a/lisp/gnus/gnus-group.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-group.el Wed Sep 24 01:50:24 1997 +0000 @@ -84,8 +84,10 @@ (defcustom 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." +This means that they will still be listed even when there are no +unread articles in the groups. + +If nil, no groups are permanently visible." :group 'gnus-group-listing :type '(choice regexp (const nil))) @@ -446,7 +448,7 @@ "r" gnus-group-read-init-file "B" gnus-group-browse-foreign-server "b" gnus-group-check-bogus-groups - "F" gnus-find-new-newsgroups + "F" gnus-group-find-new-groups "\C-c\C-d" gnus-group-describe-group "\M-d" gnus-group-describe-all-groups "\C-c\C-a" gnus-group-apropos @@ -485,7 +487,7 @@ "m" gnus-group-mark-group "u" gnus-group-unmark-group "w" gnus-group-mark-region - "m" gnus-group-mark-buffer + "b" gnus-group-mark-buffer "r" gnus-group-mark-regexp "U" gnus-group-unmark-all-groups) @@ -604,8 +606,7 @@ (gnus-group-group-name)] ["Info" gnus-group-edit-group (gnus-group-group-name)] ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] - ["Global kill file" gnus-group-edit-global-kill t]) - )) + ["Global kill file" gnus-group-edit-global-kill t]))) (easy-menu-define gnus-group-group-menu gnus-group-mode-map "" @@ -692,11 +693,10 @@ ["First unread group" gnus-group-first-unread-group t] ["Best unread group" gnus-group-best-unread-group t]) ["Delete bogus groups" gnus-group-check-bogus-groups t] - ["Find new newsgroups" gnus-find-new-newsgroups t] + ["Find new newsgroups" gnus-group-find-new-groups t] ["Transpose" gnus-group-transpose-groups (gnus-group-group-name)] - ["Read a directory as a group..." gnus-group-enter-directory t] - )) + ["Read a directory as a group..." gnus-group-enter-directory t])) (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" @@ -727,8 +727,7 @@ ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] ["Exit from Gnus" gnus-group-exit t] - ["Exit without saving" gnus-group-quit t] - )) + ["Exit without saving" gnus-group-quit t])) (run-hooks 'gnus-group-menu-hook))) @@ -1218,7 +1217,9 @@ (not (zerop (buffer-size)))))) (mode-string (eval gformat))) ;; Say whether the dribble buffer has been modified. - (setq mode-line-modified (if modified "**" "--")) + (setq mode-line-modified + (if modified (car gnus-mode-line-modified) + (cdr gnus-mode-line-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)))) @@ -1278,24 +1279,26 @@ (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) + (and + (get-text-property (point) 'gnus-group) + (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)) - (<= 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)))))))) + (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) @@ -1449,10 +1452,14 @@ FUNCTION will be called with the group name as the paremeter and with point over the group in question." (let ((groups (gnus-group-process-prefix arg)) + (window (selected-window)) group) (while (setq group (pop groups)) + (select-window window) (gnus-group-remove-mark group) - (funcall function group)))) + (save-selected-window + (save-excursion + (funcall function group)))))) (put 'gnus-group-iterate 'lisp-indent-function 1) @@ -1961,7 +1968,7 @@ (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups nil t) gnus-useful-groups))) - (list (cadr entry) (nth 2 entry)))) + (list (cadr entry) (caddr entry)))) (setq method (gnus-copy-sequence method)) (let (entry) (while (setq entry (memq (assq 'eval method) method)) @@ -2026,15 +2033,16 @@ (let* ((group (if solid (gnus-read-group "Group name: ") (message-unique-id))) + (default-type (or (car gnus-group-web-type-history) + (symbol-name (caar nnweb-type-definition)))) (type - (completing-read - "Search engine type: " - (mapcar (lambda (elem) (list (symbol-name (car elem)))) - nnweb-type-definition) - nil t (cons (or (car gnus-group-web-type-history) - (symbol-name (caar nnweb-type-definition))) - 0) - 'gnus-group-web-type-history)) + (gnus-string-or + (completing-read + (format "Search engine type (default %s): " default-type) + (mapcar (lambda (elem) (list (symbol-name (car elem)))) + nnweb-type-definition) + nil t nil 'gnus-group-web-type-history) + default-type)) (search (read-string "Search string: " @@ -2147,7 +2155,7 @@ (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. (when (gnus-gethash pgroup gnus-newsrc-hashtb) - (error "Group %s already exists." pgroup)) + (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) @@ -2878,7 +2886,7 @@ (gnus-group-list-groups (and (numberp arg) (max (car gnus-group-list-mode) arg))))) -(defun gnus-group-get-new-news-this-group (&optional n) +(defun gnus-group-get-new-news-this-group (&optional n dont-scan) "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." @@ -2892,7 +2900,7 @@ (gnus-group-remove-mark group) ;; Bypass any previous denials from the server. (gnus-remove-denial (gnus-find-method-for-group group)) - (if (gnus-activate-group group 'scan) + (if (gnus-activate-group group (if dont-scan nil 'scan)) (progn (gnus-get-unread-articles-in-group (gnus-get-info group) (gnus-active group) t) @@ -2917,11 +2925,11 @@ (interactive (list (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))))))) + (when current-prefix-arg + (completing-read + "Faq dir: " (and (listp gnus-group-faq-directory) + (mapcar (lambda (file) (list file)) + gnus-group-faq-directory)))))) (unless group (error "No group name given")) (let ((dirs (or faq-dir gnus-group-faq-directory)) @@ -3082,7 +3090,8 @@ (defun gnus-group-read-init-file () "Read the Gnus elisp init file." (interactive) - (gnus-read-init-file)) + (gnus-read-init-file) + (gnus-message 5 "Read %s" gnus-init-file)) (defun gnus-group-check-bogus-groups (&optional silent) "Check bogus newsgroups. @@ -3092,6 +3101,15 @@ (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) (gnus-group-list-groups)) +(defun gnus-group-find-new-groups (&optional arg) + "Search for new groups and add them. +Each new group will be treated with `gnus-subscribe-newsgroup-method.' +If ARG (the prefix), use the `ask-server' method to query +the server for new groups." + (interactive "P") + (gnus-find-new-newsgroups arg) + (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."
--- a/lisp/gnus/gnus-int.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-int.el Wed Sep 24 01:50:24 1997 +0000 @@ -377,7 +377,7 @@ last))) (defun gnus-request-replace-article (article group buffer) - (let ((func (car (gnus-find-method-for-group group)))) + (let ((func (car (gnus-group-name-to-method group)))) (funcall (intern (format "%s-request-replace-article" func)) article (gnus-group-real-name group) buffer)))
--- a/lisp/gnus/gnus-move.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-move.el Wed Sep 24 01:50:24 1997 +0000 @@ -61,15 +61,18 @@ "Move group INFO from FROM-SERVER to TO-SERVER." (let ((group (gnus-info-group info)) to-active hashtb type mark marks - to-article to-reads to-marks article) + to-article to-reads to-marks article + act-articles) (gnus-message 7 "Translating %s..." group) (when (gnus-request-group group nil to-server) (setq to-active (gnus-parse-active) - hashtb (gnus-make-hashtable 1024)) + hashtb (gnus-make-hashtable 1024) + act-articles (gnus-uncompress-range to-active)) ;; Fetch the headers from the `to-server'. (when (and to-active + act-articles (setq type (gnus-retrieve-headers - (gnus-uncompress-range to-active) + act-articles group to-server))) ;; Convert HEAD headers. I don't care. (when (eq type 'headers) @@ -127,7 +130,7 @@ ;; into the Gnus info format. (setq to-reads (gnus-range-add - (gnus-compress-sequence (sort to-reads '<) t) + (gnus-compress-sequence (and to-reads (sort to-reads '<)) t) (cons 1 (1- (car to-active))))) (gnus-info-set-read info to-reads) ;; Do the marks. I'm sure y'all understand what's @@ -144,7 +147,8 @@ (cons article (cdr a))))) (setq a lists) (while a - (setcdr (car a) (gnus-compress-sequence (sort (cdar a) '<))) + (setcdr (car a) (gnus-compress-sequence + (and (cdar a) (sort (cdar a) '<)))) (pop a)) (gnus-info-set-marks info lists t))))) (gnus-message 7 "Translating %s...done" group)))
--- a/lisp/gnus/gnus-msg.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-msg.el Wed Sep 24 01:50:24 1997 +0000 @@ -514,6 +514,7 @@ ;; Dummy to avoid byte-compile warning. (defvar nnspool-rejected-article-hook) +(defvar xemacs-codename) ;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might ;;; as well include the Emacs version as well. @@ -539,7 +540,9 @@ (substring emacs-version (match-beginning 3) (match-end 3)) - ""))) + "") + (if (boundp 'xemacs-codename) + (concat " - \"" xemacs-codename "\"")))) (t emacs-version)))) ;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>. @@ -693,6 +696,8 @@ (message-goto-subject) (re-search-forward " *$") (replace-match " (crosspost notification)" t t) + (when (fboundp 'deactivate-mark) + (deactivate-mark)) (when (gnus-y-or-n-p "Send this complaint? ") (message-send-and-exit)))))))
--- a/lisp/gnus/gnus-nocem.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-nocem.el Wed Sep 24 01:50:24 1997 +0000 @@ -45,13 +45,13 @@ :type '(repeat (string :tag "Group"))) (defcustom gnus-nocem-issuers - '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] - "rbraver@ohww.norman.ok.us" ; Robert Braver - "clewis@ferret.ocunix.on.ca;" ; Chris Lewis - "jem@xpat.com;" ; Despammer from Korea - "snowhare@xmission.com" ; Benjamin "Snowhare" Franz - "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM! - ) + '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] + "rbraver@ohww.norman.ok.us" ; Robert Braver + "clewis@ferret.ocunix.on.ca" ; Chris Lewis + "jem@xpat.com" ; Despammer from Korea + "snowhare@xmission.com" ; Benjamin "Snowhare" Franz + "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM! + ) "List of NoCeM issuers to pay attention to." :group 'gnus-nocem :type '(repeat string)) @@ -98,6 +98,23 @@ (defun gnus-nocem-cache-file () (concat (file-name-as-directory gnus-nocem-directory) "cache")) +;; +;; faster lookups for group names: +;; + +(defvar gnus-nocem-real-group-hashtb nil + "Real-name mappings of subscribed groups.") + +(defun gnus-fill-real-hashtb () + "Fill up a hash table with the real-name mappings from the user's +active file." + (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable + (length gnus-newsrc-alist))) + (mapcar (lambda (group) + (setq group (gnus-group-real-name (car group))) + (gnus-sethash group t gnus-nocem-real-group-hashtb)) + gnus-newsrc-alist)) + (defun gnus-nocem-scan-groups () "Scan all NoCeM groups for new NoCeM messages." (interactive) @@ -107,6 +124,8 @@ (gnus-make-directory gnus-nocem-directory) ;; Load any previous NoCeM headers. (gnus-nocem-load-cache) + ;; Get the group name mappings: + (gnus-fill-real-hashtb) ;; Read the active file if it hasn't been read yet. (and (file-exists-p (gnus-nocem-active-file)) (not gnus-nocem-active) @@ -187,6 +206,8 @@ (narrow-to-region b e) (setq issuer (mail-fetch-field "issuer")) (widen) + (or (member issuer gnus-nocem-issuers) + (message "invalid NoCeM issuer: %s" issuer)) (and (member issuer gnus-nocem-issuers) ; We like her.... (gnus-nocem-verify-issuer issuer) ; She is who she says she is... (gnus-nocem-enter-article) ; We gobble the message.. @@ -196,7 +217,8 @@ (defun gnus-nocem-verify-issuer (person) "Verify using PGP that the canceler is who she says she is." (if (fboundp gnus-nocem-verifyer) - (funcall gnus-nocem-verifyer) + (ignore-errors + (funcall gnus-nocem-verifyer)) ;; If we don't have Mailcrypt, then we use the message anyway. t)) @@ -223,7 +245,8 @@ ;; Make sure all entries in the hashtb are bound. (set group nil)) (t - (when (gnus-gethash (symbol-name group) gnus-newsrc-hashtb) + (when (gnus-gethash (gnus-group-real-name (symbol-name group)) + gnus-nocem-real-group-hashtb) ;; Valid group. (beginning-of-line) (while (= (following-char) ?\t) @@ -294,7 +317,8 @@ gnus-nocem-hashtb nil gnus-nocem-active nil gnus-nocem-touched-alist nil - gnus-nocem-seen-message-ids nil)) + gnus-nocem-seen-message-ids nil + gnus-nocem-real-group-hashtb nil)) (defun gnus-nocem-unwanted-article-p (id) "Say whether article ID in the current group is wanted."
--- a/lisp/gnus/gnus-range.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-range.el Wed Sep 24 01:50:24 1997 +0000 @@ -209,7 +209,7 @@ (setcar ranges (cons (car ranges) (cadr ranges))) (setcdr ranges (cddr ranges))) - (when (= (1+ (car ranges)) (car (cadr ranges))) + (when (= (1+ (car ranges)) (caadr ranges)) (setcar (cadr ranges) (car ranges)) (setcar ranges (cadr ranges)) (setcdr ranges (cddr ranges))))) @@ -218,8 +218,8 @@ (when (= (1+ (cdar ranges)) (cadr ranges)) (setcdr (car ranges) (cadr ranges)) (setcdr ranges (cddr ranges))) - (when (= (1+ (cdar ranges)) (car (cadr ranges))) - (setcdr (car ranges) (cdr (cadr ranges))) + (when (= (1+ (cdar ranges)) (caadr ranges)) + (setcdr (car ranges) (cdadr ranges)) (setcdr ranges (cddr ranges)))))) (setq ranges (cdr ranges))) out)))
--- a/lisp/gnus/gnus-salt.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-salt.el Wed Sep 24 01:50:24 1997 +0000 @@ -36,22 +36,32 @@ (defvar gnus-pick-mode nil "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") -(defvar gnus-pick-display-summary nil - "*Display summary while reading.") +(defcustom gnus-pick-display-summary nil + "*Display summary while reading." + :type 'boolean + :group 'gnus-summary-pick) -(defvar gnus-pick-mode-hook nil - "Hook run in summary pick mode buffers.") +(defcustom gnus-pick-mode-hook nil + "Hook run in summary pick mode buffers." + :type 'hook + :group 'gnus-summary-pick) -(defvar gnus-mark-unpicked-articles-as-read nil - "*If non-nil, mark all unpicked articles as read.") +(defcustom gnus-mark-unpicked-articles-as-read nil + "*If non-nil, mark all unpicked articles as read." + :type 'boolean + :group 'gnus-summary-pick) -(defvar gnus-pick-elegant-flow t - "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked.") +(defcustom gnus-pick-elegant-flow t + "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked." + :type 'boolean + :group 'gnus-summary-pick) -(defvar gnus-summary-pick-line-format +(defcustom gnus-summary-pick-line-format "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" "*The format specification of the lines in pick buffers. -It accepts the same format specs that `gnus-summary-line-format' does.") +It accepts the same format specs that `gnus-summary-line-format' does." + :type 'string + :group 'gnus-summary-pick) ;;; Internal variables. @@ -122,11 +132,7 @@ ;; Set up the menu. (when (gnus-visual-p 'pick-menu 'menu) (gnus-pick-make-menu-bar)) - (unless (assq 'gnus-pick-mode minor-mode-alist) - (push '(gnus-pick-mode " Pick") minor-mode-alist)) - (unless (assq 'gnus-pick-mode minor-mode-map-alist) - (push (cons 'gnus-pick-mode gnus-pick-mode-map) - minor-mode-map-alist)) + (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) (run-hooks 'gnus-pick-mode-hook)))) (defun gnus-pick-setup-message () @@ -160,7 +166,7 @@ (if gnus-pick-elegant-flow (progn (when (or catch-up gnus-mark-unpicked-articles-as-read) - (gnus-summary-limit-mark-excluded-as-read)) + (gnus-summary-catchup nil t)) (if (gnus-group-quit-config gnus-newsgroup-name) (gnus-summary-exit) (gnus-summary-next-group))) @@ -329,11 +335,7 @@ ;; Set up the menu. (when (gnus-visual-p 'binary-menu 'menu) (gnus-binary-make-menu-bar)) - (unless (assq 'gnus-binary-mode minor-mode-alist) - (push '(gnus-binary-mode " Binary") minor-mode-alist)) - (unless (assq 'gnus-binary-mode minor-mode-map-alist) - (push (cons 'gnus-binary-mode gnus-binary-mode-map) - minor-mode-map-alist)) + (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) (run-hooks 'gnus-binary-mode-hook)))) (defun gnus-binary-display-article (article &optional all-header) @@ -352,16 +354,22 @@ ;;; gnus-tree-mode ;;; -(defvar gnus-tree-line-format "%(%[%3,3n%]%)" - "Format of tree elements.") +(defcustom gnus-tree-line-format "%(%[%3,3n%]%)" + "Format of tree elements." + :type 'string + :group 'gnus-summary-tree) -(defvar gnus-tree-minimize-window t +(defcustom gnus-tree-minimize-window t "If non-nil, minimize the tree buffer window. If a number, never let the tree buffer grow taller than that number of -lines.") +lines." + :type 'boolean + :group 'gnus-summary-tree) -(defvar gnus-selected-tree-face 'modeline - "*Face used for highlighting selected articles in the thread tree.") +(defcustom gnus-selected-tree-face 'modeline + "*Face used for highlighting selected articles in the thread tree." + :type 'face + :group 'gnus-summary-tree) (defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) (?\{ . ?\}) (?< . ?>)) @@ -370,16 +378,24 @@ (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) "Characters used to connect parents with children.") -(defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z" - "*The format specification for the tree mode line.") +(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z" + "*The format specification for the tree mode line." + :type 'string + :group 'gnus-summary-tree) -(defvar gnus-generate-tree-function 'gnus-generate-vertical-tree +(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree "*Function for generating a thread tree. Two predefined functions are available: -`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.") +`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'." + :type '(radio (function-item gnus-generate-vertical-tree) + (function-item gnus-generate-horizontal-tree) + (function :tag "Other" nil)) + :group 'gnus-summary-tree) -(defvar gnus-tree-mode-hook nil - "*Hook run in tree mode buffers.") +(defcustom gnus-tree-mode-hook nil + "*Hook run in tree mode buffers." + :type 'hook + :group 'gnus-summary-tree) ;;; Internal variables. @@ -412,6 +428,7 @@ "\r" gnus-tree-select-article gnus-mouse-2 gnus-tree-pick-article "\C-?" gnus-tree-read-summary-keys + "h" gnus-tree-show-summary "\C-c\C-i" gnus-info-find-node) @@ -462,6 +479,14 @@ (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) (gnus-tree-minimize)))) +(defun gnus-tree-show-summary () + "Reconfigure windows to show summary buffer." + (interactive) + (if (not (gnus-buffer-live-p gnus-summary-buffer)) + (error "There is no summary buffer for this tree buffer") + (gnus-configure-windows 'article) + (gnus-summary-goto-subject gnus-current-article))) + (defun gnus-tree-select-article (article) "Select the article under point, if any." (interactive (list (gnus-tree-article-number))) @@ -648,7 +673,9 @@ "Generate a horizontal tree." (let* ((dummy (stringp (car thread))) (do (or dummy - (memq (mail-header-number (car thread)) gnus-tmp-limit))) + (and (car thread) + (memq (mail-header-number (car thread)) + gnus-tmp-limit)))) col beg) (if (not do) ;; We don't want this article. @@ -720,13 +747,12 @@ (delete-char -1) (insert (cadr gnus-tree-parent-child-edges)) (setq beg (point)) + (forward-char -1) ;; Draw "-" lines leftwards. - (while (progn - (unless (bolp) - (forward-char -2)) - (= (following-char) ? )) - (delete-char 1) - (insert (car gnus-tree-parent-child-edges))) + (while (= (char-after (1- (point))) ? ) + (delete-char -1) + (insert (car gnus-tree-parent-child-edges)) + (forward-char -1)) (goto-char beg) (gnus-tree-forward-line 1))) (setq dummyp nil) @@ -926,7 +952,7 @@ \\{gnus-carpal-mode-map}" (interactive) (kill-all-local-variables) - (setq mode-line-modified "-- ") + (setq mode-line-modified (cdr gnus-mode-line-modified)) (setq major-mode 'gnus-carpal-mode) (setq mode-name "Gnus Carpal") (setq mode-line-process nil)
--- a/lisp/gnus/gnus-score.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-score.el Wed Sep 24 01:50:24 1997 +0000 @@ -1,4 +1,4 @@ -;;; gnus-score.el --- scoring code for Gnus +1;;; gnus-score.el --- scoring code for Gnus ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <amanda@iesd.auc.dk> @@ -31,6 +31,7 @@ (require 'gnus) (require 'gnus-sum) (require 'gnus-range) +(require 'message) (defcustom gnus-global-score-files nil "List of global score files and directories. @@ -528,7 +529,8 @@ (gnus-score-kill-help-buffer) (unless (setq entry (assq (downcase hchar) char-to-header)) - (if mimic (error "%c %c" prefix hchar) (error ""))) + (if mimic (error "%c %c" prefix hchar) + (error "Illegal header type"))) (when (/= (downcase hchar) hchar) ;; This was a majuscule, so we end reading and set the defaults. @@ -536,36 +538,32 @@ (setq tchar (or tchar ?s) pchar (or pchar ?t))) - ;; We continue reading - the type. - (while (not tchar) - (if mimic - (progn - (sit-for 1) (message "%c %c-" prefix hchar)) - (message "%s header '%s' with match type (%s?): " - (if increase "Increase" "Lower") - (nth 1 entry) - (mapconcat (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - (char-to-string (car s)) - "")) - char-to-type ""))) - (setq tchar (read-char)) - (when (or (= tchar ??) (= tchar ?\C-h)) - (setq tchar nil) - (gnus-score-insert-help - "Match type" - (delq nil - (mapcar (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - s nil)) - char-to-type)) - 2))) + (let ((legal-types + (delq nil + (mapcar (lambda (s) + (if (eq (nth 4 entry) + (nth 3 s)) + s nil)) + char-to-type)))) + ;; We continue reading - the type. + (while (not tchar) + (if mimic + (progn + (sit-for 1) (message "%c %c-" prefix hchar)) + (message "%s header '%s' with match type (%s?): " + (if increase "Increase" "Lower") + (nth 1 entry) + (mapconcat (lambda (s) (char-to-string (car s))) + legal-types ""))) + (setq tchar (read-char)) + (when (or (= tchar ??) (= tchar ?\C-h)) + (setq tchar nil) + (gnus-score-insert-help "Match type" legal-types 2))) - (gnus-score-kill-help-buffer) - (unless (setq type (nth 1 (assq (downcase tchar) char-to-type))) - (if mimic (error "%c %c" prefix hchar) (error ""))) + (gnus-score-kill-help-buffer) + (unless (setq type (nth 1 (assq (downcase tchar) legal-types))) + (if mimic (error "%c %c" prefix hchar) + (error "Illegal match type")))) (when (/= (downcase tchar) tchar) ;; It was a majuscule, so we end reading and use the default. @@ -598,7 +596,7 @@ (error "You rang?")) (if mimic (error "%c %c %c %c" prefix hchar tchar pchar) - (error "")))) + (error "Illegal match duration")))) ;; Always kill the score help buffer. (gnus-score-kill-help-buffer)) @@ -1005,6 +1003,7 @@ (gnus-make-directory (file-name-directory file)) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) + (select-window (get-buffer-window gnus-score-edit-buffer)) (gnus-score-mode) (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) @@ -1086,11 +1085,11 @@ (decay (car (gnus-score-get 'decay alist))) (eval (car (gnus-score-get 'eval alist)))) ;; Perform possible decays. - (when (and gnus-decay-scores - (gnus-decay-scores - alist (or decay (gnus-time-to-day (current-time))))) - (gnus-score-set 'touched '(t) alist) - (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))) + (when gnus-decay-scores + (when (or (not decay) + (gnus-decay-scores alist decay)) + (gnus-score-set 'touched '(t) alist) + (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))) ;; We do not respect eval and files atoms from global score ;; files. (and files (not global) @@ -1280,8 +1279,7 @@ (erase-buffer) (let (emacs-lisp-mode-hook) (if (string-match - (concat (regexp-quote gnus-adaptive-file-suffix) - "$") + (concat (regexp-quote gnus-adaptive-file-suffix) "$") file) ;; This is an adaptive score file, so we do not run ;; it through `pp'. These files can get huge, and @@ -1364,6 +1362,7 @@ (save-excursion (set-buffer (get-buffer-create "*Headers*")) (buffer-disable-undo (current-buffer)) + (message-clone-locals gnus-summary-buffer) ;; Set the global variant of this variable. (setq gnus-current-score-file current-score-file) @@ -2201,7 +2200,9 @@ (gnus-add-current-to-buffer-list) (while trace (insert (format "%S -> %s\n" (cdar trace) - (file-name-nondirectory (caar trace)))) + (if (caar trace) + (file-name-nondirectory (caar trace)) + "(non-file rule)"))) (setq trace (cdr trace))) (goto-char (point-min)) (gnus-configure-windows 'score-trace))) @@ -2457,8 +2458,8 @@ (if (looking-at "not.") (progn (setq not-match t) - (setq regexp (concat "^" (buffer-substring 5 (point-max))))) - (setq regexp (concat "^" (buffer-substring 1 (point-max)))) + (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$"))) + (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$")) (setq not-match nil)) ;; Finally - if this resulting regexp matches the group name, ;; we add this score file to the list of score files @@ -2730,11 +2731,11 @@ ;;; (defun gnus-decay-score (score) - "Decay SCORE." + "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." (floor (- score - (* (if (< score 0) 1 -1) - (min score + (* (if (< score 0) -1 1) + (min (abs score) (max gnus-score-decay-constant (* (abs score) gnus-score-decay-scale))))))) @@ -2750,11 +2751,13 @@ (while (setq kill (pop entry)) (when (nth 2 kill) (setq updated t) - (setq score (or (car kill) gnus-score-interactive-default-score) + (setq score (or (nth 1 kill) + gnus-score-interactive-default-score) n times) (while (natnump (decf n)) (setq score (funcall gnus-decay-score-function score))) - (setcar kill score)))))) + (setcdr kill (cons score + (cdr (cdr kill))))))))) ;; Return whether this score file needs to be saved. By Je-haysuss! updated))
--- a/lisp/gnus/gnus-soup.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-soup.el Wed Sep 24 01:50:24 1997 +0000 @@ -358,7 +358,7 @@ (call-process shell-file-name nil nil nil shell-command-switch (concat "cd " dir " ; rm " files)) (gnus-message 4 "Packing...done" packer)) - (error "Couldn't pack packet.")))) + (error "Couldn't pack packet")))) (defun gnus-soup-parse-areas (file) "Parse soup area file FILE. @@ -523,7 +523,7 @@ (goto-char (point-min)) (while (not (eobp)) (unless (looking-at "#! *rnews +\\([0-9]+\\)") - (error "Bad header.")) + (error "Bad header")) (forward-line 1) (setq beg (point) end (+ (point) (string-to-int
--- a/lisp/gnus/gnus-srvr.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-srvr.el Wed Sep 24 01:50:24 1997 +0000 @@ -505,6 +505,7 @@ "n" gnus-browse-next-group "p" gnus-browse-prev-group "\177" gnus-browse-prev-group + [delete] gnus-browse-prev-group "N" gnus-browse-next-group "P" gnus-browse-prev-group "\M-n" gnus-browse-next-group @@ -552,7 +553,8 @@ (cond ((not (gnus-check-server method)) (gnus-message - 1 "Unable to contact server: %s" (gnus-status-message method)) + 1 "Unable to contact server %s: %s" (nth 1 method) + (gnus-status-message method)) nil) ((not (prog2 @@ -663,7 +665,7 @@ "(Un)subscribe to the next ARG groups." (interactive "p") (when (eobp) - (error "No group at current line.")) + (error "No group at current line")) (let ((ward (if (< arg 0) -1 1)) (arg (abs arg))) (while (and (> arg 0) @@ -695,7 +697,9 @@ ;; If this group it killed, then we want to subscribe it. (when (= (following-char) ?K) (setq sub t)) - (setq group (gnus-browse-group-name)) + (when (gnus-gethash (setq group (gnus-browse-group-name)) + gnus-newsrc-hashtb) + (error "Group already subscribed")) ;; Make sure the group has been properly removed before we ;; subscribe to it. (gnus-kill-ephemeral-group group) @@ -745,6 +749,8 @@ 'request-regenerate (car (gnus-server-to-method server)))) (error "This backend doesn't support regeneration") (gnus-message 5 "Requesting regeneration of %s..." server) + (unless (gnus-open-server server) + (error "Couldn't open server")) (if (gnus-request-regenerate server) (gnus-message 5 "Requesting regeneration of %s...done" server) (gnus-message 5 "Couldn't regenerate %s" server)))))
--- a/lisp/gnus/gnus-start.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-start.el Wed Sep 24 01:50:24 1997 +0000 @@ -79,7 +79,7 @@ :group 'gnus-dribble-file :type '(choice directory (const nil))) -(defcustom gnus-check-new-newsgroups t +(defcustom gnus-check-new-newsgroups 'ask-server "*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 @@ -123,7 +123,7 @@ :group 'gnus-start-server :type 'boolean) -(defcustom gnus-read-active-file t +(defcustom gnus-read-active-file 'some "*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. @@ -643,8 +643,8 @@ (gnus-splash) (gnus-clear-system) (nnheader-init-server-buffer) + (setq gnus-slave slave) (gnus-read-init-file) - (setq gnus-slave slave) (when (and (string-match "XEmacs" (emacs-version)) gnus-simple-splash) @@ -691,7 +691,7 @@ "Unload all Gnus features." (interactive) (unless (boundp 'load-history) - (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) + (error "Sorry, `gnus-unload' is not implemented in this Emacs version")) (let ((history load-history) feature) (while history @@ -762,6 +762,7 @@ ;; Set the file modes to reflect the .newsrc file modes. (save-buffer) (when (and (file-exists-p gnus-current-startup-file) + (file-exists-p dribble-file) (setq modes (file-modes gnus-current-startup-file))) (set-file-modes dribble-file modes)) ;; Possibly eval the file later. @@ -839,7 +840,7 @@ ;; done in `gnus-get-unread-articles'. (and gnus-read-active-file (not level) - (gnus-read-active-file)) + (gnus-read-active-file nil dont-connect)) (unless gnus-active-hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096))) @@ -861,7 +862,8 @@ ;; See whether we need to read the description file. (when (and (boundp 'gnus-group-line-format) - (string-match "%[-,0-9]*D" gnus-group-line-format) + (let ((case-fold-search nil)) + (string-match "%[-,0-9]*D" gnus-group-line-format)) (not gnus-description-hashtb) (not dont-connect) gnus-read-active-file) @@ -895,8 +897,8 @@ "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." +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) @@ -1050,7 +1052,8 @@ nil (gnus-message 6 "First time user; subscribing you to default groups") (unless (gnus-read-active-file-p) - (gnus-read-active-file)) + (let ((gnus-read-active-file t)) + (gnus-read-active-file))) (setq gnus-newsrc-last-checked-date (current-time-string)) (let ((groups gnus-default-subscribed-newsgroups) group) @@ -1209,7 +1212,8 @@ (format "(gnus-group-set-info '%S)" info))))) (when gnus-group-change-level-function - (funcall gnus-group-change-level-function group level oldlevel))))) + (funcall gnus-group-change-level-function + group level oldlevel previous))))) (defun gnus-kill-newsgroup (newsgroup) "Obsolete function. Kills a newsgroup." @@ -1282,12 +1286,11 @@ "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))))))) + (when cache-active + (when (< (car cache-active) (car active)) + (setcar active (car cache-active))) + (when (> (cdr cache-active) (cdr active)) + (setcdr active (cdr cache-active)))))))) (defun gnus-activate-group (group &optional scan dont-check method) ;; Check whether a group has been activated or not. @@ -1307,9 +1310,18 @@ (inline (gnus-request-group group dont-check method)) (error nil) (quit nil)) - (gnus-set-active group (setq active (gnus-parse-active))) - ;; Return the new active info. - active))) + (setq active (gnus-parse-active)) + ;; If there are no articles in the group, the GROUP + ;; command may have responded with the `(0 . 0)'. We + ;; ignore this if we already have an active entry + ;; for the group. + (if (and (zerop (car active)) + (zerop (cdr active)) + (gnus-active group)) + (gnus-active group) + (gnus-set-active group active) + ;; Return the new active info. + active)))) (defun gnus-get-unread-articles-in-group (info active &optional update) (when active @@ -1552,11 +1564,12 @@ (gnus-dribble-touch)) ;; Get the active file(s) from the backend(s). -(defun gnus-read-active-file (&optional force) +(defun gnus-read-active-file (&optional force not-native) (gnus-group-set-mode-line) (let ((methods (append - (if (gnus-check-server gnus-select-method) + (if (and (not not-native) + (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 @@ -1616,7 +1629,7 @@ (t (if (not (gnus-request-list method)) (unless (equal method gnus-message-archive-method) - (gnus-error 1 "Cannot read active file from %s server." + (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) @@ -1647,7 +1660,7 @@ (gnus-make-hashtable (count-lines (point-min) (point-max))) (gnus-make-hashtable 4096))))))) - ;; Delete unnecessary lines, cleaned up dmoore@ucsd.edu 31.10.1996 + ;; Delete unnecessary lines. (goto-char (point-min)) (cond ((gnus-ignored-newsgroups-has-to-p) (delete-matching-lines gnus-ignored-newsgroups)) @@ -1659,21 +1672,20 @@ ;; Make the group names readable as a lisp expression even if they ;; contain special characters. - ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>. (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))))))) + (when (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)) (let (group max min) @@ -2199,7 +2211,8 @@ (defun gnus-gnus-to-quick-newsrc-format () "Insert Gnus variables such as gnus-newsrc-alist in lisp format." - (let ((print-quoted t)) + (let ((print-quoted t) + (print-escape-newlines t)) (insert ";; -*- emacs-lisp -*-\n") (insert ";; Gnus startup file.\n") (insert
--- a/lisp/gnus/gnus-sum.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-sum.el Wed Sep 24 01:50:24 1997 +0000 @@ -631,7 +631,7 @@ :type 'function) (defcustom gnus-parse-headers-hook - (list 'gnus-decode-rfc1522) + (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -1206,7 +1206,7 @@ "j" gnus-summary-goto-article "g" gnus-summary-goto-subject "l" gnus-summary-goto-last-article - "p" gnus-summary-pop-article) + "o" gnus-summary-pop-article) (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) "k" gnus-summary-kill-thread @@ -2027,7 +2027,7 @@ (defmacro gnus-summary-article-sparse-p (article) "Say whether this article is a sparse article or not." - ` (memq ,article gnus-newsgroup-sparse)) + `(memq ,article gnus-newsgroup-sparse)) (defmacro gnus-summary-article-ancient-p (article) "Say whether this article is a sparse article or not." @@ -3061,8 +3061,9 @@ "Return the headers of the GENERATIONeth parent of HEADERS." (unless generation (setq generation 1)) - (let (references parent) - (while (and headers (not (zerop generation))) + (let ((parent t) + references) + (while (and parent headers (not (zerop generation))) (setq references (mail-header-references headers)) (when (and references (setq parent (gnus-parent-id references)) @@ -3839,6 +3840,10 @@ (set var (delq article (symbol-value var)))))) ;; Adjust assocs. ((memq mark uncompressed) + (when (not (listp (cdr (symbol-value var)))) + (set var (list (symbol-value var)))) + (when (not (listp (cdr articles))) + (setq articles (list articles))) (while articles (when (or (not (consp (setq article (pop articles)))) (< (car article) min) @@ -4214,7 +4219,7 @@ (progn (goto-char p) (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) + (if (numberp (setq lines (ignore-errors (read cur)))) lines 0) 0)) ;; Xref. @@ -4837,6 +4842,9 @@ (not non-destructive)) (setq gnus-newsgroup-scored nil)) ;; Set the new ranges of read articles. + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-undo-force-boundary)) (gnus-update-read-articles group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) ;; Set the current article marks. @@ -4873,6 +4881,7 @@ (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (mode major-mode) + (group-point nil) (buf (current-buffer))) (run-hooks 'gnus-summary-prepare-exit-hook) ;; If we have several article buffers, we kill them at exit. @@ -4899,6 +4908,7 @@ (run-hooks 'gnus-summary-exit-hook) (unless quit-config (gnus-group-next-unread-group 1)) + (setq group-point (point)) (if temporary nil ;Nothing to do. ;; If we have several article buffers, we kill them at exit. @@ -4928,8 +4938,7 @@ ;; Clear the current group name. (if (not quit-config) (progn - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1) + (goto-char group-point) (gnus-configure-windows 'group 'force)) (gnus-handle-ephemeral-exit quit-config)) (unless quit-config @@ -5015,7 +5024,7 @@ (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"))) + (let ((keys '("\C-d" "\r" "\177" [delete]))) (while keys (define-key gnus-dead-summary-mode-map (pop keys) 'gnus-summary-wake-up-the-dead)))) @@ -5032,11 +5041,8 @@ (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))))) + (gnus-add-minor-mode + 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map)))) (defun gnus-deaden-summary () "Make the current summary buffer into a dead summary buffer." @@ -5101,7 +5107,8 @@ (when current-prefix-arg (completing-read "Faq dir: " (and (listp gnus-group-faq-directory) - gnus-group-faq-directory))))) + (mapcar (lambda (file) (list file)) + gnus-group-faq-directory)))))) (let (gnus-faq-buffer) (when (setq gnus-faq-buffer (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) @@ -5163,7 +5170,8 @@ (if (and (or (eq t unreads) (and unreads (not (zerop unreads)))) (gnus-summary-read-group - target-group nil no-article current-buffer)) + target-group nil no-article + (and (buffer-name current-buffer) current-buffer))) (setq entered t) (setq current-group target-group target-group nil))))))) @@ -5311,7 +5319,7 @@ did) (and (not pseudo) (gnus-summary-article-pseudo-p article) - (error "This is a pseudo-article.")) + (error "This is a pseudo-article")) (prog1 (save-excursion (set-buffer gnus-summary-buffer) @@ -5875,7 +5883,7 @@ '<) (sort gnus-newsgroup-limit '<))) article) - (setq gnus-newsgroup-unreads nil) + (setq gnus-newsgroup-unreads gnus-newsgroup-limit) (if all (setq gnus-newsgroup-dormant nil gnus-newsgroup-marked nil @@ -5949,7 +5957,10 @@ (mail-header-number (car thread)))) (progn (if (<= (length (cdr thread)) 1) - (setq thread (cadr thread)) + (setq gnus-newsgroup-limit + (delq (mail-header-number (car thread)) + gnus-newsgroup-limit) + thread (cadr thread)) (when (gnus-invisible-cut-children (cdr thread)) (let ((th (cdr thread))) (while th @@ -5957,8 +5968,7 @@ gnus-newsgroup-limit) (setq thread (car th) th nil) - (setq th (cdr th))))))))) - )) + (setq th (cdr th))))))))))) thread) (defun gnus-cut-threads (threads) @@ -6066,7 +6076,7 @@ (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))) (progn - (setq gnus-newsgroup-reads + (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) t)))) ;; Nope, invisible article. @@ -6174,12 +6184,17 @@ (let* ((header (gnus-id-to-header message-id)) (sparse (and header (gnus-summary-article-sparse-p - (mail-header-number header))))) - (if header + (mail-header-number header)) + (memq (mail-header-number header) + gnus-newsgroup-limit)))) + (if (and header + (or (not (gnus-summary-article-sparse-p + (mail-header-number header))) + sparse)) (prog1 - ;; The article is present in the buffer, to we just go to it. + ;; The article is present in the buffer, so we just go to it. (gnus-summary-goto-article - (mail-header-number header) nil header) + (mail-header-number header) nil t) (when sparse (gnus-summary-update-article (mail-header-number header)))) ;; We fetch the article @@ -6342,11 +6357,15 @@ "Search for an article containing REGEXP. Optional argument BACKWARD means do search for backward. `gnus-select-article-hook' is not called during the search." + ;; We have to require this here to make sure that the following + ;; dynamic binding isn't shadowed by autoloading. + (require 'gnus-async) (let ((gnus-select-article-hook nil) ;Disable hook. (gnus-article-display-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. + (gnus-use-trees nil) ;Inhibit updating tree buffer. (sum (current-buffer)) (found nil) point) @@ -6670,6 +6689,8 @@ (cond ;; Move the article. ((eq action 'move) + ;; Remove this article from future suppression. + (gnus-dup-unsuppress-article article) (gnus-request-move-article article ; Article to move gnus-newsgroup-name ; From newsgroup @@ -6811,7 +6832,7 @@ (save-excursion (set-buffer gnus-group-buffer) (when (gnus-group-goto-group (car to-groups) t) - (gnus-group-get-new-news-this-group 1)) + (gnus-group-get-new-news-this-group 1 t)) (pop to-groups))) (gnus-kill-buffer copy-buf) @@ -7004,7 +7025,7 @@ (gnus-set-global-variables) (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) - (error "The current newsgroup does not support article deletion.")) + (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) @@ -7042,11 +7063,12 @@ (gnus-set-global-variables) (when (and (not force) (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing.")) + (error "The current newsgroup does not support article editing")) ;; Select article if needed. (unless (eq (gnus-summary-article-number) gnus-current-article) (gnus-summary-select-article t)) + (gnus-article-date-original) (gnus-article-edit-article `(lambda () (gnus-summary-edit-article-done @@ -7063,7 +7085,7 @@ (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) (current-buffer)))) - (error "Couldn't replace article.") + (error "Couldn't replace article") ;; Update the summary buffer. (if (and references (equal (message-tokenize-header references " ") @@ -7711,7 +7733,7 @@ (setq scored (cdr scored))) (if (not headers) (when (not no-error) - (error "No expunged articles hidden.")) + (error "No expunged articles hidden")) (goto-char (point-min)) (gnus-summary-prepare-unthreaded (nreverse headers)) (goto-char (point-min)) @@ -7742,7 +7764,9 @@ (if (and not-mark (not gnus-newsgroup-adaptive) (not gnus-newsgroup-auto-expire) - (not gnus-suppress-duplicates)) + (not gnus-suppress-duplicates) + (or (not gnus-use-cache) + (not (eq gnus-use-cache 'passive)))) (progn (when all (setq gnus-newsgroup-marked nil @@ -7866,9 +7890,9 @@ is non-nil or the Subject: of both articles are the same." (interactive) (unless (not (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing.")) + (error "The current newsgroup does not support article editing")) (unless (<= (length gnus-newsgroup-processable) 1) - (error "No more than one article may be marked.")) + (error "No more than one article may be marked")) (save-window-excursion (let ((gnus-article-buffer " *reparent*") (current-article (gnus-summary-article-number)) @@ -7878,13 +7902,13 @@ (save-excursion (if (eq (forward-line -1) 0) (gnus-summary-article-number) - (error "Beginning of summary buffer.")))))) + (error "Beginning of summary buffer")))))) (unless (not (eq current-article parent-article)) - (error "An article may not be self-referential.")) + (error "An article may not be self-referential")) (let ((message-id (mail-header-id (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) - (error "No message-id in desired parent.")) + (error "No message-id in desired parent")) (gnus-summary-select-article t t nil current-article) (set-buffer gnus-original-article-buffer) (let ((buf (format "%s" (buffer-string)))) @@ -7897,11 +7921,11 @@ (unless (gnus-request-replace-article current-article (car gnus-article-current) (current-buffer)) - (error "Couldn't replace article.")))) + (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." + (gnus-message 3 "Article %d is now the child of article %d" current-article parent-article))))) (defun gnus-summary-toggle-threads (&optional arg) @@ -8469,7 +8493,8 @@ (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (setq buffer-read-only nil) - (let ((command (if automatic command (read-string "Command: " command)))) + (let ((command (if automatic command + (read-string "Command: " (cons command 0))))) (erase-buffer) (insert "$ " command "\n\n") (if gnus-view-pseudo-asynchronously @@ -8701,6 +8726,8 @@ (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit)) buffers))))) +(gnus-ems-redefine) + (provide 'gnus-sum) (run-hooks 'gnus-sum-load-hook)
--- a/lisp/gnus/gnus-topic.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-topic.el Wed Sep 24 01:50:24 1997 +0000 @@ -79,7 +79,6 @@ (defvar gnus-topic-killed-topics nil) (defvar gnus-topic-inhibit-change-level nil) -(defvar gnus-topic-tallied-groups nil) (defconst gnus-topic-line-format-alist `((?n name ?s) @@ -364,8 +363,6 @@ (let ((buffer-read-only nil) (lowest (or lowest 1))) - (setq gnus-topic-tallied-groups nil) - (when (or (not gnus-topic-alist) (not gnus-topology-checked-p)) (gnus-topic-check-topology)) @@ -441,10 +438,7 @@ (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))))) (when (and (listp entry) - (numberp (car entry)) - (not (member (gnus-info-group (setq info (nth 2 entry))) - gnus-topic-tallied-groups))) - (push (gnus-info-group info) gnus-topic-tallied-groups) + (numberp (car entry))) (incf unread (car entry))) (when (listp entry) (setq tick t))) @@ -520,8 +514,7 @@ (gnus-add-text-properties (point) (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec) - (gnus-topic-remove-excess-properties)1) + (eval gnus-topic-line-format-spec)) (list 'gnus-topic (intern name) 'gnus-topic-level level 'gnus-topic-unread unread @@ -549,12 +542,14 @@ (when (and (eq major-mode 'gnus-group-mode) gnus-topic-mode) (let ((group (gnus-group-group-name)) + (m (point-marker)) (buffer-read-only nil)) (when (and group (gnus-get-info group) (gnus-topic-goto-topic (gnus-current-topic))) (gnus-topic-update-topic-line (gnus-group-topic-name)) - (gnus-group-goto-group group) + (goto-char m) + (set-marker m nil) (gnus-group-position-point))))) (defun gnus-topic-goto-missing-group (group) @@ -648,7 +643,6 @@ (setq gnus-topic-active-topology nil gnus-topic-active-alist nil gnus-topic-killed-topics nil - gnus-topic-tallied-groups nil gnus-topology-checked-p nil)) (defun gnus-topic-check-topology () @@ -681,18 +675,20 @@ ;; they belong to some topic. (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) gnus-topic-alist))) - (entry (assoc (caar gnus-topic-topology) gnus-topic-alist)) + (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) (newsrc (cdr gnus-newsrc-alist)) group) (while newsrc (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) - (setcdr entry (cons group (cdr entry)))))) + (setcdr entry (list group)) + (setq entry (cdr entry))))) ;; Go through all topics and make sure they contain only living groups. (let ((alist gnus-topic-alist) topic) (while (setq topic (pop alist)) (while (cdr topic) - (if (gnus-gethash (cadr topic) gnus-newsrc-hashtb) + (if (and (cadr topic) + (gnus-gethash (cadr topic) gnus-newsrc-hashtb)) (setq topic (cdr topic)) (setcdr topic (cddr topic))))))) @@ -729,10 +725,11 @@ (push (cons topic-name (nreverse filtered-topic)) result))) (setq gnus-topic-alist (nreverse result)))) -(defun gnus-topic-change-level (group level oldlevel) +(defun gnus-topic-change-level (group level oldlevel &optional previous) "Run when changing levels to enter/remove groups from topics." (save-excursion (set-buffer gnus-group-buffer) + (gnus-group-goto-group (or (car (nth 2 previous)) group)) (when (and gnus-topic-mode gnus-topic-alist (not gnus-topic-inhibit-change-level)) @@ -900,7 +897,9 @@ "\C-i" gnus-topic-indent [tab] gnus-topic-indent "r" gnus-topic-rename - "\177" gnus-topic-delete) + "\177" gnus-topic-delete + [delete] gnus-topic-delete + "h" gnus-topic-toggle-display-empty-topics) (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) "s" gnus-topic-sort-groups @@ -930,7 +929,9 @@ ["Rename" gnus-topic-rename t] ["Create" gnus-topic-create-topic t] ["Mark" gnus-topic-mark-topic t] - ["Indent" gnus-topic-indent t]) + ["Indent" gnus-topic-indent t] + ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t] + ["Edit parameters" gnus-topic-edit-parameters t]) ["List active" gnus-topic-list-active t])))) (defun gnus-topic-mode (&optional arg redisplay) @@ -942,17 +943,14 @@ (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. - (when gnus-topic-mode + (if (not gnus-topic-mode) + (setq gnus-goto-missing-group-function nil) (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (setq gnus-topic-line-format-spec (gnus-parse-format gnus-topic-line-format gnus-topic-line-format-alist t)) - (unless (assq 'gnus-topic-mode minor-mode-alist) - (push '(gnus-topic-mode " Topic") minor-mode-alist)) - (unless (assq 'gnus-topic-mode minor-mode-map-alist) - (push (cons 'gnus-topic-mode gnus-topic-mode-map) - minor-mode-map-alist)) + (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) (set (make-local-variable 'gnus-group-prepare-function) @@ -1024,6 +1022,8 @@ (gnus-group-read-group all no-article group))) (defun gnus-topic-create-topic (topic parent &optional previous full-topic) + "Create a new TOPIC under PARENT. +When used interactively, PARENT will be the topic under point." (interactive (list (read-string "New topic: ") @@ -1234,7 +1234,8 @@ ;; Remove from alist. (setq gnus-topic-alist (delq entry gnus-topic-alist)) ;; Remove from topology. - (gnus-topic-find-topology topic nil nil 'delete))) + (gnus-topic-find-topology topic nil nil 'delete) + (gnus-dribble-touch))) (defun gnus-topic-rename (old-name new-name) "Rename a topic." @@ -1303,6 +1304,16 @@ gnus-killed-list gnus-zombie-list) (gnus-group-list-groups 9 nil 1))) +(defun gnus-topic-toggle-display-empty-topics () + "Show/hide topics that have no unread articles." + (interactive) + (setq gnus-topic-display-empty-topics + (not gnus-topic-display-empty-topics)) + (gnus-group-list-groups) + (message "%s empty topics" + (if gnus-topic-display-empty-topics + "Showing" "Hiding"))) + ;;; Topic sorting functions (defun gnus-topic-edit-parameters (group) @@ -1312,7 +1323,7 @@ (if group (gnus-group-edit-group-parameters group) (if (not (gnus-group-topic-p)) - (error "Nothing to edit on the current line.") + (error "Nothing to edit on the current line") (let ((topic (gnus-group-topic-name))) (gnus-edit-form (gnus-topic-parameters topic)
--- a/lisp/gnus/gnus-undo.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-undo.el Wed Sep 24 01:50:24 1997 +0000 @@ -73,15 +73,15 @@ "\M-\C-_" gnus-undo "\C-_" gnus-undo "\C-xu" gnus-undo - [(control /)] gnus-undo ; many people are used to type `C-/' on - ; X terminals and get `C-_'. - )) + ;; many people are used to type `C-/' on X terminals and get `C-_'. + [(control /)] gnus-undo)) (defun gnus-undo-make-menu-bar () + ;; This is disabled for the time being. (when nil - (define-key-after (current-local-map) [menu-bar file gnus-undo] - (cons "Undo" 'gnus-undo-actions) - [menu-bar file whatever]))) + (define-key-after (current-local-map) [menu-bar file gnus-undo] + (cons "Undo" 'gnus-undo-actions) + [menu-bar file whatever]))) (defun gnus-undo-mode (&optional arg) "Minor mode for providing `undo' in Gnus buffers. @@ -97,15 +97,9 @@ ;; Set up the menu. (when (gnus-visual-p 'undo-menu 'menu) (gnus-undo-make-menu-bar)) - ;; Don't display anything in the mode line -- too annoying. - ;;(unless (assq 'gnus-undo-mode minor-mode-alist) - ;; (push '(gnus-undo-mode " Undo") minor-mode-alist)) - (unless (assq 'gnus-undo-mode minor-mode-map-alist) - (push (cons 'gnus-undo-mode gnus-undo-mode-map) - minor-mode-map-alist)) + (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map) (make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'gnus-undo-boundary nil t) - (add-hook 'gnus-summary-exit-hook 'gnus-undo-boundary) (run-hooks 'gnus-undo-mode-hook))) ;;; Interface functions. @@ -124,6 +118,11 @@ (setq gnus-undo-boundary-inhibit nil) (setq gnus-undo-boundary t))) +(defun gnus-undo-force-boundary () + "Set Gnus undo boundary." + (setq gnus-undo-boundary-inhibit nil + gnus-undo-boundary t)) + (defun gnus-undo-register (form) "Register FORMS as something to be performed to undo a change. FORMS may use backtick quote syntax."
--- a/lisp/gnus/gnus-util.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-util.el Wed Sep 24 01:50:24 1997 +0000 @@ -255,7 +255,8 @@ (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)))) + (caddr date) (cadr date) (car date) + (* 60 (timezone-zone-to-minute (nth 4 date)))))) (defun gnus-time-minus (t1 t2) "Subtract two internal times." @@ -530,7 +531,7 @@ (unless gnus-xemacs (let* ((overlayss (overlay-lists)) (buffer-read-only nil) - (overlays (nconc (car overlayss) (cdr overlayss)))) + (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) (while overlays (delete-overlay (pop overlays))))))
--- a/lisp/gnus/gnus-uu.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-uu.el Wed Sep 24 01:50:24 1997 +0000 @@ -1388,7 +1388,7 @@ (if (not (looking-at gnus-uu-begin-string)) (setq state (list 'middle)) - ;; This is the beginning of an uuencoded article. + ;; This is the beginning of a uuencoded article. ;; We replace certain characters that could make things messy. (setq gnus-uu-file-name (let ((nnheader-file-name-translation-alist @@ -1779,7 +1779,7 @@ This may not be smart, as no other decoder I have seen are able to follow threads when collecting uuencoded articles. (Well, I have seen one package that does that - gnus-uu, but somehow, I don't think that -counts...) Default is nil." +counts...) The default is nil." :group 'gnus-extract-post :type 'boolean) @@ -1878,28 +1878,7 @@ (setq file-name gnus-uu-post-inserted-file-name) (setq file-name (gnus-uu-post-insert-binary))) - (if gnus-uu-post-threaded - (let ((message-required-news-headers - (if (memq 'Message-ID message-required-news-headers) - message-required-news-headers - (cons 'Message-ID message-required-news-headers))) - gnus-inews-article-hook) - - (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) - gnus-inews-article-hook - (list gnus-inews-article-hook))) - (push - '(lambda () - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) - (setq gnus-uu-post-message-id - (buffer-substring - (match-beginning 1) (match-end 1))) - (setq gnus-uu-post-message-id nil)))) - gnus-inews-article-hook) - (gnus-uu-post-encoded file-name t)) - (gnus-uu-post-encoded file-name nil))) + (gnus-uu-post-encoded file-name gnus-uu-post-threaded)) (setq gnus-uu-post-inserted-file-name nil) (when gnus-uu-winconf-post-news (set-window-configuration gnus-uu-winconf-post-news))) @@ -1966,12 +1945,12 @@ (goto-char (point-min)) (setq length (count-lines 1 (point-max))) (setq parts (/ length gnus-uu-post-length)) - (when (not (< (% length gnus-uu-post-length) 4)) - (setq parts (1+ parts)))) + (unless (< (% length gnus-uu-post-length) 4) + (incf parts))) (when gnus-uu-post-separate-description (forward-line -1)) - (kill-region (point) (point-max)) + (delete-region (point) (point-max)) (goto-char (point-min)) (re-search-forward @@ -1980,12 +1959,13 @@ (setq header (buffer-substring 1 (point))) (goto-char (point-min)) - (if (not gnus-uu-post-separate-description) - () - (when (and (not threaded) (re-search-forward "^Subject: " nil t)) + (when gnus-uu-post-separate-description + (when (re-search-forward "^Subject: " nil t) (end-of-line) (insert (format " (0/%d)" parts))) - (message-send)) + (save-excursion + (message-send)) + (setq gnus-uu-post-message-id (message-fetch-field "message-id"))) (save-excursion (setq i 1) @@ -1995,7 +1975,7 @@ (erase-buffer) (insert header) (when (and threaded gnus-uu-post-message-id) - (insert (format "References: %s\n" gnus-uu-post-message-id))) + (insert "References: " gnus-uu-post-message-id "\n")) (insert separator) (setq whole-len (- 62 (length (format top-string "" file-name i parts "")))) @@ -2010,15 +1990,9 @@ (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) (goto-char (point-min)) - (if (not (re-search-forward "^Subject: " nil t)) - () - (if (not threaded) - (progn - (end-of-line) - (insert (format " (%d/%d)" i parts))) - (when (or (and (= i 2) gnus-uu-post-separate-description) - (and (= i 1) (not gnus-uu-post-separate-description))) - (replace-match "Subject: Re: ")))) + (when (re-search-forward "^Subject: " nil t) + (end-of-line) + (insert (format " (%d/%d)" i parts))) (goto-char (point-max)) (save-excursion @@ -2031,10 +2005,9 @@ (forward-line -4)) (setq end (point))) (insert-buffer-substring uubuf beg end) - (insert beg-line) - (insert "\n") + (insert beg-line "\n") (setq beg end) - (setq i (1+ i)) + (incf i) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) @@ -2048,12 +2021,14 @@ (insert beg-line) (insert "\n") (let (message-sent-message-via) - (message-send)))) + (save-excursion + (message-send)) + (setq gnus-uu-post-message-id + (concat (message-fetch-field "references") " " + (message-fetch-field "message-id")))))) - (when (setq buf (get-buffer send-buffer-name)) - (kill-buffer buf)) - (when (setq buf (get-buffer encoded-buffer-name)) - (kill-buffer buf)) + (gnus-kill-buffer send-buffer-name) + (gnus-kill-buffer encoded-buffer-name) (when (not gnus-uu-post-separate-description) (set-buffer-modified-p nil)
--- a/lisp/gnus/gnus-win.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus-win.el Wed Sep 24 01:50:24 1997 +0000 @@ -184,6 +184,7 @@ (faq . gnus-faq-buffer) (picons . "*Picons*") (tree . gnus-tree-buffer) + (score-trace . "*Score Trace*") (info . gnus-info-buffer) (article-copy . gnus-article-copy) (draft . gnus-draft-buffer))
--- a/lisp/gnus/gnus.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/gnus.el Wed Sep 24 01:50:24 1997 +0000 @@ -145,6 +145,18 @@ :link '(custom-manual "(gnus)Various Summary Stuff") :group 'gnus-summary) +(defgroup gnus-summary-pick nil + "Pick mode in the summary buffer." + :link '(custom-manual "(gnus)Pick and Read") + :prefix "gnus-pick-" + :group 'gnus-summary) + +(defgroup gnus-summary-tree nil + "Tree display of threads in the summary buffer." + :link '(custom-manual "(gnus)Tree Display") + :prefix "gnus-tree-" + :group 'gnus-summary) + ;; Belongs to gnus-uu.el (defgroup gnus-extract-view nil "Viewing extracted files." @@ -257,7 +269,6 @@ (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-character-to-event 'identity) @@ -649,12 +660,13 @@ (save-excursion (save-restriction (narrow-to-region start end) - (indent-rigidly start end arg) - ;; We translate tabs into spaces -- not everybody uses - ;; an 8-character tab. - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " t t))))) + (let ((tab-width 8)) + (indent-rigidly start end arg) + ;; We translate tabs into spaces -- not everybody uses + ;; an 8-character tab. + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (replace-match " " t t)))))) (defvar gnus-simple-splash nil) @@ -781,7 +793,7 @@ (when (and gnus-default-nntp-server (not (string= gnus-default-nntp-server ""))) gnus-default-nntp-server) - (system-name))) + "news")) (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) nil @@ -1346,7 +1358,6 @@ gnus-article-fill-cited-article gnus-article-remove-cr gnus-article-de-quoted-unreadable - gnus-article-display-x-face gnus-summary-stop-page-breaking ;; gnus-summary-caesar-message ;; gnus-summary-verbose-headers @@ -1370,7 +1381,9 @@ gnus-article-strip-leading-blank-lines gnus-article-strip-multiple-blank-lines gnus-article-strip-blank-lines - gnus-article-treat-overstrike)) + gnus-article-treat-overstrike + gnus-article-display-x-face + gnus-smiley-display)) (defcustom gnus-article-save-directory gnus-directory "*Name of the directory articles will be saved in (default \"~/News\")." @@ -1643,7 +1656,7 @@ 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-article-delete-invisible-text) + gnus-article-delete-invisible-text gnus-hack-decode-rfc1522) ("gnus-art" :interactive t gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-word-wrap @@ -1910,6 +1923,20 @@ ;;; Gnus Utility Functions ;;; +(defmacro gnus-string-or (&rest strings) + "Return the first element of STRINGS that is a non-blank string. +STRINGS will be evaluated in normal `or' order." + `(gnus-string-or-1 ',strings)) + +(defun gnus-string-or-1 (strings) + (let (string) + (while strings + (setq string (eval (pop strings))) + (if (string-match "^[ \t]*$" string) + (setq string nil) + (setq strings nil))) + 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) @@ -2001,7 +2028,7 @@ (string-match gnus-total-expirable-newsgroups group))))) (defun gnus-group-auto-expirable-p (group) - "Check whether GROUP is total-expirable or not." + "Check whether GROUP is auto-expirable or not." (let ((params (gnus-group-find-parameter group)) val) (cond @@ -2064,7 +2091,7 @@ (defun gnus-simplify-mode-line () "Make mode lines a bit simpler." - (setq mode-line-modified "-- ") + (setq mode-line-modified (cdr gnus-mode-line-modified)) (when (listp mode-line-format) (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format))
--- a/lisp/gnus/message.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/message.el Wed Sep 24 01:50:24 1997 +0000 @@ -596,6 +596,25 @@ (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) "If non-nil, delete the deletable headers before feeding to mh.") +(defvar message-send-method-alist + '((news message-news-p message-send-via-news) + (mail message-mail-p message-send-via-mail)) + "Alist of ways to send outgoing messages. +Each element has the form + + \(TYPE PREDICATE FUNCTION) + +where TYPE is a symbol that names the method; PREDICATE is a function +called without any parameters to determine whether the message is +a message of type TYPE; and FUNCTION is a function to be called if +PREDICATE returns non-nil. FUNCTION is called with one parameter -- +the prefix.") + +(defvar message-mail-alias-type 'abbrev + "*What alias expansion type to use in Message buffers. +The default is `abbrev', which uses mailabbrev. nil switches +mail aliases off.") + ;;; Internal variables. ;;; Well, not really internal. @@ -725,19 +744,19 @@ (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")) (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)")) - `((,(concat "^\\(To:\\)" content) + `((,(concat "^\\([Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-to-face nil t)) - (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)" content) + (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-cc-face nil t)) - (,(concat "^\\(Subject:\\)" content) + (,(concat "^\\([Ss]ubject:\\)" content) (1 'message-header-name-face) (2 'message-header-subject-face nil t)) - (,(concat "^\\(Newsgroups:\\|Followup-to:\\)" content) + (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-newsgroups-face nil t)) - (,(concat "^\\([^: \n\t]+:\\)" content) + (,(concat "^\\([A-Z][^: \n\t]+:\\)" content) (1 'message-header-name-face) (2 'message-header-other-face nil t)) (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) @@ -1263,9 +1282,10 @@ (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) ;; Allow mail alias things. - (if (fboundp 'mail-abbrevs-setup) - (mail-abbrevs-setup) - (funcall (intern "mail-aliases-setup"))) + (when (eq message-mail-alias-type 'abbrev) + (if (fboundp 'mail-abbrevs-setup) + (mail-abbrevs-setup) + (funcall (intern "mail-aliases-setup")))) (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -1348,11 +1368,15 @@ -(defun message-insert-to () - "Insert a To header that points to the author of the article being replied to." - (interactive) +(defun message-insert-to (&optional force) + "Insert a To header that points to the author of the article being replied to. +If the original author requested not to be sent mail, the function signals +an error. +With the prefix argument FORCE, insert the header anyway." + (interactive "P") (let ((co (message-fetch-reply-field "mail-copies-to"))) - (when (and co + (when (and (null force) + co (equal (downcase co) "never")) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") @@ -1733,30 +1757,43 @@ (message-fix-before-sending) (run-hooks 'message-send-hook) (message "Sending...") - (when (and (or (not (message-news-p)) - (and (or (not (memq 'news message-sent-message-via)) - (y-or-n-p - "Already sent message via news; resend? ")) - (funcall message-send-news-function arg))) - (or (not (message-mail-p)) - (and (or (not (memq 'mail message-sent-message-via)) - (y-or-n-p - "Already sent message via mail; resend? ")) - (message-send-mail arg)))) - (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) - (run-hooks 'message-sent-hook) - (message "Sending...done") - ;; If buffer has no file, mark it as unmodified and delete autosave. - (unless buffer-file-name - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t)) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t))) + (let ((alist message-send-method-alist) + (success t) + elem sent) + (while (and success + (setq elem (pop alist))) + (when (and (or (not (funcall (cadr elem))) + (and (or (not (memq (car elem) + message-sent-message-via)) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem)))) + (setq success (funcall (caddr elem) arg))))) + (setq sent t))) + (when (and success sent) + (message-do-fcc) + ;;(when (fboundp 'mail-hist-put-headers-into-history) + ;; (mail-hist-put-headers-into-history)) + (run-hooks 'message-sent-hook) + (message "Sending...done") + ;; If buffer has no file, mark it as unmodified and delete autosave. + (unless buffer-file-name + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t)) + ;; Delete other mail buffers and stuff. + (message-do-send-housekeeping) + (message-do-actions message-send-actions) + ;; Return success. + t)))) + +(defun message-send-via-mail (arg) + "Send the current message via mail." + (message-send-mail arg)) + +(defun message-send-via-news (arg) + "Send the current message via news." + (funcall message-send-news-function arg)) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -1926,10 +1963,10 @@ ;; qmail-inject doesn't say anything on it's stdout/stderr, ;; we have to look at the retval instead (0 nil) - (1 (error "qmail-inject reported permanent failure.")) - (111 (error "qmail-inject reported transient failure.")) + (1 (error "qmail-inject reported permanent failure")) + (111 (error "qmail-inject reported transient failure")) ;; should never happen - (t (error "qmail-inject reported unknown failure.")))) + (t (error "qmail-inject reported unknown failure")))) (defun message-send-mail-with-mh () "Send the prepared message buffer with mh." @@ -2007,7 +2044,8 @@ (funcall (intern (format "%s-open-server" (car method))) (cadr method) (cddr method)) (setq result - (funcall (intern (format "%s-request-post" (car method)))))) + (funcall (intern (format "%s-request-post" (car method))) + (cadr method)))) (kill-buffer tembuf)) (set-buffer messbuf) (if result @@ -2191,6 +2229,22 @@ (y-or-n-p (format "The %s header looks odd: \"%s\". Really post? " (car headers) header))))) + (message-check 'repeated-newsgroups + (let ((case-fold-search t) + (headers '("Newsgroups" "Followup-To")) + header error groups group) + (while (and headers + (not error)) + (when (setq header (mail-fetch-field (pop headers))) + (setq groups (message-tokenize-header header ",")) + (while (setq group (pop groups)) + (when (member group groups) + (setq error group + groups nil))))) + (if (not error) + t + (y-or-n-p + (format "Group %s is repeated in headers. Really post? " error))))) ;; Check the From header. (message-check 'from (let* ((case-fold-search t) @@ -2282,7 +2336,8 @@ (concat "^" (regexp-quote mail-header-separator) "$")) (while (not (eobp)) (when (not (looking-at "[ \t\n]")) - (setq sum (logxor (ash sum 1) (following-char)))) + (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) + (following-char)))) (forward-char 1))) sum)) @@ -2373,16 +2428,21 @@ (defun message-make-message-id () "Make a unique Message-ID." (concat "<" (message-unique-id) - (let ((psubject (save-excursion (message-fetch-field "subject")))) - (if (and message-reply-headers - (mail-header-references message-reply-headers) - (mail-header-subject message-reply-headers) - psubject - (mail-header-subject message-reply-headers) - (not (string= - (message-strip-subject-re - (mail-header-subject message-reply-headers)) - (message-strip-subject-re psubject)))) + (let ((psubject (save-excursion (message-fetch-field "subject"))) + (psupersedes + (save-excursion (message-fetch-field "supersedes")))) + (if (or + (and message-reply-headers + (mail-header-references message-reply-headers) + (mail-header-subject message-reply-headers) + psubject + (mail-header-subject message-reply-headers) + (not (string= + (message-strip-subject-re + (mail-header-subject message-reply-headers)) + (message-strip-subject-re psubject)))) + (and psupersedes + (string-match "_-_@" psupersedes))) "_-_" "")) "@" (message-make-fqdn) ">")) @@ -2468,9 +2528,10 @@ (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of " + "'s message of \"" (if (or (not date) (string= date "")) - "(unknown date)" date))))))) + "(unknown date)" date) + "\"")))))) (defun message-make-distribution () "Make a Distribution header." @@ -2633,6 +2694,8 @@ header value elem) ;; First we remove any old generated headers. (let ((headers message-deletable-headers)) + (unless (buffer-modified-p) + (setq headers (delq 'Message-ID (copy-sequence headers)))) (while headers (goto-char (point-min)) (and (re-search-forward @@ -2939,6 +3002,7 @@ (message-narrow-to-headers) (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) + (setq buffer-undo-list nil) (run-hooks 'message-setup-hook) (message-position-point) (undo-boundary)) @@ -2951,7 +3015,11 @@ (let ((name (make-temp-name (expand-file-name (concat (file-name-as-directory message-autosave-directory) - "msg."))))) + "msg." + (nnheader-replace-chars-in-string + (nnheader-replace-chars-in-string + (buffer-name) ?* ?.) + ?/ ?-)))))) (setq buffer-auto-save-file-name (save-excursion (prog1 @@ -3246,9 +3314,10 @@ mail-header-separator "\n" message-cancel-message) (message "Canceling your article...") - (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) - (message "Canceling your article...done") + (if (let ((message-syntax-checks + 'dont-check-for-anything-just-trust-me)) + (funcall message-send-news-function)) + (message "Canceling your article...done")) (kill-buffer buf))))) ;;;###autoload @@ -3576,14 +3645,15 @@ (insert string) (if (not comp) (message "No matching groups") - (pop-to-buffer "*Completions*") - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (display-completion-list (sort completions 'string<))) - (goto-char (point-min)) - (pop-to-buffer cur))))))) + (save-selected-window + (pop-to-buffer "*Completions*") + (buffer-disable-undo (current-buffer)) + (let ((buffer-read-only nil)) + (erase-buffer) + (let ((standard-output (current-buffer))) + (display-completion-list (sort completions 'string<))) + (goto-char (point-min)) + (delete-region (point) (progn (forward-line 3) (point)))))))))) ;;; Help stuff. @@ -3617,19 +3687,27 @@ Then clone the local variables and values from the old buffer to the new one, cloning only the locals having a substring matching the regexp varstr." - (let ((oldlocals (buffer-local-variables))) + (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (generate-new-buffer name)) - (mapcar (lambda (dude) - (when (and (car dude) - (or (not varstr) - (string-match varstr (symbol-name (car dude))))) - (ignore-errors - (set (make-local-variable (car dude)) - (cdr dude))))) - oldlocals) + (message-clone-locals oldbuf) (current-buffer)))) +(defun message-clone-locals (buffer) + "Clone the local variables from BUFFER to the current buffer." + (let ((locals (save-excursion + (set-buffer buffer) + (buffer-local-variables))) + (regexp "^gnus\\|^nn\\|^message")) + (mapcar + (lambda (local) + (when (and (car local) + (string-match regexp (symbol-name (car local)))) + (ignore-errors + (set (make-local-variable (car local)) + (cdr local))))) + locals))) + (run-hooks 'message-load-hook) (provide 'message)
--- a/lisp/gnus/nnfolder.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnfolder.el Wed Sep 24 01:50:24 1997 +0000 @@ -276,7 +276,8 @@ (when group (unless (assoc group nnfolder-group-alist) (push (list group (cons 1 0)) nnfolder-group-alist) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) + (nnmail-save-active nnfolder-group-alist nnfolder-active-file) + (nnfolder-read-folder group))) t) (deffoo nnfolder-request-list (&optional server) @@ -451,6 +452,11 @@ (kill-buffer (current-buffer)) t)))) +(defun nnfolder-request-regenerate (server) + (nnfolder-possibly-change-group nil server) + (nnfolder-generate-active-file) + t) + ;;; Internal functions. @@ -503,8 +509,6 @@ ;; Change group. (when (and group (not (equal group nnfolder-current-group))) - ;; 1997/8/14 by MORIOKA Tomohiko - ;; for XEmacs/mule. (let ((pathname-coding-system 'binary)) (nnmail-activate 'nnfolder) (when (and (not (assoc group nnfolder-group-alist)) @@ -513,16 +517,17 @@ ;; The group doesn't exist, so we create a new entry for it. (push (list group (cons 1 0)) nnfolder-group-alist) (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) - + (if dont-check - (setq nnfolder-current-group group) + (setq nnfolder-current-group group + nnfolder-current-buffer nil) (let (inf file) ;; If we have to change groups, see if we don't already have the ;; folder in memory. If we do, verify the modtime and destroy ;; the folder if needed so we can rescan it. - (when (setq inf (assoc group nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (nth 1 inf))) - + (setq nnfolder-current-buffer + (nth 1 (assoc group nnfolder-buffer-alist))) + ;; If the buffer is not live, make sure it isn't in the alist. If it ;; is live, verify that nobody else has touched the file since last ;; time. @@ -530,9 +535,9 @@ (not (gnus-buffer-live-p nnfolder-current-buffer))) (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) nnfolder-current-buffer nil)) - + (setq nnfolder-current-group group) - + (when (or (not nnfolder-current-buffer) (not (verify-visited-file-modtime nnfolder-current-buffer))) (save-excursion @@ -758,9 +763,7 @@ (defun nnfolder-group-pathname (group) "Make pathname for GROUP." - ;; 1997/8/14 by MORIOKA Tomohiko - ;; encode file name for Emacs 20. - (setq group (encode-coding-string group nnmail-pathname-coding-system)) + (setq group (gnus-encode-coding-string group nnmail-pathname-coding-system)) (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. (if (or nnmail-use-long-file-names @@ -773,6 +776,7 @@ "Save the buffer." (when (buffer-modified-p) (run-hooks 'nnfolder-save-buffer-hook) + (gnus-make-directory (file-name-directory (buffer-file-name))) (save-buffer))) (provide 'nnfolder)
--- a/lisp/gnus/nngateway.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nngateway.el Wed Sep 24 01:50:24 1997 +0000 @@ -58,9 +58,11 @@ (insert-buffer-substring buf) (message-narrow-to-head) (funcall nngateway-header-transformation nngateway-address) + (goto-char (point-max)) + (insert mail-header-separator "\n") (widen) (let (message-required-mail-headers) - (message-send-mail)))))) + (funcall message-send-mail-function)))))) ;;; Internal functions
--- a/lisp/gnus/nnheader.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnheader.el Wed Sep 24 01:50:24 1997 +0000 @@ -683,9 +683,7 @@ (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir - ;; 1997/8/10 by MORIOKA Tomohiko - ;; encode file name for Emacs 20. - (encode-coding-string + (gnus-encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnheader-pathname-coding-system) "/")))
--- a/lisp/gnus/nnkiboze.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnkiboze.el Wed Sep 24 01:50:24 1997 +0000 @@ -154,7 +154,9 @@ (nnkiboze-possibly-change-group group) (when force (let ((files (list (nnkiboze-nov-file-name) - (concat nnkiboze-directory group ".newsrc") + (concat nnkiboze-directory + (nnheader-translate-file-chars + (concat group ".newsrc"))) (nnkiboze-score-file group)))) (while files (and (file-exists-p (car files)) @@ -205,8 +207,12 @@ (defun nnkiboze-generate-group (group) (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) - (newsrc-file (concat nnkiboze-directory group ".newsrc")) - (nov-file (concat nnkiboze-directory group ".nov")) + (newsrc-file (concat nnkiboze-directory + (nnheader-translate-file-chars + (concat group ".newsrc")))) + (nov-file (concat nnkiboze-directory + (nnheader-translate-file-chars + (concat group ".nov")))) method nnkiboze-newsrc gname newsrc active ginfo lowest glevel orig-info nov-buffer ;; Bind various things to nil to make group entry faster.
--- a/lisp/gnus/nnmail.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnmail.el Wed Sep 24 01:50:24 1997 +0000 @@ -113,7 +113,9 @@ ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil - "If non-nil, nnmail will never delete the last expired article in a directory. + "If non-nil, nnmail will never delete/move a group's last article. +It can be marked expirable, so it will be deleted when it is no longer last. + You may need to set this variable if other programs are putting new mail into folder numbers that Gnus has marked as expired." :group 'nnmail-procmail @@ -396,7 +398,9 @@ '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") (mail . "mailer-daemon\\|postmaster\\|uucp") (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc") - (from . "from\\|sender\\|resent-from")) + (from . "from\\|sender\\|resent-from") + (nato . "to\\|cc\\|resent-to\\|resent-cc") + (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc")) "Alist of abbreviations allowed in `nnmail-split-fancy'." :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) @@ -505,9 +509,7 @@ (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir - ;; 1997/8/10 by MORIOKA Tomohiko - ;; encode file name for Emacs 20. - (encode-coding-string + (gnus-encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnmail-pathname-coding-system) "/"))) @@ -559,18 +561,17 @@ (defun nnmail-move-inbox (inbox) "Move INBOX to `nnmail-crash-box'." (if (not (file-writable-p nnmail-crash-box)) - (gnus-error 1 "Can't write to crash box %s. Not moving mail." + (gnus-error 1 "Can't write to crash box %s. Not moving mail" nnmail-crash-box) ;; If the crash box exists and is empty, we delete it. (when (and (file-exists-p nnmail-crash-box) (zerop (nnheader-file-size (file-truename nnmail-crash-box)))) (delete-file nnmail-crash-box)) - (let ((inbox (file-truename (expand-file-name inbox))) - (tofile (file-truename (expand-file-name nnmail-crash-box))) - movemail popmail errors result) - (if (setq popmail (string-match - "^po:" (file-name-nondirectory inbox))) - (setq inbox (file-name-nondirectory inbox)) + (let ((tofile (file-truename (expand-file-name nnmail-crash-box))) + (popmail (string-match "^po:" inbox)) + movemail errors result) + (unless popmail + (setq inbox (file-truename (expand-file-name inbox))) (setq movemail t) ;; On some systems, /usr/spool/mail/foo is a directory ;; and the actual inbox is /usr/spool/mail/foo/foo. @@ -590,7 +591,7 @@ (nnmail-read-passwd (format "Password for %s: " (substring inbox (+ popmail 3)))))) - (message "Getting mail from post office ...")) + (message "Getting mail from the post office...")) (when (or (and (file-exists-p tofile) (/= 0 (nnheader-file-size tofile))) (and (file-exists-p inbox) @@ -831,7 +832,7 @@ (= (following-char) ?\n))) (save-excursion (forward-line 1) - (while (looking-at ">From ") + (while (looking-at ">From \\|From ") (forward-line 1)) (looking-at "[^ \n\t:]+[ \n\t]*:"))) (setq found 'yes))))) @@ -860,7 +861,7 @@ (= (following-char) ?\n))) (save-excursion (forward-line 1) - (while (looking-at ">From ") + (while (looking-at ">From \\|From ") (forward-line 1)) (looking-at "[^ \n\t:]+[ \n\t]*:"))) (setq found 'yes))))) @@ -1069,6 +1070,9 @@ (fboundp nnmail-split-methods)) (let ((split (condition-case nil + ;; `nnmail-split-methods' is a function, so we + ;; just call this function here and use the + ;; result. (or (funcall nnmail-split-methods) '("bogus")) (error @@ -1076,9 +1080,13 @@ "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) - (unless (equal split '(junk)) - ;; `nnmail-split-methods' is a function, so we just call - ;; this function here and use the result. + ;; The article may be "cross-posted" to `junk'. What + ;; to do? Just remove the `junk' spec. Don't really + ;; see anything else to do... + (let (elem) + (while (setq elem (car (memq 'junk split))) + (setq split (delq elem split)))) + (when split (setq group-art (mapcar (lambda (group) (cons group (funcall func group))) @@ -1109,7 +1117,13 @@ ;; See whether the split methods returned `junk'. (if (equal group-art '(junk)) nil - (nreverse (delq 'junk group-art))))))) + ;; The article may be "cross-posted" to `junk'. What + ;; to do? Just remove the `junk' spec. Don't really + ;; see anything else to do... + (let (elem) + (while (setq elem (car (memq 'junk group-art))) + (setq group-art (delq elem group-art))) + (nreverse group-art))))))) (defun nnmail-insert-lines () "Insert how many lines there are in the body of the mail. @@ -1139,10 +1153,8 @@ (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist - ;; 1997/8/10 by MORIOKA Tomohiko - ;; encode file name for Emacs 20. (insert (format " %s:%d" - (encode-coding-string (caar group-alist) + (gnus-encode-coding-string (caar group-alist) nnmail-pathname-coding-system) (cdar group-alist))) (setq group-alist (cdr group-alist)))
--- a/lisp/gnus/nnmh.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnmh.el Wed Sep 24 01:50:24 1997 +0000 @@ -190,11 +190,9 @@ (deffoo nnmh-request-list (&optional server dir) (nnheader-insert "") - (let (;; 1997/8/14 by MORIOKA Tomohiko - ;; for XEmacs/mule. - (pathname-coding-system 'binary) + (let ((pathname-coding-system 'binary) (nnmh-toplev - (or dir (file-truename (file-name-as-directory nnmh-directory))))) + (file-truename (or dir (file-name-as-directory nnmh-directory))))) (nnmh-request-list-1 nnmh-toplev)) (setq nnmh-group-alist (nnmail-get-active)) t)
--- a/lisp/gnus/nnml.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnml.el Wed Sep 24 01:50:24 1997 +0000 @@ -38,7 +38,7 @@ (nnoo-declare nnml) (defvoo nnml-directory message-directory - "Mail spool directory.") + "Spool directory for the nnml mail backend.") (defvoo nnml-active-file (concat (file-name-as-directory nnml-directory) "active") @@ -474,8 +474,15 @@ (defun nnml-article-to-file (article) (nnml-update-file-alist) (let (file) - (when (setq file (cdr (assq article nnml-article-file-alist))) - (concat nnml-current-directory file)))) + (if (setq file (cdr (assq article nnml-article-file-alist))) + (concat nnml-current-directory file) + ;; Just to make sure nothing went wrong when reading over NFS -- + ;; check once more. + (when (file-exists-p + (setq file (concat nnml-current-directory "/" + (number-to-string article)))) + (nnml-update-file-alist t) + file)))) (defun nnml-deletable-article-p (group article) "Say whether ARTICLE in GROUP can be deleted." @@ -769,8 +776,7 @@ (search-forward "\n\n" nil t) (setq chars (- (point-max) (point))) (max 1 (1- (point))))) - (when (and (not (= 0 chars)) ; none of them empty files... - (not (= (point-min) (point-max)))) + (unless (zerop (buffer-size)) (goto-char (point-min)) (setq headers (nnml-parse-head chars (caar files))) (save-excursion @@ -800,8 +806,9 @@ (setf (car active) num))))))) t)) -(defun nnml-update-file-alist () - (unless nnml-article-file-alist +(defun nnml-update-file-alist (&optional force) + (when (or (not nnml-article-file-alist) + force) (setq nnml-article-file-alist (nnheader-article-to-file-alist nnml-current-directory))))
--- a/lisp/gnus/nnoo.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnoo.el Wed Sep 24 01:50:24 1997 +0000 @@ -143,7 +143,7 @@ (def (assq backend nnoo-definition-alist)) (parents (nth 1 def))) (unless def - (error "%s belongs to a backend that hasn't been declared." var)) + (error "%s belongs to a backend that hasn't been declared" var)) (setcar (nthcdr 2 def) (delq (assq var (nth 2 def)) (nth 2 def))) (setcar (nthcdr 2 def)
--- a/lisp/gnus/nnsoup.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnsoup.el Wed Sep 24 01:50:24 1997 +0000 @@ -237,7 +237,7 @@ (deffoo nnsoup-request-type (group &optional article) (nnsoup-possibly-change-group group) - ;; Try to guess the type based on the first articl ein the group. + ;; Try to guess the type based on the first article in the group. (when (not article) (setq article (cdaar (cddr (assoc group nnsoup-group-alist))))) @@ -623,7 +623,7 @@ (nnsoup-write-replies) ;; Check whether there is anything here. (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$")) - (error "No files to pack.")) + (error "No files to pack")) ;; Pack all these files into a SOUP packet. (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
--- a/lisp/gnus/nntp.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nntp.el Wed Sep 24 01:50:24 1997 +0000 @@ -73,10 +73,11 @@ Two pre-made functions are `nntp-open-network-stream', which is the default, and simply connects to some port or other on the remote -system (see nntp-port-number). The other are `nntp-open-rlogin', which -does an rlogin on the remote system, and then does a telnet to the -NNTP server available there (see nntp-rlogin-parameters) and `nntp-open-telnet' which -telnets to a remote system, logs in and does the same") +system (see nntp-port-number). The other are `nntp-open-rlogin', +which does an rlogin on the remote system, and then does a telnet to +the NNTP server available there (see nntp-rlogin-parameters) and +`nntp-open-telnet' which telnets to a remote system, logs in and does +the same.") (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") "*Parameters to `nntp-open-login'. @@ -98,6 +99,12 @@ (defvoo nntp-telnet-passwd nil "Password to use to log in via telnet with.") +(defvoo nntp-telnet-command "telnet" + "Command used to start telnet.") + +(defvoo nntp-telnet-switches '("-8") + "Switches given to the telnet command.") + (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 @@ -122,7 +129,7 @@ none of the commands are successful, nntp will just grab headers one by one.") -(defvoo nntp-nov-gap 20 +(defvoo nntp-nov-gap 5 "*Maximum allowed gap between two articles. If the gap between two consecutive articles is bigger than this variable, split the XOVER request into two requests.") @@ -187,7 +194,7 @@ (save-excursion (set-buffer (process-buffer process)) (goto-char (point-min)) - (while (or (not (memq (following-char) '(?2 ?3 ?4 ?5))) + (while (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) (looking-at "480")) (when (looking-at "480") (erase-buffer) @@ -568,20 +575,22 @@ (when (nntp-send-command-and-decode "\r?\n\\.\r?\n" "ARTICLE" (if (numberp article) (int-to-string article) article)) - (when (and buffer - (not (equal buffer nntp-server-buffer))) - (save-excursion - (set-buffer nntp-server-buffer) - (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number))) - (nntp-find-group-and-number))) + (if (and buffer + (not (equal buffer nntp-server-buffer))) + (save-excursion + (set-buffer nntp-server-buffer) + (copy-to-buffer buffer (point-min) (point-max)) + (nntp-find-group-and-number)) + (nntp-find-group-and-number)))) (deffoo nntp-request-head (article &optional group server) (nntp-possibly-change-group group server) - (when (nntp-send-command-and-decode + (when (nntp-send-command "\r?\n\\.\r?\n" "HEAD" (if (numberp article) (int-to-string article) article)) - (nntp-find-group-and-number))) + (prog1 + (nntp-find-group-and-number) + (nntp-decode-text)))) (deffoo nntp-request-body (article &optional group server) (nntp-possibly-change-group group server) @@ -1046,8 +1055,9 @@ (save-excursion (set-buffer buffer) (erase-buffer) - (let ((proc (start-process - "nntpd" buffer "telnet" "-8")) + (let ((proc (apply + 'start-process + "nntpd" buffer nntp-telnet-command nntp-telnet-switches)) (case-fold-search t)) (when (memq (process-status proc) '(open run)) (process-send-string proc "set escape \^X\n")
--- a/lisp/gnus/nnvirtual.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnvirtual.el Wed Sep 24 01:50:24 1997 +0000 @@ -374,22 +374,29 @@ (insert "Xref: " system-name " " group ":") (princ article (current-buffer)) + (insert " ") ;; If there were existing xref lines, clean them up to have the correct ;; component server prefix. - (let ((xref-end (save-excursion - (search-forward "\t" (gnus-point-at-eol) 'move) - (point))) - (len (length prefix))) - (unless (= (point) xref-end) + (save-restriction + (narrow-to-region (point) + (or (search-forward "\t" (gnus-point-at-eol) t) + (gnus-point-at-eol))) + (goto-char (point-min)) + (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (when (re-search-forward + (concat (gnus-group-real-name group) ":[0-9]+") + nil t) + (replace-match "" t t)) + (unless (= (point) (point-max)) (insert " ") (when (not (string= "" prefix)) - (while (re-search-forward "[^ ]+:[0-9]+" xref-end t) + (while (re-search-forward "[^ ]+:[0-9]+" nil t) (save-excursion (goto-char (match-beginning 0)) - (insert prefix)) - (setq xref-end (+ xref-end len))) - ))) + (insert prefix)))))) ;; Ensure a trailing \t. (end-of-line)
--- a/lisp/gnus/nnweb.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/nnweb.el Wed Sep 24 01:50:24 1997 +0000 @@ -288,9 +288,9 @@ (save-excursion (set-buffer nnweb-buffer) (erase-buffer) - (prog1 - (url-insert-file-contents url) - (copy-to-buffer buf (point-min) (point-max))))) + (url-insert-file-contents url) + (copy-to-buffer buf (point-min) (point-max)) + t)) (nnweb-url-retrieve-asynch url 'nnweb-callback (current-buffer) nnheader-callback-function) t))) @@ -344,7 +344,7 @@ (goto-char (point-min)) (while (re-search-forward "&\\([a-z]+\\);" nil t) (replace-match (char-to-string (or (cdr (assq (intern (match-string 1)) - w3-html-entities )) + w3-html-entities)) ?#)) t t))) @@ -443,7 +443,10 @@ (replace-match "\\1 " t) (forward-line 1)) (when (re-search-forward "\n\n+" nil t) - (replace-match "\n" t t)))) + (replace-match "\n" t t)) + (goto-char (point-min)) + (when (search-forward "[More Headers]" nil t) + (replace-match "" t t)))) (defun nnweb-dejanews-search (search) (nnweb-fetch-form @@ -564,35 +567,34 @@ (set-marker body nil)))) (defun nnweb-reference-search (search) - (prog1 - (url-insert-file-contents - (concat - (nnweb-definition 'address) - "?" - (nnweb-encode-www-form-urlencoded - `(("search" . "advanced") - ("querytext" . ,search) - ("subj" . "") - ("name" . "") - ("login" . "") - ("host" . "") - ("organization" . "") - ("groups" . "") - ("keywords" . "") - ("choice" . "Search") - ("startmonth" . "Jul") - ("startday" . "25") - ("startyear" . "1996") - ("endmonth" . "Aug") - ("endday" . "24") - ("endyear" . "1996") - ("mode" . "Quick") - ("verbosity" . "Verbose") - ("ranking" . "Relevance") - ("first" . "1") - ("last" . "25") - ("score" . "50"))))) - (setq buffer-file-name nil)) + (url-insert-file-contents + (concat + (nnweb-definition 'address) + "?" + (nnweb-encode-www-form-urlencoded + `(("search" . "advanced") + ("querytext" . ,search) + ("subj" . "") + ("name" . "") + ("login" . "") + ("host" . "") + ("organization" . "") + ("groups" . "") + ("keywords" . "") + ("choice" . "Search") + ("startmonth" . "Jul") + ("startday" . "25") + ("startyear" . "1996") + ("endmonth" . "Aug") + ("endday" . "24") + ("endyear" . "1996") + ("mode" . "Quick") + ("verbosity" . "Verbose") + ("ranking" . "Relevance") + ("first" . "1") + ("last" . "25") + ("score" . "50"))))) + (setq buffer-file-name nil) t) ;;; @@ -670,21 +672,21 @@ (nnweb-remove-markup))) (defun nnweb-altavista-search (search &optional part) - (prog1 - (url-insert-file-contents - (concat - (nnweb-definition 'address) - "?" - (nnweb-encode-www-form-urlencoded - `(("pg" . "aq") - ("what" . "news") - ,@(when part `(("stq" . ,(int-to-string (* part 30))))) - ("fmt" . "d") - ("q" . ,search) - ("r" . "") - ("d0" . "") - ("d1" . ""))))) - (setq buffer-file-name nil))) + (url-insert-file-contents + (concat + (nnweb-definition 'address) + "?" + (nnweb-encode-www-form-urlencoded + `(("pg" . "aq") + ("what" . "news") + ,@(when part `(("stq" . ,(int-to-string (* part 30))))) + ("fmt" . "d") + ("q" . ,search) + ("r" . "") + ("d0" . "") + ("d1" . ""))))) + (setq buffer-file-name nil) + t) (provide 'nnweb)
--- a/lisp/gnus/pop3.el Tue Sep 23 18:23:17 1997 +0000 +++ b/lisp/gnus/pop3.el Wed Sep 24 01:50:24 1997 +0000 @@ -1,10 +1,10 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996, Free Software Foundation, Inc. +;; Copyright (C) 1996,1997 Free Software Foundation, Inc. ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net> ;; Keywords: mail, pop3 -;; Version: 1.3e +;; Version: 1.3g ;; This file is part of GNU Emacs. @@ -37,7 +37,7 @@ (require 'mail-utils) (provide 'pop3) -(defconst pop3-version "1.3c") +(defconst pop3-version "1.3g") (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) "*POP3 maildrop.") @@ -152,7 +152,7 @@ (set-buffer (process-buffer process)) (goto-char pop3-read-point) (while (not (search-forward "\r\n" nil t)) - (accept-process-output process) + (accept-process-output process 3) (goto-char pop3-read-point)) (setq match-end (point)) (goto-char pop3-read-point) @@ -205,6 +205,7 @@ (defun pop3-munge-message-separator (start end) "Check to see if a message separator exists. If not, generate one." + (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message")) (save-excursion (save-restriction (narrow-to-region start end) @@ -214,7 +215,8 @@ (looking-at "BABYL OPTIONS:") ; Babyl )) (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) - (date (pop3-string-to-list (mail-fetch-field "Date"))) + (date (pop3-string-to-list (or (mail-fetch-field "Date") + (message-make-date)))) (From_)) ;; sample date formats I have seen ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) @@ -315,7 +317,7 @@ (save-excursion (set-buffer (process-buffer process)) (while (not (re-search-forward "^\\.\r\n" nil t)) - (accept-process-output process) + (accept-process-output process 3) ;; bill@att.com ... to save wear and tear on the heap (if (> (buffer-size) 20000) (sleep-for 1)) (if (> (buffer-size) 50000) (sleep-for 1))