From aa88205ebb3cd4ade3696b2faf1d72a687cffa49 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 23:30:53 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 46 +++ lisp/article.el | 26 +- lisp/custom-edit.el | 2 +- lisp/dgnushack.el | 2 +- lisp/gnus-art.el | 202 ++++++------ lisp/gnus-async.el | 2 +- lisp/gnus-audio.el | 4 +- lisp/gnus-bcklg.el | 5 +- lisp/gnus-cache.el | 135 ++++---- lisp/gnus-cite.el | 165 +++++----- lisp/gnus-demon.el | 16 +- lisp/gnus-ems.el | 69 ++-- lisp/gnus-gl.el | 362 +++++++++++---------- lisp/gnus-group.el | 236 +++++++------- lisp/gnus-int.el | 2 +- lisp/gnus-kill.el | 126 ++++---- lisp/gnus-load.el | 9 +- lisp/gnus-logic.el | 24 +- lisp/gnus-move.el | 2 +- lisp/gnus-msg.el | 65 ++-- lisp/gnus-nocem.el | 6 +- lisp/gnus-picon.el | 28 +- lisp/gnus-range.el | 78 +++-- lisp/gnus-salt.el | 141 +++++---- lisp/gnus-score.el | 303 +++++++++--------- lisp/gnus-setup.el | 125 ++++---- lisp/gnus-soup.el | 126 ++++---- lisp/gnus-spec.el | 3 +- lisp/gnus-srvr.el | 74 +++-- lisp/gnus-start.el | 345 ++++++++++---------- lisp/gnus-sum.el | 752 +++++++++++++++++++++++--------------------- lisp/gnus-topic.el | 39 ++- lisp/gnus-util.el | 38 ++- lisp/gnus-uu.el | 465 ++++++++++++++------------- lisp/gnus-vm.el | 8 +- lisp/gnus-win.el | 45 ++- lisp/gnus-xmas.el | 69 ++-- lisp/gnus.el | 70 +++-- lisp/message.el | 3 +- lisp/nnbabyl.el | 104 +++--- lisp/nndb.el | 10 +- lisp/nndoc.el | 15 +- lisp/nndraft.el | 4 +- lisp/nneething.el | 54 ++-- lisp/nnfolder.el | 200 ++++++------ lisp/nnheader.el | 32 +- lisp/nnheaderxm.el | 44 ++- lisp/nnkiboze.el | 37 ++- lisp/nnmail.el | 118 +++---- lisp/nnmbox.el | 199 ++++++------ lisp/nnmh.el | 85 ++--- lisp/nnml.el | 84 ++--- lisp/nnoo.el | 8 +- lisp/nnsoup.el | 27 +- lisp/nnspool.el | 14 +- lisp/nntp.el | 28 +- lisp/nnvirtual.el | 20 +- lisp/nnweb.el | 9 +- lisp/widget-edit.el | 14 +- texi/ChangeLog | 5 + texi/gnus.texi | 18 +- texi/message.texi | 5 +- 62 files changed, 2743 insertions(+), 2609 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 13e1ca99c..609eb7e5c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,49 @@ +Tue Oct 1 03:41:17 1996 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-glyph-hashtb): Made into hashtb. + +Tue Oct 1 01:50:10 1996 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-new-mail): New function. + (gnus-new-mail-mark): New variable. + + * nnmail.el (nnmail-new-mail-p): New function. + + * gnus-xmas.el (gnus-xmas-splash): New function. + +Tue Oct 1 01:36:17 1996 Raja R. Harinath + + * gnus-score.el (gnus-all-score-files): Didn't handle alist. + + * gnus-gl.el: Dropped `bbb-alist'. Changed cl-hashtable to obarray, + using gnus-{get,set}hash to access it. Dropped a few temp. bindings + Changed (aref (assoc "message-id" ...) ...) to (mail-header-id ...). + +Mon Sep 30 00:02:13 1996 Lars Magne Ingebrigtsen + + * gnus.el: General (and major) indentation, breaking, + if/when/unless/and/or, push revision. + + * gnus-sum.el (gnus-read-header): Set buffer before changing + vars. + +Sun Sep 29 23:20:26 1996 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-write-buffer): New function. + +Sun Sep 29 23:05:33 1996 Kurt Swanson + + * gnus-sum.el (gnus-handle-ephemeral-exit): New function. + +Sun Sep 29 22:41:01 1996 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-possibly-enter-article): Allow making + articles persistent in uncacheable groups. + +Sun Sep 29 01:23:43 1996 Lars Magne Ingebrigtsen + + * gnus.el: Red Gnus v0.45 is released. + Sun Sep 29 00:57:13 1996 Dave Disser * gnus-sum.el (gnus-summary-display-article): Don't show tree diff --git a/lisp/article.el b/lisp/article.el index aa2e79e31..f4b9196a5 100644 --- a/lisp/article.el +++ b/lisp/article.el @@ -42,7 +42,9 @@ "All headers that match this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `article-visible-headers' is non-nil, this variable will be ignored." - :type '(repeat string) ;Leave monster regexp to lisp. + :type '(choice :custom-show nil + regexp + (repeat regexp)) :group 'article) (defcustom gnus-visible-headers @@ -53,7 +55,9 @@ If `article-visible-headers' is non-nil, this variable will be ignored." "All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-article-ignored-headers' will be ignored." - :type '(repeat string) ;Leave monster regexp to lisp. + :type '(choice :custom-show nil + (repeat regexp) + regexp) :group 'article) (defcustom gnus-sorted-header-list @@ -63,18 +67,18 @@ If this variable is non-nil, `gnus-article-ignored-headers' will be ignored." If it is non-nil, headers that match the regular expressions will be placed first in the article buffer in the sequence specified by this list." - :type '(repeat string) + :type '(repeat regexp) :group 'article) (defcustom gnus-boring-article-headers '(empty followup-to reply-to) "Headers that are only to be displayed if they have interesting data. Possible values in this list are `empty', `newsgroups', `followup-to', `reply-to', and `date'." - :type '(set (item :tag "Headers with no content." empty) - (item :tag "Newsgroups with only one group." newsgroups) - (item :tag "Followup-to identical to newsgroups." followup-to) - (item :tag "Reply-to identical to from." reply-to) - (item :tag "Date less than four days old." date)) + :type '(set (const :tag "Headers with no content." empty) + (const :tag "Newsgroups with only one group." newsgroups) + (const :tag "Followup-to identical to newsgroups." followup-to) + (const :tag "Reply-to identical to from." reply-to) + (const :tag "Date less than four days old." date)) :group 'article) (defcustom gnus-signature-separator '("^-- $" "^-- *$") @@ -93,7 +97,7 @@ longer (in lines) than that number. If it is a function, the function will be called without any parameters, and if it returns nil, there is no signature in the buffer. If it is a string, it will be used as a regexp. If it matches, the text in question is not a signature." - :type '(choice integer number function string) + :type '(choice integer number function regexp) :group 'article) (defcustom gnus-hidden-properties '(invisible t intangible t) @@ -476,8 +480,8 @@ always hide." (point-max)) (subst-char-in-region (point-min) (point-max) ?_ ? ) (goto-char (point-max))) - (if (looking-at "\\([ \t\n]+\\)=\\?") - (replace-match "" t t nil 1)) + (when (looking-at "\\([ \t\n]+\\)=\\?") + (replace-match "" t t nil 1)) (goto-char (point-min)))))) (defun article-de-quoted-unreadable (&optional force) diff --git a/lisp/custom-edit.el b/lisp/custom-edit.el index ed7385f4a..1145a0575 100644 --- a/lisp/custom-edit.el +++ b/lisp/custom-edit.el @@ -607,7 +607,7 @@ Optional EVENT is the location for the menu." (child (car (widget-get widget :children)))) (unless (get symbol 'saved-face) (error "No saved value for this face") - (widget-value-set child (get symbol 'saved-face))))) + (widget-value-set child (get symbol 'saved-face))))) (defun custom-face-factory (widget) "Restore WIDGET to the face's factory settings." diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index c04fda8fa..f3e48101b 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -36,7 +36,7 @@ (defalias 'ange-ftp-re-read-dir 'ignore) (defun dgnushack-compile () - ;(setq byte-compile-dynamic t) + ;;(setq byte-compile-dynamic t) (let ((files (directory-files "." nil ".el$")) (xemacs (string-match "XEmacs" emacs-version)) ;;(byte-compile-generate-call-tree t) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 2ec6f1567..5c46531ca 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -361,9 +361,10 @@ displayed by the first non-nil matching CONTENT face." nil) (t file))) (gnus-number-of-articles-to-be-saved - (when (eq gnus-prompt-before-saving t) num))) ; Magic + (when (eq gnus-prompt-before-saving t) + num))) ; Magic (set-buffer gnus-summary-buffer) - (funcall gnus-default-article-saver filename))))) + (funcall gnus-default-article-saver filename))))) (defun gnus-read-save-file-name (prompt default-name &optional filename) (cond @@ -509,8 +510,8 @@ The directory to save in defaults to `gnus-article-save-directory'." (save-restriction (widen) (goto-char (point-min)) - (and (search-forward "\n\n" nil t) - (narrow-to-region (point) (point-max))) + (when (search-forward "\n\n" nil t) + (narrow-to-region (point) (point-max))) (gnus-output-to-file filename)))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-file filename))) @@ -525,8 +526,8 @@ The directory to save in defaults to `gnus-article-save-directory'." (command command) (t (read-string "Shell command on article: " gnus-last-shell-command)))) - (if (string-equal command "") - (setq command gnus-last-shell-command)) + (when (string-equal command "") + (setq command gnus-last-shell-command)) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) @@ -537,9 +538,9 @@ The directory to save in defaults to `gnus-article-save-directory'." (defun gnus-capitalize-newsgroup (newsgroup) "Capitalize NEWSGROUP name." - (and (not (zerop (length newsgroup))) - (concat (char-to-string (upcase (aref newsgroup 0))) - (substring newsgroup 1)))) + (when (not (zerop (length newsgroup))) + (concat (char-to-string (upcase (aref newsgroup 0))) + (substring newsgroup 1)))) (defun gnus-Numeric-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. @@ -806,41 +807,41 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;; The result from the `request' was an actual article - ;; or at least some text that is now displayed in the ;; article buffer. - (if (and (numberp article) - (not (eq article gnus-current-article))) - ;; Seems like a new article has been selected. - ;; `gnus-current-article' must be an article number. - (save-excursion - (set-buffer summary-buffer) - (setq gnus-last-article gnus-current-article - gnus-newsgroup-history (cons gnus-current-article - gnus-newsgroup-history) - gnus-current-article article - gnus-current-headers - (gnus-summary-article-header gnus-current-article) - gnus-article-current - (cons gnus-newsgroup-name gnus-current-article)) - (unless (vectorp gnus-current-headers) - (setq gnus-current-headers nil)) - (gnus-summary-show-thread) - (run-hooks 'gnus-mark-article-hook) - (gnus-set-mode-line 'summary) - (and (gnus-visual-p 'article-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook)) - ;; Set the global newsgroup variables here. - ;; Suggested by Jim Sisolak - ;; . - (gnus-set-global-variables) - (setq gnus-have-all-headers - (or all-headers gnus-show-all-headers)) - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (gnus-cache-possibly-enter-article - group article - (gnus-summary-article-header article) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))))) + (when (and (numberp article) + (not (eq article gnus-current-article))) + ;; Seems like a new article has been selected. + ;; `gnus-current-article' must be an article number. + (save-excursion + (set-buffer summary-buffer) + (setq gnus-last-article gnus-current-article + gnus-newsgroup-history (cons gnus-current-article + gnus-newsgroup-history) + gnus-current-article article + gnus-current-headers + (gnus-summary-article-header gnus-current-article) + gnus-article-current + (cons gnus-newsgroup-name gnus-current-article)) + (unless (vectorp gnus-current-headers) + (setq gnus-current-headers nil)) + (gnus-summary-show-thread) + (run-hooks 'gnus-mark-article-hook) + (gnus-set-mode-line 'summary) + (when (gnus-visual-p 'article-highlight 'highlight) + (run-hooks 'gnus-visual-mark-article-hook)) + ;; Set the global newsgroup variables here. + ;; Suggested by Jim Sisolak + ;; . + (gnus-set-global-variables) + (setq gnus-have-all-headers + (or all-headers gnus-show-all-headers)) + (and gnus-use-cache + (vectorp (gnus-summary-article-header article)) + (gnus-cache-possibly-enter-article + group article + (gnus-summary-article-header article) + (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-dormant) + (memq article gnus-newsgroup-unreads))))) (when (or (numberp article) (stringp article)) ;; Hooks for getting information from the article. @@ -849,16 +850,17 @@ If ALL-HEADERS is non-nil, no headers are hidden." (run-hooks 'internal-hook) (run-hooks 'gnus-article-prepare-hook) ;; Decode MIME message. - (if gnus-show-mime - (if (or (not gnus-strict-mime) - (gnus-fetch-field "Mime-Version")) - (funcall gnus-show-mime-method) - (funcall gnus-decode-encoded-word-method))) + (when gnus-show-mime + (if (or (not gnus-strict-mime) + (gnus-fetch-field "Mime-Version")) + (funcall gnus-show-mime-method) + (funcall gnus-decode-encoded-word-method))) ;; Perform the article display hooks. (run-hooks 'gnus-article-display-hook)) ;; Do page break. (goto-char (point-min)) - (and gnus-break-pages (gnus-narrow-to-page))) + (when gnus-break-pages + (gnus-narrow-to-page))) (gnus-set-mode-line 'article) (gnus-configure-windows 'article) (goto-char (point-min)) @@ -913,7 +915,7 @@ Provided for backwards compatibility." (set-buffer file-buffer) (rmail-insert-rmail-file-header) (let ((require-final-newline nil)) - (write-region (point-min) (point-max) file-name t 1))) + (gnus-write-buffer file-name))) (kill-buffer file-buffer)) (error "Output file does not exist"))) (set-buffer tmpbuf) @@ -931,19 +933,18 @@ Provided for backwards compatibility." (msg (and (boundp 'rmail-current-message) (symbol-value 'rmail-current-message)))) ;; If MSG is non-nil, buffer is in RMAIL mode. - (if msg - (progn (widen) - (narrow-to-region (point-max) (point-max)))) + (when msg + (widen) + (narrow-to-region (point-max) (point-max))) (insert-buffer-substring tmpbuf) - (if msg - (progn - (goto-char (point-min)) - (widen) - (search-backward "\^_") - (narrow-to-region (point) (point-max)) - (goto-char (1+ (point-min))) - (rmail-count-new-messages t) - (rmail-show-message msg))))))) + (when msg + (goto-char (point-min)) + (widen) + (search-backward "\^_") + (narrow-to-region (point) (point-max)) + (goto-char (1+ (point-min))) + (rmail-count-new-messages t) + (rmail-show-message msg)))))) (kill-buffer tmpbuf))) (defun gnus-output-to-file (file-name) @@ -1173,8 +1174,8 @@ If given a prefix, show the hidden text instead." (defun gnus-article-maybe-highlight () "Do some article highlighting if `article-visual' is non-nil." - (if (gnus-visual-p 'article-highlight 'highlight) - (gnus-article-highlight-some))) + (when (gnus-visual-p 'article-highlight 'highlight) + (gnus-article-highlight-some))) (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." @@ -1208,23 +1209,23 @@ If given a prefix, show the hidden text instead." (save-excursion (set-buffer gnus-summary-buffer) (let ((header (gnus-summary-article-header article))) - (if (< article 0) - (cond - ((memq article gnus-newsgroup-sparse) - ;; This is a sparse gap article. - (setq do-update-line article) - (setq article (mail-header-id header)) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article)) - (setq gnus-newsgroup-sparse - (delq article gnus-newsgroup-sparse))) - ((vectorp header) - ;; It's a real article. - (setq article (mail-header-id header))) - (t - ;; It is an extracted pseudo-article. - (setq article 'pseudo) - (gnus-request-pseudo-article header)))) + (when (< article 0) + (cond + ((memq article gnus-newsgroup-sparse) + ;; This is a sparse gap article. + (setq do-update-line article) + (setq article (mail-header-id header)) + (let ((gnus-override-method gnus-refer-article-method)) + (gnus-read-header article)) + (setq gnus-newsgroup-sparse + (delq article gnus-newsgroup-sparse))) + ((vectorp header) + ;; It's a real article. + (setq article (mail-header-id header))) + (t + ;; It is an extracted pseudo-article. + (setq article 'pseudo) + (gnus-request-pseudo-article header)))) (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) @@ -1232,10 +1233,9 @@ If given a prefix, show the hidden text instead." () (let ((dir (concat (file-name-as-directory (nth 1 method)) (mail-header-subject header)))) - (if (file-directory-p dir) - (progn - (setq article 'nneething) - (gnus-group-enter-directory dir))))))))) + (when (file-directory-p dir) + (setq article 'nneething) + (gnus-group-enter-directory dir)))))))) (cond ;; Refuse to select canceled articles. @@ -1545,7 +1545,8 @@ call it with the value of the `gnus-data' text property." (let* ((pos (posn-point (event-start event))) (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) - (if fun (funcall fun data)))) + (when fun + (funcall fun data)))) (defun gnus-article-press-button () "Check text at point for a callback function. @@ -1554,7 +1555,8 @@ call it with the value of the `gnus-data' text property." (interactive) (let* ((data (get-text-property (point) 'gnus-data)) (fun (get-text-property (point) 'gnus-callback))) - (if fun (funcall fun data)))) + (when fun + (funcall fun data)))) (defun gnus-article-prev-button (n) "Move point to N buttons backward. @@ -1640,8 +1642,8 @@ do the highlighting. See the documentation for those functions." (not (eobp))) (beginning-of-line) (setq from (point)) - (or (search-forward ":" nil t) - (forward-char 1)) + (unless (search-forward ":" nil t) + (forward-char 1)) (when (and header-face (not (memq (point) hpoints))) (push (point) hpoints) @@ -1742,11 +1744,11 @@ specified by `gnus-button-alist'." (end (match-end (nth 1 entry))) (form (nth 2 entry))) (goto-char (match-end 0)) - (and (eval form) - (gnus-article-add-button - start end (nth 3 entry) - (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry))))))) + (when (eval form) + (gnus-article-add-button + start end (nth 3 entry) + (buffer-substring (match-beginning (nth 4 entry)) + (match-end (nth 4 entry))))))) (goto-char end)))) (widen))) @@ -1754,9 +1756,9 @@ specified by `gnus-button-alist'." (defun gnus-article-add-button (from to fun &optional data) "Create a button between FROM and TO with callback FUN and data DATA." - (and gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay from to) + 'face gnus-article-button-face)) (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face @@ -1794,7 +1796,7 @@ specified by `gnus-button-alist'." (let* ((entry (gnus-button-entry)) (inhibit-point-motion-hooks t) (fun (nth 3 entry)) - (args (mapcar (lambda (group) + (args (mapcar (lambda (group) (let ((string (buffer-substring (match-beginning group) (match-end group)))) @@ -1904,7 +1906,7 @@ specified by `gnus-button-alist'." (let ((win (selected-window))) (select-window (get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) - (select-window win))) + (select-window win))) (provide 'gnus-art) diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 013ff5ab6..012106655 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -147,7 +147,7 @@ It should return non-nil if the article is to be prefetched.") (data (gnus-data-find-list article)) d) (while (and (setq d (pop data)) - (if (numberp n) + (if (numberp n) (natnump (decf n)) n)) (unless (or (gnus-async-prefetched-article-entry diff --git a/lisp/gnus-audio.el b/lisp/gnus-audio.el index 2342bef52..e72804a3b 100644 --- a/lisp/gnus-audio.el +++ b/lisp/gnus-audio.el @@ -27,8 +27,8 @@ ;; You can safely ignore most of it until Red Gnus. **Evil Laugh** ;;; Code: -(if (null (boundp 'running-xemacs)) - (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) +(when (null (boundp 'running-xemacs)) + (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) (require 'nnheader) (eval-when-compile (require 'cl)) diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index 302448116..855ca66cb 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -70,13 +70,14 @@ (and (numberp gnus-keep-backlog) (>= (length gnus-backlog-articles) gnus-keep-backlog) (gnus-backlog-remove-oldest-article)) - (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) + (push ident gnus-backlog-articles) ;; Insert the new article. (save-excursion (set-buffer (gnus-backlog-buffer)) (let (buffer-read-only) (goto-char (point-max)) - (or (bolp) (insert "\n")) + (unless (bolp) + (insert "\n")) (setq b (point)) (insert-buffer-substring buffer) ;; Tag the beginning of the article with the ident. diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index cca9609e2..048056905 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -90,32 +90,28 @@ variable to \"^nnml\".") (defun gnus-cache-save-buffers () ;; save the overview buffer if it exists and has been modified ;; delete empty cache subdirectories - (if (null gnus-cache-buffer) - () + (when gnus-cache-buffer (let ((buffer (cdr gnus-cache-buffer)) (overview-file (gnus-cache-file-name (car gnus-cache-buffer) ".overview"))) ;; write the overview only if it was modified - (if (buffer-modified-p buffer) - (save-excursion - (set-buffer buffer) - (if (> (buffer-size) 0) - ;; non-empty overview, write it out - (progn - (gnus-make-directory (file-name-directory overview-file)) - (write-region (point-min) (point-max) - overview-file nil 'quietly)) - ;; empty overview file, remove it - (and (file-exists-p overview-file) - (delete-file overview-file)) - ;; if possible, remove group's cache subdirectory - (condition-case nil - ;; FIXME: we can detect the error type and warn the user - ;; of any inconsistencies (articles w/o nov entries?). - ;; for now, just be conservative...delete only if safe -- sj - (delete-directory (file-name-directory overview-file)) - (error nil))))) - ;; kill the buffer, it's either unmodified or saved + (when (buffer-modified-p buffer) + (save-excursion + (set-buffer buffer) + (if (> (buffer-size) 0) + ;; Non-empty overview, write it to a file. + (gnus-write-buffer overview-file) + ;; Empty overview file, remove it + (when (file-exists-p overview-file) + (delete-file overview-file)) + ;; If possible, remove group's cache subdirectory. + (condition-case nil + ;; FIXME: we can detect the error type and warn the user + ;; of any inconsistencies (articles w/o nov entries?). + ;; for now, just be conservative...delete only if safe -- sj + (delete-directory (file-name-directory overview-file)) + (error nil))))) + ;; Kill the buffer -- it's either unmodified or saved. (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) @@ -124,7 +120,8 @@ variable to \"^nnml\".") (when (and (or force (not (eq gnus-use-cache 'passive))) (numberp article) (> article 0) - (vectorp headers)) ; This might be a dummy article. + (vectorp headers)) + ; This might be a dummy article. ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) (let ((result (nnvirtual-find-group-art @@ -135,11 +132,12 @@ variable to \"^nnml\".") (let ((number (mail-header-number headers)) file dir) (when (and (> number 0) ; Reffed article. - (or (not gnus-uncacheable-groups) - (not (string-match gnus-uncacheable-groups group))) (or force - (gnus-cache-member-of-class - gnus-cache-enter-articles ticked dormant unread)) + (and (or (not gnus-uncacheable-groups) + (not (string-match + gnus-uncacheable-groups group))) + (gnus-cache-member-of-class + gnus-cache-enter-articles ticked dormant unread))) (not (file-exists-p (setq file (gnus-cache-file-name group number))))) ;; Possibly create the cache directory. @@ -152,25 +150,25 @@ variable to \"^nnml\".") (let ((gnus-use-cache nil)) (gnus-request-article-this-buffer number group)) (when (> (buffer-size) 0) - (write-region (point-min) (point-max) file nil 'quiet) + (gnus-write-buffer file) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-max)) (forward-line -1) (while (condition-case () - (and (not (bobp)) - (> (read (current-buffer)) number)) + (when (not (bobp)) + (> (read (current-buffer)) number)) (error ;; The line was malformed, so we just remove it!! (gnus-delete-line) t)) (forward-line -1)) - (if (bobp) + (if (bobp) (if (not (eobp)) (progn (beginning-of-line) - (if (< (read (current-buffer)) number) - (forward-line 1))) + (when (< (read (current-buffer)) number) + (forward-line 1))) (beginning-of-line)) (forward-line 1)) (beginning-of-line) @@ -219,14 +217,14 @@ variable to \"^nnml\".") article) (gnus-cache-change-buffer gnus-newsgroup-name) (while articles - (if (memq (setq article (pop articles)) cache-articles) - ;; The article was in the cache, so we see whether we are - ;; supposed to remove it from the cache. - (gnus-cache-possibly-remove-article - article (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (or (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected)))))) + (when (memq (setq article (pop articles)) cache-articles) + ;; The article was in the cache, so we see whether we are + ;; supposed to remove it from the cache. + (gnus-cache-possibly-remove-article + article (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-dormant) + (or (memq article gnus-newsgroup-unreads) + (memq article gnus-newsgroup-unselected)))))) ;; The overview file might have been modified, save it ;; safe because we're only called at group exit anyway. (gnus-cache-save-buffers))) @@ -359,21 +357,21 @@ Returns the list of articles removed." ;; Another overview cache is current, save it. (gnus-cache-save-buffers))) ;; if gnus-cache buffer is nil, create it - (or gnus-cache-buffer - ;; Create cache buffer - (save-excursion - (setq gnus-cache-buffer - (cons group - (set-buffer (get-buffer-create " *gnus-cache-overview*")))) - (buffer-disable-undo (current-buffer)) - ;; Insert the contents of this group's cache overview. - (erase-buffer) - (let ((file (gnus-cache-file-name group ".overview"))) - (and (file-exists-p file) - (insert-file-contents file))) - ;; We have a fresh (empty/just loaded) buffer, - ;; mark it as unmodified to save a redundant write later. - (set-buffer-modified-p nil)))) + (unless gnus-cache-buffer + ;; Create cache buffer + (save-excursion + (setq gnus-cache-buffer + (cons group + (set-buffer (get-buffer-create " *gnus-cache-overview*")))) + (buffer-disable-undo (current-buffer)) + ;; Insert the contents of this group's cache overview. + (erase-buffer) + (let ((file (gnus-cache-file-name group ".overview"))) + (when (file-exists-p file) + (insert-file-contents file))) + ;; We have a fresh (empty/just loaded) buffer, + ;; mark it as unmodified to save a redundant write later. + (set-buffer-modified-p nil)))) ;; Return whether an article is a member of a class. (defun gnus-cache-member-of-class (class ticked dormant unread) @@ -423,11 +421,11 @@ Returns the list of articles removed." (delete-file file) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-min)) - (if (or (looking-at (concat (int-to-string number) "\t")) - (search-forward (concat "\n" (int-to-string number) "\t") - (point-max) t)) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) + (when (or (looking-at (concat (int-to-string number) "\t")) + (search-forward (concat "\n" (int-to-string number) "\t") + (point-max) t)) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point))))) (setq gnus-newsgroup-cached (delq article gnus-newsgroup-cached)) (gnus-summary-update-secondary-mark article) @@ -437,7 +435,7 @@ Returns the list of articles removed." "Return a sorted list of cached articles in GROUP." (let ((dir (file-name-directory (gnus-cache-file-name group 1)))) (when (file-exists-p dir) - (sort (mapcar (lambda (name) (string-to-int name)) + (sort (mapcar (lambda (name) (string-to-int name)) (directory-files dir nil "^[0-9]+$" t)) '<)))) @@ -467,8 +465,9 @@ Returns the list of articles removed." (setq beg (progn (beginning-of-line) (point)) end (progn (end-of-line) (point))) (setq beg nil))) - (if beg (progn (insert-buffer-substring cache-buf beg end) - (insert "\n"))) + (when beg + (insert-buffer-substring cache-buf beg end) + (insert "\n")) (setq cached (cdr cached))) (kill-buffer cache-buf))) @@ -553,18 +552,14 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" (when (or force (and gnus-cache-active-hashtb gnus-cache-active-altered)) - (save-excursion - (gnus-set-work-buffer) + (nnheader-temp-write gnus-cache-active-file (mapatoms (lambda (sym) (when (and sym (boundp sym)) (insert (format "%s %d %d y\n" (symbol-name sym) (cdr (symbol-value sym)) (car (symbol-value sym)))))) - gnus-cache-active-hashtb) - (gnus-make-directory (file-name-directory gnus-cache-active-file)) - (write-region - (point-min) (point-max) gnus-cache-active-file nil 'silent)) + gnus-cache-active-hashtb)) ;; Mark the active hashtb as unaltered. (setq gnus-cache-active-altered nil))) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 42fcbfee0..6da934e24 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -182,11 +182,11 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps face (cdr (assoc prefix face-alist))) ;; Add attribution button. (goto-line number) - (if (re-search-forward gnus-cite-attribution-suffix - (save-excursion (end-of-line 1) (point)) - t) - (gnus-article-add-button (match-beginning 1) (match-end 1) - 'gnus-cite-toggle prefix)) + (when (re-search-forward gnus-cite-attribution-suffix + (save-excursion (end-of-line 1) (point)) + t) + (gnus-article-add-button (match-beginning 1) (match-end 1) + 'gnus-cite-toggle prefix)) ;; Highlight attribution line. (gnus-cite-add-face number skip face) (gnus-cite-add-face number skip gnus-cite-attribution-face)) @@ -377,23 +377,22 @@ See also the documentation for `gnus-article-highlight-citation'." (setq hiden (+ hiden (length (cdr (assoc (cdar atts) gnus-cite-prefix-alist)))) atts (cdr atts))) - (if (or force - (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) - (> hiden gnus-cite-hide-absolute))) - (progn - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hiden (car total) - total (cdr total)) - (goto-line hiden) - (or (assq hiden gnus-cite-attribution-alist) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties))))))))))) + (when (or force + (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) + (> hiden gnus-cite-hide-absolute))) + (setq atts gnus-cite-attribution-alist) + (while atts + (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) + atts (cdr atts)) + (while total + (setq hiden (car total) + total (cdr total)) + (goto-line hiden) + (unless (assq hiden gnus-cite-attribution-alist) + (gnus-add-text-properties + (point) (progn (forward-line 1) (point)) + (nconc (list 'article-type 'cite) + gnus-hidden-properties)))))))))) (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." @@ -418,7 +417,7 @@ See also the documentation for `gnus-article-highlight-citation'." gnus-cite-loose-prefix-alist nil gnus-cite-loose-attribution-alist nil) ;; Parse if not too large. - (if (and (not force) + (if (and (not force) gnus-cite-parse-max-size (> (buffer-size) gnus-cite-parse-max-size)) () @@ -431,8 +430,8 @@ See also the documentation for `gnus-article-highlight-citation'." ;; Parse current buffer searching for citation prefixes. (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (goto-char (point-max))) + (unless (search-forward "\n\n" nil t) + (goto-char (point-max))) (let ((line (1+ (count-lines (point-min) (point)))) (case-fold-search t) (max (save-excursion @@ -448,13 +447,13 @@ See also the documentation for `gnus-article-highlight-citation'." start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. - (if (looking-at gnus-supercite-regexp) - (if (match-end 1) - (setq end (1+ (match-end 1))) - (setq end (1+ begin)))) + (when (looking-at gnus-supercite-regexp) + (if (match-end 1) + (setq end (1+ (match-end 1))) + (setq end (1+ begin)))) ;; Ignore very long prefixes. - (if (> end (+ (point) gnus-cite-max-prefix)) - (setq end (+ (point) gnus-cite-max-prefix))) + (when (> end (+ (point) gnus-cite-max-prefix)) + (setq end (+ (point) gnus-cite-max-prefix))) (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) ;; Each prefix. (setq end (match-end 0) @@ -463,7 +462,7 @@ See also the documentation for `gnus-article-highlight-citation'." (setq entry (assoc prefix alist)) (if entry (setcdr entry (cons line (cdr entry))) - (setq alist (cons (list prefix line) alist))) + (push (list prefix line) alist)) (goto-char begin)) (goto-char start) (setq line (1+ line))) @@ -487,11 +486,10 @@ See also the documentation for `gnus-article-highlight-citation'." ;; longer in case it is an exact match for an attribution ;; line, but we don't remove the line from other ;; prefixes. - (setq gnus-cite-prefix-alist - (cons entry gnus-cite-prefix-alist))) + (push entry gnus-cite-prefix-alist)) (t - (setq gnus-cite-prefix-alist (cons entry - gnus-cite-prefix-alist)) + (push entry + gnus-cite-prefix-alist) ;; Remove articles from other prefixes. (let ((loop alist) current) @@ -514,9 +512,9 @@ See also the documentation for `gnus-article-highlight-citation'." ;; Check previous line for an attribution leader. (tag (progn (beginning-of-line 1) - (and (looking-at gnus-supercite-secondary-regexp) - (buffer-substring (match-beginning 1) - (match-end 1))))) + (when (looking-at gnus-supercite-secondary-regexp) + (buffer-substring (match-beginning 1) + (match-end 1))))) (in (progn (goto-char start) (and (re-search-backward gnus-cite-attribution-prefix @@ -527,31 +525,32 @@ See also the documentation for `gnus-article-highlight-citation'." (not (re-search-forward gnus-cite-attribution-suffix start t)) (count-lines (point-min) (1+ (point))))))) - (if (eq wrote in) - (setq in nil)) + (when (eq wrote in) + (setq in nil)) (goto-char end) - (setq gnus-cite-loose-attribution-alist - (cons (list wrote in prefix tag) - gnus-cite-loose-attribution-alist)))) + (push (list wrote in prefix tag) + gnus-cite-loose-attribution-alist))) ;; Find exact supercite citations. (gnus-cite-match-attributions 'small nil (lambda (prefix tag) - (if tag - (concat "\\`" - (regexp-quote prefix) "[ \t]*" - (regexp-quote tag) ">")))) + (when tag + (concat "\\`" + (regexp-quote prefix) "[ \t]*" + (regexp-quote tag) ">")))) ;; Find loose supercite citations after attributions. (gnus-cite-match-attributions 'small t (lambda (prefix tag) - (if tag (concat "\\<" - (regexp-quote tag) - "\\>")))) + (when tag + (concat "\\<" + (regexp-quote tag) + "\\>")))) ;; Find loose supercite citations anywhere. (gnus-cite-match-attributions 'small nil (lambda (prefix tag) - (if tag (concat "\\<" - (regexp-quote tag) - "\\>")))) + (when tag + (concat "\\<" + (regexp-quote tag) + "\\>")))) ;; Find nested citations after attributions. (gnus-cite-match-attributions 'small-if-unique t (lambda (prefix tag) @@ -566,11 +565,11 @@ See also the documentation for `gnus-article-highlight-citation'." (while alist (setq entry (car alist) alist (cdr alist)) - (if (< (length (cdr entry)) gnus-cite-minimum-match-count) - (setq gnus-cite-prefix-alist - (delq entry gnus-cite-prefix-alist) - gnus-cite-loose-prefix-alist - (delq entry gnus-cite-loose-prefix-alist))))) + (when (< (length (cdr entry)) gnus-cite-minimum-match-count) + (setq gnus-cite-prefix-alist + (delq entry gnus-cite-prefix-alist) + gnus-cite-loose-prefix-alist + (delq entry gnus-cite-loose-prefix-alist))))) ;; Find flat attributions. (gnus-cite-match-attributions 'first t nil) ;; Find any attributions (are we getting desperate yet?). @@ -632,27 +631,25 @@ See also the documentation for `gnus-article-highlight-citation'." () (setq gnus-cite-loose-attribution-alist (delq att gnus-cite-loose-attribution-alist)) - (setq gnus-cite-attribution-alist - (cons (cons wrote (car best)) gnus-cite-attribution-alist)) - (if in - (setq gnus-cite-attribution-alist - (cons (cons in (car best)) gnus-cite-attribution-alist))) - (if (memq best gnus-cite-loose-prefix-alist) - (let ((loop gnus-cite-prefix-alist) - (numbers (cdr best)) - current) - (setq gnus-cite-loose-prefix-alist - (delq best gnus-cite-loose-prefix-alist)) - (while loop - (setq current (car loop) - loop (cdr loop)) - (if (eq current best) - () - (setcdr current (gnus-set-difference (cdr current) numbers)) - (if (null (cdr current)) - (setq gnus-cite-loose-prefix-alist - (delq current gnus-cite-loose-prefix-alist) - atts (delq current atts))))))))))) + (push (cons wrote (car best)) gnus-cite-attribution-alist) + (when in + (push (cons in (car best)) gnus-cite-attribution-alist)) + (when (memq best gnus-cite-loose-prefix-alist) + (let ((loop gnus-cite-prefix-alist) + (numbers (cdr best)) + current) + (setq gnus-cite-loose-prefix-alist + (delq best gnus-cite-loose-prefix-alist)) + (while loop + (setq current (car loop) + loop (cdr loop)) + (if (eq current best) + () + (setcdr current (gnus-set-difference (cdr current) numbers)) + (when (null (cdr current)) + (setq gnus-cite-loose-prefix-alist + (delq current gnus-cite-loose-prefix-alist) + atts (delq current atts))))))))))) (defun gnus-cite-find-loose (prefix) ;; Return a list of loose attribution lines prefixed by PREFIX. @@ -662,8 +659,8 @@ See also the documentation for `gnus-article-highlight-citation'." (setq att (car atts) line (car att) atts (cdr atts)) - (if (string-equal (gnus-cite-find-prefix line) prefix) - (setq lines (cons line lines)))) + (when (string-equal (gnus-cite-find-prefix line) prefix) + (push line lines))) lines)) (defun gnus-cite-add-face (number prefix face) @@ -711,8 +708,8 @@ See also the documentation for `gnus-article-highlight-citation'." (while alist (setq entry (car alist) alist (cdr alist)) - (if (memq line (cdr entry)) - (setq prefix (car entry)))) + (when (memq line (cdr entry)) + (setq prefix (car entry)))) prefix)) (gnus-add-shutdown 'gnus-cache-close 'gnus) diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index 3ee19b8bb..7c5707594 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -59,7 +59,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's.") (defvar gnus-demon-idle-time 0) (defvar gnus-demon-handler-state nil) (defvar gnus-demon-is-idle nil) -(defvar gnus-demon-last-keys nil) +(defvar gnus-demon-last-keys nil) (eval-and-compile (autoload 'timezone-parse-date "timezone") @@ -80,7 +80,8 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's.") (setq gnus-demon-handlers (delq (assq function gnus-demon-handlers) gnus-demon-handlers)) - (or no-init (gnus-demon-init))) + (unless no-init + (gnus-demon-init))) (defun gnus-demon-init () "Initialize the Gnus daemon." @@ -108,8 +109,8 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's.") (defun gnus-demon-cancel () "Cancel any Gnus daemons." (interactive) - (and gnus-demon-timer - (nnheader-cancel-timer gnus-demon-timer)) + (when gnus-demon-timer + (nnheader-cancel-timer gnus-demon-timer)) (setq gnus-demon-timer nil gnus-use-demon nil) (condition-case () @@ -145,7 +146,8 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's.") (round (/ (if (< nseconds 0) (+ nseconds (* 60 60 24)) - nseconds) gnus-demon-timestep))))) + nseconds) + gnus-demon-timestep))))) (defun gnus-demon () "The Gnus daemon that takes care of running all Gnus handlers." @@ -164,8 +166,8 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's.") ((numberp (setq time (nth 1 handler))) ;; These handlers use a regular timeout mechanism. We decrease ;; the timer if it hasn't reached zero yet. - (or (zerop time) - (setcar (nthcdr 1 handler) (decf time))) + (unless (zerop time) + (setcar (nthcdr 1 handler) (decf time))) (and (zerop time) ; If the timer now is zero... (or (not (setq idle (nth 2 handler))) ; Don't care about idle. (and (numberp idle) ; Numerical idle... diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 8be400818..ab6c5caef 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -45,20 +45,20 @@ (defun gnus-mule-cite-add-face (number prefix face) ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (if face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (if (< from to) - (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) + (when face + (let ((inhibit-point-motion-hooks t) + from to) + (goto-line number) + (if (boundp 'MULE) + (forward-char (chars-in-string prefix)) + (forward-char (length prefix))) + (skip-chars-forward " \t") + (setq from (point)) + (end-of-line 1) + (skip-chars-backward " \t") + (setq to (point)) + (when (< from to) + (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) (defun gnus-mule-max-width-function (el max-width) (` (let* ((val (eval (, el))) @@ -131,14 +131,15 @@ pounce directly on the real variables themselves.")) ((or (not (boundp 'emacs-minor-version)) (< emacs-minor-version 30)) ;; Remove the `intangible' prop. - (let ((props (and (boundp 'gnus-hidden-properties) + (let ((props (and (boundp 'gnus-hidden-properties) gnus-hidden-properties))) (while (and props (not (eq (car (cdr props)) 'intangible))) (setq props (cdr props))) - (and props (setcdr props (cdr (cdr (cdr props)))))) - (or (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - (format "%s" (buffer-substring beg end))))) + (when props + (setcdr props (cdr (cdr (cdr props)))))) + (unless (fboundp 'buffer-substring-no-properties) + (defun buffer-substring-no-properties (beg end) + (format "%s" (buffer-substring beg end))))) ((boundp 'MULE) (provide 'gnusutil)))) @@ -150,16 +151,16 @@ pounce directly on the real variables themselves.")) (let ((funcs '(mouse-set-point set-face-foreground set-face-background x-popup-menu))) (while funcs - (or (fboundp (car funcs)) - (fset (car funcs) 'gnus-dummy-func)) + (unless (fboundp (car funcs)) + (fset (car funcs) 'gnus-dummy-func)) (setq funcs (cdr funcs)))))) - (or (fboundp 'file-regular-p) - (defun file-regular-p (file) - (and (not (file-directory-p file)) - (not (file-symlink-p file)) - (file-exists-p file)))) - (or (fboundp 'face-list) - (defun face-list (&rest args)))) + (unless (fboundp 'file-regular-p) + (defun file-regular-p (file) + (and (not (file-directory-p file)) + (not (file-symlink-p file)) + (file-exists-p file)))) + (unless (fboundp 'face-list) + (defun face-list (&rest args)))) (eval-and-compile (let ((case-fold-search t)) @@ -194,10 +195,10 @@ pounce directly on the real variables themselves.")) (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) (fset 'gnus-max-width-function 'gnus-mule-max-width-function) - (if (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) + (when (boundp 'gnus-check-before-posting) + (setq gnus-check-before-posting + (delq 'long-lines + (delq 'control-chars gnus-check-before-posting)))) (defun gnus-summary-line-format-spec () (insert gnus-tmp-unread gnus-tmp-replied @@ -209,8 +210,8 @@ pounce directly on the real variables themselves.")) gnus-tmp-opening-bracket (format "%4d: %-20s" gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string gnus-tmp-name 20) + (if (> (length gnus-tmp-name) 20) + (truncate-string gnus-tmp-name 20) gnus-tmp-name)) gnus-tmp-closing-bracket) (point)) diff --git a/lisp/gnus-gl.el b/lisp/gnus-gl.el index 194a815e5..2d4955e50 100644 --- a/lisp/gnus-gl.el +++ b/lisp/gnus-gl.el @@ -132,12 +132,13 @@ "*The line format spec in summary GroupLens mode buffers.") (defvar grouplens-pseudonym "" - "User's pseudonym. This pseudonym is obtained during the registration process") + "User's pseudonym. +This pseudonym is obtained during the registration process") (defvar grouplens-bbb-host "grouplens.cs.umn.edu" "Host where the bbbd is running" ) -(defvar grouplens-bbb-port 9000 +(defvar grouplens-bbb-port 9000 "Port where the bbbd is listening" ) (defvar grouplens-newsgroups @@ -149,7 +150,7 @@ "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc" "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x" "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" - "rec.food.recipes" "rec.humor") + "rec.food.recipes" "rec.humor") "*Groups that are part of the GroupLens experiment.") (defvar grouplens-prediction-display 'prediction-spot @@ -203,18 +204,12 @@ GroupLens scores can be combined with gnus scores in one of three ways. (defvar grouplens-rating-alist nil "Current set of message-id rating pairs") -(defvar grouplens-current-hashtable (make-hash-table :test 'equal :size 100)) -;; this seems like a pretty ugly way to get around the problem, but If -;; I don't do this, then the compiler complains when I call gethash -;; -(eval-when-compile (setq grouplens-current-hashtable - (make-hash-table :test 'equal :size 100))) +(defvar grouplens-current-hashtable nil + "A hashtable to hold predictions from the BBB") (defvar grouplens-current-group nil) -(defvar bbb-mid-list nil) - -(defvar bbb-alist nil) +;;(defvar bbb-alist nil) (defvar bbb-timeout-secs 10 "Number of seconds to wait for some response from the BBB. @@ -226,23 +221,39 @@ If this times out we give up and assume that something has died..." ) (defvar bbb-read-point) (defvar bbb-response-point) +(defun bbb-renew-hash-table () + (setq grouplens-current-hashtable (make-vector 100 0))) + +(bbb-renew-hash-table) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Utility Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun bbb-connect-to-bbbd (host port) - (unless grouplens-bbb-buffer - (setq grouplens-bbb-buffer + (unless grouplens-bbb-buffer + (setq grouplens-bbb-buffer (get-buffer-create (format " *BBBD trace: %s*" host))) (save-excursion (set-buffer grouplens-bbb-buffer) (make-local-variable 'bbb-read-point) + (make-local-variable 'bbb-response-point) (setq bbb-read-point (point-min)))) + + ;; if an old process is still running for some reason, kill it + (when grouplens-bbb-process + (condition-case () + (when (eq 'open (process-status grouplens-bbb-process)) + (set-process-buffer grouplens-bbb-process nil) + (delete-process grouplens-bbb-process)) + (error nil))) + ;; clear the trace buffer of old output (save-excursion (set-buffer grouplens-bbb-buffer) (erase-buffer)) + ;; open the connection to the server - (setq grouplens-bbb-process nil) (catch 'done (condition-case error (setq grouplens-bbb-process @@ -251,31 +262,27 @@ If this times out we give up and assume that something has died..." ) nil)) (and (null grouplens-bbb-process) (throw 'done nil)) - ;; (set-process-filter grouplens-bbb-process 'bbb-process-filter) (save-excursion (set-buffer grouplens-bbb-buffer) (setq bbb-read-point (point-min)) (or (bbb-read-response grouplens-bbb-process) (throw 'done nil)))) - grouplens-bbb-process) -;; (defun bbb-process-filter (process output) -;; (save-excursion -;; (set-buffer (bbb-process-buffer process)) -;; (goto-char (point-max)) -;; (insert output))) + ;; return the process + grouplens-bbb-process) (defun bbb-send-command (process command) (goto-char (point-max)) - (insert command) + (insert command) (insert "\r\n") (setq bbb-read-point (point)) (setq bbb-response-point (point)) (set-marker (process-mark process) (point)) ; process output also comes here (process-send-string process command) - (process-send-string process "\r\n")) + (process-send-string process "\r\n") + (process-send-eof process)) -(defun bbb-read-response (process) ; &optional return-response-string) +(defun bbb-read-response (process) "This function eats the initial response of OK or ERROR from the BBB." (let ((case-fold-search nil) match-end) @@ -296,32 +303,32 @@ If this times out we give up and assume that something has died..." ) (interactive) (setq grouplens-bbb-token nil) (if (not (equal grouplens-pseudonym "")) - (let ((bbb-process + (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) (if bbb-process - (save-excursion + (save-excursion (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process + (bbb-send-command bbb-process (concat "login " grouplens-pseudonym)) (if (bbb-read-response bbb-process) (setq grouplens-bbb-token (bbb-extract-token-number)) - (gnus-message 3 "Error: GroupLens login failed"))))) + (gnus-message 3 "Error: GroupLens login failed"))))) (gnus-message 3 "Error: you must set a pseudonym")) grouplens-bbb-token) (defun bbb-extract-token-number () (let ((token-pos (search-forward "token=" nil t) )) - (if (looking-at "[0-9]+") - (buffer-substring token-pos (match-end 0))))) + (when (looking-at "[0-9]+") + (buffer-substring token-pos (match-end 0))))) (gnus-add-shutdown 'bbb-logout 'gnus) (defun bbb-logout () "logout of bbb session" - (let ((bbb-process + (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) (if bbb-process - (save-excursion + (save-excursion (set-buffer (process-buffer bbb-process)) (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) (bbb-read-response bbb-process)) @@ -333,126 +340,109 @@ If this times out we give up and assume that something has died..." ) (defun bbb-build-mid-scores-alist (groupname) "this function can be called as part of the function to return the -list of score files to use. See the gnus variable +list of score files to use. See the gnus variable gnus-score-find-score-files-function. -*Note:* If you want to use grouplens scores along with calculated scores, +*Note:* If you want to use grouplens scores along with calculated scores, you should see the offset and scale variables. At this point, I don't recommend using both scores and grouplens predictions together." (setq grouplens-current-group groupname) - (if (member groupname grouplens-newsgroups) - (let* ((mid-list (bbb-get-all-mids)) - (predict-list (bbb-get-predictions mid-list groupname))) - (setq grouplens-previous-article nil) - ;; scores-alist should be a list of lists: - ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) - ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value - (list (list (list (append (list "message-id") predict-list))))) - nil)) + (when (member groupname grouplens-newsgroups) + (setq grouplens-previous-article nil) + ;; scores-alist should be a list of lists: + ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) + ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value + (list + (list + (list (append (list "message-id") + (bbb-get-predictions (bbb-get-all-mids) groupname))))))) (defun bbb-get-predictions (midlist groupname) "Ask the bbb for predictions, and build up the score alist." (if (or (null grouplens-bbb-token) (equal grouplens-bbb-token "0")) - (progn + (progn (gnus-message 3 "Error: You are not logged in to a BBB") - nil) + (ding)) (gnus-message 5 "Fetching Predictions...") - (let (predict-list - (predict-command (bbb-build-predict-command midlist groupname - grouplens-bbb-token)) - (bbb-process (bbb-connect-to-bbbd grouplens-bbb-host + (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process predict-command) - (if (bbb-read-response bbb-process) - (setq predict-list (bbb-get-prediction-response bbb-process)) - (gnus-message 1 "Invalid Token, login and try again") - (ding)))) - (setq bbb-alist predict-list)))) + (when bbb-process + (save-excursion + (set-buffer (process-buffer bbb-process)) + (bbb-send-command bbb-process + (bbb-build-predict-command midlist groupname + grouplens-bbb-token)) + (if (not (bbb-read-response bbb-process)) + (progn + (gnus-message 1 "Invalid Token, login and try again") + (ding)) + (bbb-get-prediction-response bbb-process))))))) (defun bbb-get-all-mids () - (let ((index (nth 1 (assoc "message-id" gnus-header-index))) - (articles gnus-newsgroup-headers) - art this) - (setq bbb-mid-list nil) - (while articles - (progn (setq art (car articles) - this (aref art index) - articles (cdr articles)) - (setq bbb-mid-list (cons this bbb-mid-list)))) - bbb-mid-list)) + (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers)) (defun bbb-build-predict-command (mlist grpname token) - (let ((cmd (concat "getpredictions " token " " grpname "\r\n")) - art) - (while mlist - (setq art (car mlist) - cmd (concat cmd art "\r\n") - mlist (cdr mlist))) - (setq cmd (concat cmd ".\r\n")) - cmd)) + (concat "getpredictions " token " " grpname "\r\n" + (mapconcat 'identity mlist "\r\n") "\r\n.\r\n")) (defun bbb-get-prediction-response (process) - (let ((case-fold-search nil) - match-end) + (let ((case-fold-search nil)) (goto-char bbb-read-point) (while (and (not (search-forward ".\r\n" nil t)) (accept-process-output process bbb-timeout-secs)) (goto-char bbb-read-point)) - (setq match-end (point)) (goto-char (+ bbb-response-point 4));; we ought to be right before OK (bbb-build-response-alist))) ;; build-response-alist assumes that the cursor has been positioned at -;; the first line of the list of mid/rating pairs. For now we will -;; use a prediction of 99 to signify no prediction. Ultimately, we -;; should just ignore messages with no predictions. +;; the first line of the list of mid/rating pairs. (defun bbb-build-response-alist () - (let ((resp nil) - (match-end (point))) - (setq grouplens-current-hashtable (make-hash-table :test 'equal :size 100)) + (let (resp mid pred) (while - (cond ((looking-at "\\(<.*>\\) :nopred=") - (push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") - (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp) - (cl-puthash (bbb-get-mid) - (list (bbb-get-pred) (bbb-get-confl) (bbb-get-confh)) - grouplens-current-hashtable) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") - (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp) - (cl-puthash (bbb-get-mid) - (list (bbb-get-pred) 0 0) - grouplens-current-hashtable) - (forward-line 1) - t) - (t nil))) + (cond + ((looking-at "\\(<.*>\\) :nopred=") + ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) + (forward-line 1) + t) + ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") + (setq mid (bbb-get-mid) + pred (bbb-get-pred)) + (push `(,mid ,pred nil s) resp) + (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh)) + grouplens-current-hashtable) + (forward-line 1) + t) + ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") + (setq mid (bbb-get-mid) + pred (bbb-get-pred)) + (push `(,mid ,pred nil s) resp) + (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable) + (forward-line 1) + t) + (t nil))) resp)) -;; these two functions assume that there is an active match lying +;; these "get" functions assume that there is an active match lying ;; around. Where the first parenthesized expression is the -;; message-id, and the second is the prediction. Since gnus assumes -;; that scores are integer values?? we round the prediction. +;; message-id, and the second is the prediction, the third and fourth +;; are the confidence interval +;; +;; Since gnus assumes that scores are integer values?? we round the +;; prediction. (defun bbb-get-mid () (buffer-substring (match-beginning 1) (match-end 1))) (defun bbb-get-pred () - (let ((tpred (string-to-number (buffer-substring - (match-beginning 2) - (match-end 2))))) + (let ((tpred (string-to-number (buffer-substring (match-beginning 2) + (match-end 2))))) (if (> tpred 0) - (round (* grouplens-score-scale-factor (+ grouplens-score-offset tpred))) + (round (* grouplens-score-scale-factor + (+ grouplens-score-offset tpred))) 1))) (defun bbb-get-confl () - (string-to-number (buffer-substring (match-beginning 3) (match-end 3)))) + (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) (defun bbb-get-confh () (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) @@ -469,13 +459,13 @@ recommend using both scores and grouplens predictions together." (defun bbb-grouplens-score (header) (if (eq gnus-grouplens-override-scoring 'separate) (bbb-grouplens-other-score header) - (let* ((rate-string (make-string 12 ? )) - (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) - (hashent (gethash mid grouplens-current-hashtable)) + (let* ((rate-string (make-string 12 ?\ )) + (mid (mail-header-id header)) + (hashent (gnus-gethash mid grouplens-current-hashtable)) (iscore gnus-tmp-score) (low (car (cdr hashent))) (high (car (cdr (cdr hashent))))) - (aset rate-string 0 ?|) + (aset rate-string 0 ?|) (aset rate-string 11 ?|) (unless (member grouplens-current-group grouplens-newsgroups) (unless (equal grouplens-prediction-display 'prediction-num) @@ -483,9 +473,9 @@ recommend using both scores and grouplens predictions together." (setq iscore 1)) ((> iscore 5) (setq iscore 5)))) - (setq low 0) + (setq low 0) (setq high 0)) - (if (and (bbb-valid-score iscore) + (if (and (bbb-valid-score iscore) (not (null mid))) (cond ;; prediction-spot @@ -514,7 +504,6 @@ recommend using both scores and grouplens predictions together." (aset rate-string 5 ?N) (aset rate-string 6 ?A)) rate-string))) -;; ;; Gnus user format function that doesn't depend on ;; bbb-build-mid-scores-alist being used as the score function, but is ;; instead called from gnus-select-group-hook. -- LAB @@ -522,14 +511,14 @@ recommend using both scores and grouplens predictions together." (if (not (member grouplens-current-group grouplens-newsgroups)) ;; Return an empty string "" - (let* ((rate-string (make-string 12 ? )) - (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) - (hashent (gethash mid grouplens-current-hashtable)) + (let* ((rate-string (make-string 12 ?\ )) + (mid (mail-header-id header)) + (hashent (gnus-gethash mid grouplens-current-hashtable)) (pred (or (nth 0 hashent) 0)) (low (nth 1 hashent)) (high (nth 2 hashent))) ;; Init rate-string - (aset rate-string 0 ?|) + (aset rate-string 0 ?|) (aset rate-string 11 ?|) (unless (equal grouplens-prediction-display 'prediction-num) (cond ((< pred 0) @@ -538,8 +527,8 @@ recommend using both scores and grouplens predictions together." (setq pred 5)))) ;; If no entry in BBB hash mark rate string as NA and return (cond - ((null hashent) - (aset rate-string 5 ?N) + ((null hashent) + (aset rate-string 5 ?N) (aset rate-string 6 ?A) rate-string) @@ -566,7 +555,7 @@ recommend using both scores and grouplens predictions together." (t (gnus-message 3 "Invalid prediction display type") - (aset rate-string 0 ?|) + (aset rate-string 0 ?|) (aset rate-string 11 ?|) rate-string))))) @@ -602,14 +591,14 @@ recommend using both scores and grouplens predictions together." (bbb-fmt-prediction-num score))) (defun bbb-fmt-prediction-bar (rate-string score) - (let* ((i 1) + (let* ((i 1) (step (/ grplens-rating-range (- grplens-predstringsize 4))) (half-step (/ step 2)) (loc (- grplens-minrating half-step))) (while (< i (- grplens-predstringsize 2)) (if (> score loc) (aset rate-string i ?#) - (aset rate-string i ? )) + (aset rate-string i ?\ )) (setq i (+ i 1)) (setq loc (+ loc step))) ) @@ -622,9 +611,6 @@ recommend using both scores and grouplens predictions together." ;;;; Put Ratings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The message-id for the current article can be found in -;; (aref gnus-current-headers (nth 1 (assoc "message-id" gnus-header-index))) - (defun bbb-put-ratings () (if (and grouplens-rating-alist (member gnus-newsgroup-name grouplens-newsgroups)) @@ -646,15 +632,13 @@ recommend using both scores and grouplens predictions together." (setq grouplens-rating-alist nil))) (defun bbb-build-rate-command (rate-alist) - (let (this - (cmd (concat "putratings " grouplens-bbb-token - " " grouplens-current-group " \r\n"))) - (while rate-alist - (setq this (car rate-alist) - cmd (concat cmd (car this) " :rating=" (cadr this) ".00" - " :time=" (cddr this) "\r\n") - rate-alist (cdr rate-alist))) - (concat cmd ".\r\n"))) + (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n" + (mapconcat '(lambda (this) ; form (mid . (score . time)) + (concat (car this) + " :rating=" (cadr this) ".00" + " :time=" (cddr this))) + rate-alist "\r\n") + "\r\n.\r\n")) ;; Interactive rating functions. (defun bbb-summary-rate-article (rating &optional midin) @@ -662,26 +646,28 @@ recommend using both scores and grouplens predictions together." (when (member gnus-newsgroup-name grouplens-newsgroups) (let ((mid (or midin (bbb-get-current-id)))) (if (and rating - (>= rating grplens-minrating) + (>= rating grplens-minrating) (<= rating grplens-maxrating) mid) (let ((oldrating (assoc mid grouplens-rating-alist))) (if oldrating (setcdr oldrating (cons rating 0)) (push `(,mid . (,rating . 0)) grouplens-rating-alist)) - (gnus-summary-mark-article nil (int-to-string rating))) + (gnus-summary-mark-article nil (int-to-string rating))) (gnus-message 3 "Invalid rating"))))) (defun grouplens-next-unread-article (rating) "Select unread article after current one." (interactive "P") - (if rating (bbb-summary-rate-article rating)) + (when rating + (bbb-summary-rate-article rating)) (gnus-summary-next-unread-article)) (defun grouplens-best-unread-article (rating) "Select unread article after current one." (interactive "P") - (if rating (bbb-summary-rate-article rating)) + (when rating + (bbb-summary-rate-article rating)) (gnus-summary-best-unread-article)) (defun grouplens-summary-catchup-and-exit (rating) @@ -689,8 +675,8 @@ recommend using both scores and grouplens predictions together." then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") - (if rating - (bbb-summary-rate-article rating)) + (when rating + (bbb-summary-rate-article rating)) (if (numberp rating) (gnus-summary-catchup-and-exit) (gnus-summary-catchup-and-exit rating))) @@ -700,15 +686,14 @@ recommend using both scores and grouplens predictions together." (interactive "nRating: ") (let (e) (save-excursion - (let ((articles (gnus-summary-articles-in-thread))) - (while articles - (gnus-summary-goto-subject (car articles)) + (let ((articles (gnus-summary-articles-in-thread)) + article) + (while (setq article (pop articles)) + (gnus-summary-goto-subject article) (gnus-set-global-variables) (bbb-summary-rate-article score (mail-header-id - (gnus-summary-article-header - (car articles)))) - (setq articles (cdr articles)))) + (gnus-summary-article-header article))))) (setq e (point))) (let ((gnus-summary-check-current t)) (or (zerop (gnus-summary-next-subject 1 t)) @@ -717,11 +702,13 @@ recommend using both scores and grouplens predictions together." (gnus-summary-position-point) (gnus-set-mode-line 'summary)) +(defun bbb-exit-group () + (bbb-put-ratings) + (bbb-renew-hash-table)) (defun bbb-get-current-id () (if gnus-current-headers - (aref gnus-current-headers - (nth 1 (assoc "message-id" gnus-header-index))) + (mail-header-id gnus-current-headers) (gnus-message 3 "You must select an article before you rate it"))) (defun bbb-grouplens-group-p (group) @@ -741,7 +728,7 @@ recommend using both scores and grouplens predictions together." (- et (bbb-time-float grouplens-current-starting-time)))) (defun bbb-time-float (timeval) - (+ (* (car timeval) 65536) + (+ (* (car timeval) 65536) (cadr timeval))) (defun grouplens-do-time () @@ -761,7 +748,7 @@ recommend using both scores and grouplens predictions together." ;; BUG REPORTING ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst gnus-gl-version "gnus-gl.el 2.12") +(defconst gnus-gl-version "gnus-gl.el 2.50") (defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") (defun gnus-gl-submit-bug-report () "Submit via mail a bug report on gnus-gl" @@ -776,22 +763,19 @@ recommend using both scores and grouplens predictions together." 'grouplens-bbb-token 'grouplens-bbb-process 'grouplens-current-group - 'grouplens-previous-article - 'grouplens-mid-list - 'bbb-alist) + 'grouplens-previous-article) nil 'gnus-gl-get-trace)) (defun gnus-gl-get-trace () "Insert the contents of the BBBD trace buffer" - (if grouplens-bbb-buffer (insert-buffer grouplens-bbb-buffer))) - -;;; -;;; Additions to make gnus-grouplens-mode Warning Warning!! -;;; This version of the gnus-grouplens-mode does -;;; not work with gnus-5.x. The "old" way of -;;; setting up GroupLens still works however. -;;; + (when grouplens-bbb-buffer + (insert-buffer grouplens-bbb-buffer))) + +;; +;; GroupLens minor mode +;; + (defvar gnus-grouplens-mode nil "Minor mode for providing a GroupLens interface in Gnus summary buffers.") @@ -832,27 +816,31 @@ recommend using both scores and grouplens predictions together." (gnus-make-local-hook 'gnus-select-article-hook) (gnus-add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local) (gnus-make-local-hook 'gnus-exit-group-hook) - (gnus-add-hook 'gnus-exit-group-hook 'bbb-put-ratings nil 'local) + (gnus-add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) (make-local-variable 'gnus-score-find-score-files-function) - (cond ((eq gnus-grouplens-override-scoring 'combine) - ;; either add bbb-buld-mid-scores-alist to a list - ;; or make a list - (if (listp gnus-score-find-score-files-function) - (setq gnus-score-find-score-files-function - (append 'bbb-build-mid-scores-alist - gnus-score-find-score-files-function )) - (setq gnus-score-find-score-files-function - (list gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist)))) - ;; leave the gnus-score-find-score-files variable alone - ((eq gnus-grouplens-override-scoring 'separate) - (add-hook 'gnus-select-group-hook - '(lambda() - (bbb-build-mid-scores-alist gnus-newsgroup-name)))) - ;; default is to override - (t (setq gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist))) + (cond + ((eq gnus-grouplens-override-scoring 'combine) + ;; either add bbb-buld-mid-scores-alist to a list + ;; or make a list + (if (listp gnus-score-find-score-files-function) + (setq gnus-score-find-score-files-function + (append 'bbb-build-mid-scores-alist + gnus-score-find-score-files-function)) + (setq gnus-score-find-score-files-function + (list gnus-score-find-score-files-function + 'bbb-build-mid-scores-alist)))) + ;; leave the gnus-score-find-score-files variable alone + ((eq gnus-grouplens-override-scoring 'separate) + (add-hook 'gnus-select-group-hook + '(lambda () + (bbb-get-predictions (bbb-get-all-mids) + gnus-newsgroup-name)))) + ;; default is to override + (t + (setq gnus-score-find-score-files-function + 'bbb-build-mid-scores-alist))) + ;; Change how summary lines look (make-local-variable 'gnus-summary-line-format) (make-local-variable 'gnus-summary-line-format-spec) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index da5047e14..d368cce76 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -117,6 +117,7 @@ with some simple extensions. %p Process mark (char) %O Moderated group (string, \"(m)\" or \"\") %P Topic indentation (string) +%m Whether there is new(ish) mail in the group (char, \"%\") %l Whether there are GroupLens predictions for this group (string) %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used @@ -273,6 +274,8 @@ level: The level of the group. score: The score of the group. ticked: The number of ticked articles.") +(defvar gnus-new-mail-mark ?% + "Mark used for groups with new mail.") ;;; Internal variables @@ -295,7 +298,7 @@ ticked: The number of ticked articles.") (?S gnus-tmp-subscribed ?c) (?L gnus-tmp-level ?d) (?N (cond ((eq number t) "*" ) - ((numberp number) + ((numberp number) (int-to-string (+ number (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) @@ -320,6 +323,7 @@ ticked: The number of ticked articles.") (?P gnus-group-indentation ?s) (?l gnus-tmp-grouplens ?s) (?z gnus-tmp-news-method-string ?s) + (?m (gnus-group-new-mail gnus-tmp-group) ?c) (?u gnus-tmp-user-defined ?s))) (defvar gnus-group-mode-line-format-alist @@ -821,35 +825,35 @@ If REGEXP, only list groups matching REGEXP." (lowest (or lowest 1)) info clevel unread group params) (erase-buffer) - (if (< lowest gnus-level-zombie) - ;; List living groups. - (while newsrc - (setq info (car newsrc) - group (gnus-info-group info) - params (gnus-info-params info) - newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (and unread ; This group might be bogus - (or (not regexp) - (string-match regexp group)) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (or all ; We list all groups? - (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) ; We list groups with unread articles - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) + (when (< lowest gnus-level-zombie) + ;; List living groups. + (while newsrc + (setq info (car newsrc) + group (gnus-info-group info) + params (gnus-info-params info) + newsrc (cdr newsrc) + unread (car (gnus-gethash group gnus-newsrc-hashtb))) + (and unread ; This group might be bogus + (or (not regexp) + (string-match regexp group)) + (<= (setq clevel (gnus-info-level info)) level) + (>= clevel lowest) + (or all ; We list all groups? + (if (eq unread t) ; Unactivated? + gnus-group-list-inactive-groups ; We list unactivated + (> unread 0)) ; We list groups with unread articles + (and gnus-list-groups-with-ticked-articles + (cdr (assq 'tick (gnus-info-marks info)))) ; And groups with tickeds - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups - group)) - (memq 'visible params) - (cdr (assq 'visible params))) - (gnus-group-insert-group-line - group (gnus-info-level info) - (gnus-info-marks info) unread (gnus-info-method info))))) + ;; Check for permanent visibility. + (and gnus-permanently-visible-groups + (string-match gnus-permanently-visible-groups + group)) + (memq 'visible params) + (cdr (assq 'visible params))) + (gnus-group-insert-group-line + group (gnus-info-level info) + (gnus-info-marks info) unread (gnus-info-method info))))) ;; List dead groups. (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) @@ -904,7 +908,8 @@ If REGEXP, only list groups matching REGEXP." (not (gnus-ephemeral-group-p group)) (gnus-dribble-enter (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) ")"))) + (gnus-prin1-to-string (nth 2 entry)) + ")"))) (setq gnus-group-indentation (gnus-group-group-indentation)) (gnus-delete-line) (gnus-group-insert-group-line-info group) @@ -1052,11 +1057,11 @@ already." found buffer-read-only) ;; Enter the current status into the dribble buffer. (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (if (and entry (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")")))) + (when (and entry (not (gnus-ephemeral-group-p group))) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string (nth 2 entry)) + ")")))) ;; Find all group instances. If topics are in use, each group ;; may be listed in more than once. (while (setq loc (text-property-any @@ -1152,6 +1157,11 @@ already." "Get the number of unread articles of the newsgroup on the current line." (get-text-property (gnus-point-at-bol) 'gnus-unread)) +(defun gnus-group-new-mail (group) + (if (nnmail-new-mail-p group) + gnus-new-mail-mark + ? )) + (defun gnus-group-search-forward (&optional backward all level first-too) "Find the next newsgroup with unread articles. If BACKWARD is non-nil, find the previous newsgroup instead. @@ -1165,7 +1175,8 @@ If FIRST-TOO, the current line is also eligible as a target." pos found lev) (if (and backward (progn (beginning-of-line)) (bobp)) nil - (or first-too (forward-line way)) + (unless first-too + (forward-line way)) (while (and (not (eobp)) (not (setq @@ -1210,7 +1221,7 @@ If FIRST-TOO, the current line is also eligible as a target." (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (subst-char-in-region - (point) (1+ (point)) (following-char) + (point) (1+ (point)) (following-char) (if unmark (progn (setq gnus-group-marked (delete group gnus-group-marked)) @@ -1277,7 +1288,7 @@ Return nil if the group isn't displayed." (defun gnus-group-set-mark (group) "Set the process mark on GROUP." - (if (gnus-group-goto-group group) + (if (gnus-group-goto-group group) (save-excursion (gnus-group-mark-group 1 nil t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) @@ -1312,7 +1323,7 @@ Take into consideration N (the prefix) and the list of marked groups." (save-excursion (while (and (> n 0) (setq group (gnus-group-group-name))) - (setq groups (cons group groups)) + (push group groups) (setq n (1- n)) (gnus-group-next-group way))) (nreverse groups))) @@ -1407,8 +1418,8 @@ buffer." "Start Gnus if necessary and enter GROUP. Returns whether the fetching was successful or not." (interactive "sGroup name: ") - (or (get-buffer gnus-group-buffer) - (gnus)) + (unless (get-buffer gnus-group-buffer) + (gnus)) (gnus-group-read-group nil nil group)) ;; Enter a group that is not in the group buffer. Non-nil is returned @@ -1576,17 +1587,16 @@ If EXCLUDE-GROUP, do not go to that group." unread best-point) (while (not (eobp)) (setq unread (get-text-property (point) 'gnus-unread)) - (if (and (numberp unread) (> unread 0)) - (progn - (if (and (get-text-property (point) 'gnus-level) - (< (get-text-property (point) 'gnus-level) best) - (or (not exclude-group) - (not (equal exclude-group (gnus-group-group-name))))) - (progn - (setq best (get-text-property (point) 'gnus-level)) - (setq best-point (point)))))) + (when (and (numberp unread) (> unread 0)) + (when (and (get-text-property (point) 'gnus-level) + (< (get-text-property (point) 'gnus-level) best) + (or (not exclude-group) + (not (equal exclude-group (gnus-group-group-name))))) + (setq best (get-text-property (point) 'gnus-level)) + (setq best-point (point)))) (forward-line 1)) - (if best-point (goto-char best-point)) + (when best-point + (goto-char best-point)) (gnus-summary-position-point) (and best-point (gnus-group-group-name)))) @@ -1638,10 +1648,10 @@ ADDRESS." t) ;; Make it active. (gnus-set-active nname (cons 1 0)) - (or (gnus-ephemeral-group-p name) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (cdr info)) ")"))) + (unless (gnus-ephemeral-group-p name) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string (cdr info)) ")"))) ;; Insert the line. (gnus-group-insert-group-line-info nname) (forward-line -1) @@ -1654,8 +1664,8 @@ ADDRESS." gnus-valid-select-methods) (require backend)) (gnus-check-server meth) - (and (gnus-check-backend-function 'request-create-group nname) - (gnus-request-create-group nname nil args)) + (when (gnus-check-backend-function 'request-create-group nname) + (gnus-request-create-group nname nil args)) t)) (defun gnus-group-delete-group (group &optional force) @@ -1667,9 +1677,10 @@ doing the deletion." (interactive (list (gnus-group-group-name) current-prefix-arg)) - (or group (error "No group to rename")) - (or (gnus-check-backend-function 'request-delete-group group) - (error "This backend does not support group deletion")) + (unless group + (error "No group to rename")) + (unless (gnus-check-backend-function 'request-delete-group group) + (error "This backend does not support group deletion")) (prog1 (if (not (gnus-yes-or-no-p (format @@ -1923,8 +1934,10 @@ directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive (list (read-file-name "Create group from directory: "))) - (or (file-exists-p dir) (error "No such directory")) - (or (file-directory-p dir) (error "Not a directory")) + (unless (file-exists-p dir) + (error "No such directory")) + (unless (file-directory-p dir) + (error "Not a directory")) (let ((ext "") (i 0) group) @@ -1958,8 +1971,8 @@ score file entries for articles to include in the group." (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) - (setq regexps (cons (list regexp nil nil 'r) regexps))) - (setq scores (cons (cons header regexps) scores))) + (push (list regexp nil nil 'r) regexps)) + (push (cons header regexps) scores)) scores))) (gnus-group-make-group group "nnkiboze" address) (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) @@ -1972,8 +1985,8 @@ score file entries for articles to include in the group." (list current-prefix-arg (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t "nnvirtual:"))) - (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) - (error "%s is not an nnvirtual group" vgroup)) + (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) + (error "%s is not an nnvirtual group" vgroup)) (let* ((groups (gnus-group-process-prefix n)) (method (gnus-info-method (gnus-get-info vgroup)))) (setcar (cdr method) @@ -1992,8 +2005,8 @@ score file entries for articles to include in the group." (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. - (and (gnus-gethash pgroup gnus-newsrc-hashtb) - (error "Group %s already exists." pgroup)) + (when (gnus-gethash pgroup gnus-newsrc-hashtb) + (error "Group %s already exists." pgroup)) ;; Subscribe the new group after the group on the current line. (gnus-subscribe-group pgroup (gnus-group-group-name) method) (gnus-group-update-group pgroup) @@ -2246,9 +2259,9 @@ caught up is returned." (while groups ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) - (if (eq 'nnvirtual (car method)) - (nnvirtual-catchup-group - (gnus-group-real-name (car groups)) (nth 1 method) all))) + (when (eq 'nnvirtual (car method)) + (nnvirtual-catchup-group + (gnus-group-real-name (car groups)) (nth 1 method) all))) (gnus-group-remove-mark (car groups)) (if (>= (gnus-group-group-level) gnus-level-zombie) (gnus-message 2 "Dead groups can't be caught up") @@ -2349,14 +2362,14 @@ or nil if no action could be taken." (string-to-int (let ((s (read-string (format "Level (default %s): " - (or (gnus-group-group-level) + (or (gnus-group-group-level) gnus-level-default-subscribed))))) (if (string-match "^\\s-*$" s) - (int-to-string (or (gnus-group-group-level) + (int-to-string (or (gnus-group-group-level) gnus-level-default-subscribed)) s))))) - (or (and (>= level 1) (<= level gnus-level-killed)) - (error "Illegal level: %d" level)) + (unless (and (>= level 1) (<= level gnus-level-killed)) + (error "Illegal level: %d" level)) (let ((groups (gnus-group-process-prefix n)) group) (while (setq group (pop groups)) @@ -2437,8 +2450,8 @@ group line." (or (and (member group gnus-zombie-list) gnus-level-zombie) gnus-level-killed) - (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) + (when (gnus-group-group-name) + (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) (unless silent (gnus-group-update-group group))) (t (error "No such newsgroup: %s" group))) @@ -2449,8 +2462,8 @@ group line." If given a negative prefix, move down instead. The difference between N and the number of steps taken is returned." (interactive "p") - (or (gnus-group-group-name) - (error "No group on current line")) + (unless (gnus-group-group-name) + (error "No group on current line")) (gnus-group-kill-group 1) (prog1 (forward-line (- n)) @@ -2547,8 +2560,8 @@ is returned." (setq arg (or arg 1)) (let (info group prev out) (while (>= (decf arg) 0) - (if (not (setq info (pop gnus-list-of-killed-groups))) - (error "No more newsgroups to yank")) + (when (not (setq info (pop gnus-list-of-killed-groups))) + (error "No more newsgroups to yank")) (push (setq group (nth 1 info)) out) ;; Find which newsgroup to insert this one before - search ;; backward until something suitable is found. If there are no @@ -2647,7 +2660,7 @@ entail asking the server for the groups." (lambda (sym) (and (boundp sym) (symbol-value sym) - (setq list (cons (symbol-name sym) list)))) + (push (symbol-name sym) list))) gnus-active-hashtb) list) 'string<)) @@ -2703,7 +2716,8 @@ If N is negative, this group and the N-1 previous groups will be checked." (interactive "P") (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) - (beg (unless n (point))) + (beg (unless n + (point))) group) (while (setq group (pop groups)) (gnus-group-remove-mark group) @@ -2720,7 +2734,8 @@ If N is negative, this group and the N-1 previous groups will be checked." 'denied) (gnus-error 3 "Server denied access") (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) - (when beg (goto-char beg)) + (when beg + (goto-char beg)) (when gnus-goto-next-group-when-activating (gnus-group-next-unread-group 1 t)) (gnus-summary-position-point) @@ -2762,25 +2777,27 @@ to use." (when (and force gnus-description-hashtb) (gnus-sethash mname nil gnus-description-hashtb)) - (or group (error "No group name given")) - (and (or (and gnus-description-hashtb - ;; We check whether this group's method has been - ;; queried for a description file. - (gnus-gethash mname gnus-description-hashtb)) - (setq desc (gnus-group-get-description group)) - (gnus-read-descriptions-file method)) - (gnus-message 1 - (or desc (gnus-gethash group gnus-description-hashtb) - "No description available"))))) + (unless group + (error "No group name given")) + (when (or (and gnus-description-hashtb + ;; We check whether this group's method has been + ;; queried for a description file. + (gnus-gethash mname gnus-description-hashtb)) + (setq desc (gnus-group-get-description group)) + (gnus-read-descriptions-file method)) + (gnus-message 1 + (or desc (gnus-gethash group gnus-description-hashtb) + "No description available"))))) ;; Suggested by Per Abrahamsen . (defun gnus-group-describe-all-groups (&optional force) "Pop up a buffer with descriptions of all newsgroups." (interactive "P") - (and force (setq gnus-description-hashtb nil)) - (if (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) + (when force + (setq gnus-description-hashtb nil)) + (when (not (or gnus-description-hashtb + (gnus-read-all-descriptions-files))) + (error "Couldn't request descriptions file")) (let ((buffer-read-only nil) b) (erase-buffer) @@ -2809,7 +2826,7 @@ to use." (lambda (group) (and (symbol-name group) (string-match regexp (symbol-name group)) - (setq groups (cons (symbol-name group) groups)))) + (push (symbol-name group) groups))) gnus-active-hashtb) ;; Also go through all descriptions that are known to Gnus. (when search-description @@ -2817,7 +2834,7 @@ to use." (lambda (group) (and (string-match regexp (symbol-value group)) (gnus-active (symbol-name group)) - (setq groups (cons (symbol-name group) groups)))) + (push (symbol-name group) groups))) gnus-description-hashtb)) (if (not groups) (gnus-message 3 "No groups matched \"%s\"." regexp) @@ -2829,13 +2846,12 @@ to use." (setq groups (sort groups 'string<)) (while groups ;; Groups may be entered twice into the list of groups. - (if (not (string= (car groups) prev)) - (progn - (insert (setq prev (car groups)) "\n") - (if (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " des "\n")))) + (when (not (string= (car groups) prev)) + (insert (setq prev (car groups)) "\n") + (when (and gnus-description-hashtb + (setq des (gnus-gethash (car groups) + gnus-description-hashtb))) + (insert " " des "\n"))) (setq groups (cdr groups))) (goto-char (point-min)))) (pop-to-buffer obuf))) @@ -2843,9 +2859,9 @@ to use." (defun gnus-group-description-apropos (regexp) "List all newsgroups that have names or descriptions that match a regexp." (interactive "sGnus description apropos (regexp): ") - (if (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) + (when (not (or gnus-description-hashtb + (gnus-read-all-descriptions-files))) + (error "Couldn't request descriptions file")) (gnus-group-apropos regexp t)) ;; Suggested by Per Abrahamsen . diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 44e65ac2b..5b2da01e1 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -407,7 +407,7 @@ If GROUP is nil, all groups on METHOD are scanned." (let* ((elem (assoc method gnus-opened-servers)) (status (cadr elem))) ;; If this hasn't been opened before, we add it to the list. - (when (eq status 'denied) + (when (eq status 'denied) ;; Set the status of this server. (setcar (cdr elem) 'closed)))) diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index 3f674d2eb..898ccfe46 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -187,8 +187,8 @@ If NEWSGROUP is nil, the global kill file is selected." ;; REGEXP: The string to kill. (save-excursion (let (string) - (or (eq major-mode 'gnus-kill-file-mode) - (gnus-kill-set-kill-buffer)) + (unless (eq major-mode 'gnus-kill-file-mode) + (gnus-kill-set-kill-buffer)) (unless dont-move (goto-char (point-max))) (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) @@ -202,7 +202,8 @@ If NEWSGROUP is nil, the global kill file is selected." (if (vectorp gnus-current-headers) (regexp-quote (gnus-simplify-subject (mail-header-subject gnus-current-headers))) - "") t)) + "") + t)) (defun gnus-kill-file-kill-by-author () "Kill by author." @@ -225,19 +226,19 @@ If NEWSGROUP is nil, the global kill file is selected." (defun gnus-kill-file-kill-by-xref () "Kill by Xref." (interactive) - (let ((xref (and (vectorp gnus-current-headers) + (let ((xref (and (vectorp gnus-current-headers) (mail-header-xref gnus-current-headers))) (start 0) group) (if xref (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) - (if (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-kill-file-enter-kill - "Xref" (concat " " (regexp-quote group) ":") t))) + (when (not (string= + (setq group + (substring xref (match-beginning 1) (match-end 1))) + gnus-newsgroup-name)) + (gnus-kill-file-enter-kill + "Xref" (concat " " (regexp-quote group) ":") t))) (gnus-kill-file-enter-kill "Xref" "" t)))) (defun gnus-kill-file-raise-followups-to-author (level) @@ -300,13 +301,13 @@ If NEWSGROUP is nil, the global kill file is selected." (save-buffer) (let ((killbuf (current-buffer))) ;; We don't want to return to article buffer. - (and (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) + (when (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer)) ;; Delete the KILL file windows. (delete-windows-on killbuf) ;; Restore last window configuration if available. - (and gnus-winconf-kill-file - (set-window-configuration gnus-winconf-kill-file)) + (when gnus-winconf-kill-file + (set-window-configuration gnus-winconf-kill-file)) (setq gnus-winconf-kill-file nil) ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. (kill-buffer killbuf))) @@ -341,9 +342,9 @@ If NEWSGROUP is nil, return the global kill file instead." "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) ;; Ignores global KILL. - (if (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" - gnus-newsgroup-name)) + (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) + (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" + gnus-newsgroup-name)) 0) ((or (file-exists-p (gnus-newsgroup-kill-file nil)) (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) @@ -374,12 +375,11 @@ Returns the number of articles marked as read." (mapcar (lambda (header) (mail-header-number header)) headers)) (while headers - (or (gnus-member-of-range - (mail-header-number (car headers)) - gnus-newsgroup-killed) - (setq gnus-newsgroup-kill-headers - (cons (mail-header-number (car headers)) - gnus-newsgroup-kill-headers))) + (unless (gnus-member-of-range + (mail-header-number (car headers)) + gnus-newsgroup-killed) + (push (mail-header-number (car headers)) + gnus-newsgroup-kill-headers)) (setq headers (cdr headers)))) (setq files nil)) (setq files (cdr files))))) @@ -395,7 +395,7 @@ Returns the number of articles marked as read." (gnus-add-current-to-buffer-list) (goto-char (point-min)) - (if (consp (condition-case nil (read (current-buffer)) + (if (consp (condition-case nil (read (current-buffer)) (error nil))) (gnus-kill-parse-gnus-kill-file) (gnus-kill-parse-rn-kill-file)) @@ -432,8 +432,8 @@ Returns the number of articles marked as read." (setq beg (point)) (setq form (condition-case () (read (current-buffer)) (error nil)))) - (or (listp form) - (error "Illegal kill entry (possibly rn kill file?): %s" form)) + (unless (listp form) + (error "Illegal kill entry (possibly rn kill file?): %s" form)) (if (or (eq (car form) 'gnus-kill) (eq (car form) 'gnus-raise) (eq (car form) 'gnus-lower)) @@ -443,7 +443,7 @@ Returns the number of articles marked as read." (save-excursion (set-buffer gnus-summary-buffer) (condition-case () (eval form) (error nil))))) - (and (buffer-modified-p) + (and (buffer-modified-p) gnus-kill-save-kill-file (save-buffer)) (set-buffer-modified-p nil))) @@ -472,17 +472,16 @@ Returns the number of articles marked as read." ;; The "f:+" command marks everything *but* the matches as read, ;; so we simply first match everything as read, and then unmark ;; PATTERN later. - (and (string-match "\\+" commands) - (progn - (gnus-kill "from" ".") - (setq commands "m"))) + (when (string-match "\\+" commands) + (gnus-kill "from" ".") + (setq commands "m")) (gnus-kill (or (cdr (assq modifier mod-to-header)) "subject") pattern - (if (string-match "m" commands) + (if (string-match "m" commands) '(gnus-summary-mark-as-unread nil " ") - '(gnus-summary-mark-as-read nil "X")) + '(gnus-summary-mark-as-read nil "X")) nil t)) (forward-line 1)))) @@ -512,11 +511,11 @@ COMMAND must be a lisp expression or a string representing a key sequence." ;; It is a list. (if (not (consp (cdr kill-list))) ;; It's on the form (regexp . date). - (if (zerop (gnus-execute field (car kill-list) + (if (zerop (gnus-execute field (car kill-list) command nil (not all))) - (if (> (gnus-days-between date (cdr kill-list)) - gnus-kill-expiry-days) - (setq regexp nil)) + (when (> (gnus-days-between date (cdr kill-list)) + gnus-kill-expiry-days) + (setq regexp nil)) (setcdr kill-list date)) (while (setq kill (car kill-list)) (if (consp kill) @@ -525,13 +524,13 @@ COMMAND must be a lisp expression or a string representing a key sequence." (setq kdate (cdr kill)) (if (zerop (gnus-execute field (car kill) command nil (not all))) - (if (> (gnus-days-between date kdate) - gnus-kill-expiry-days) - ;; Time limit has been exceeded, so we - ;; remove the match. - (if prev - (setcdr prev (cdr kill-list)) - (setq regexp (cdr regexp)))) + (when (> (gnus-days-between date kdate) + gnus-kill-expiry-days) + ;; Time limit has been exceeded, so we + ;; remove the match. + (if prev + (setcdr prev (cdr kill-list)) + (setq regexp (cdr regexp)))) ;; Successful kill. Set the date to today. (setcdr kill date))) ;; It's a permanent kill. @@ -540,12 +539,13 @@ COMMAND must be a lisp expression or a string representing a key sequence." (setq kill-list (cdr kill-list)))) (gnus-execute field kill-list command nil (not all)))))) (switch-to-buffer old-buffer) - (if (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) - (gnus-pp-gnus-kill - (nconc (list 'gnus-kill field - (if (consp regexp) (list 'quote regexp) regexp)) - (if (or exe-command all) (list (list 'quote exe-command))) - (if all (list t) nil)))))) + (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) + (gnus-pp-gnus-kill + (nconc (list 'gnus-kill field + (if (consp regexp) (list 'quote regexp) regexp)) + (when (or exe-command all) + (list (list 'quote exe-command))) + (if all (list t) nil)))))) (defun gnus-pp-gnus-kill (object) (if (or (not (consp (nth 2 object))) @@ -568,11 +568,11 @@ COMMAND must be a lisp expression or a string representing a key sequence." (and (nth 3 object) (insert "\n " (if (and (consp (nth 3 object)) - (not (eq 'quote (car (nth 3 object))))) + (not (eq 'quote (car (nth 3 object))))) "'" "") (gnus-prin1-to-string (nth 3 object)))) - (and (nth 4 object) - (insert "\n t")) + (when (nth 4 object) + (insert "\n t")) (insert ")") (prog1 (buffer-substring (point-min) (point-max)) @@ -590,8 +590,8 @@ COMMAND must be a lisp expression or a string representing a key sequence." (progn (setq value (funcall function header)) ;; Number (Lines:) or symbol must be converted to string. - (or (stringp value) - (setq value (gnus-prin1-to-string value))) + (unless (stringp value) + (setq value (gnus-prin1-to-string value))) (setq did-kill (string-match regexp value))) (cond ((stringp form) ;Keyboard macro. (execute-kbd-macro form)) @@ -608,13 +608,13 @@ COMMAND must be a lisp expression or a string representing a key sequence." 6 "Searching for article: %d..." (mail-header-number header)) (gnus-article-setup-buffer) (gnus-article-prepare (mail-header-number header) t) - (if (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (setq did-kill (re-search-forward regexp nil t))) - (if (stringp form) ;Keyboard macro. - (execute-kbd-macro form) - (eval form)))))) + (when (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (setq did-kill (re-search-forward regexp nil t))) + (if (stringp form) ;Keyboard macro. + (execute-kbd-macro form) + (eval form)))))) did-kill))) (defun gnus-execute (field regexp form &optional backward ignore-marked) @@ -628,7 +628,7 @@ marked as read or ticked are ignored." function article header) (cond ;; Search body. - ((or (null field) + ((or (null field) (string-equal field "")) (setq function nil)) ;; Get access function of header field. diff --git a/lisp/gnus-load.el b/lisp/gnus-load.el index d95ac6b82..6c6bd552c 100644 --- a/lisp/gnus-load.el +++ b/lisp/gnus-load.el @@ -83,9 +83,9 @@ used to 899, you would say something along these lines: (list 'nntp (or (condition-case () (gnus-getenv-nntpserver) (error nil)) - (if (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) + (when (and gnus-default-nntp-server + (not (string= gnus-default-nntp-server ""))) + gnus-default-nntp-server) (system-name))) (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) @@ -651,6 +651,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("rmailout" rmail-output) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages rmail-show-message) + ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) @@ -744,7 +745,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-group-setup-buffer gnus-group-get-new-news gnus-group-make-help-group gnus-group-update-group) ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article - gnus-backlog-remove-article) + gnus-backlog-remove-article) ("gnus-art" gnus-article-read-summary-keys gnus-article-save gnus-article-prepare gnus-article-set-window-start gnus-article-show-all-headers gnus-article-next-page diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index af33a36ec..c26faab3b 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -42,10 +42,10 @@ ("subject" 1 gnus-advanced-string) ("from" 2 gnus-advanced-string) ("date" 3 gnus-advanced-date) - ("message-id" 4 gnus-advanced-string) - ("references" 5 gnus-advanced-string) - ("chars" 6 gnus-advanced-integer) - ("lines" 7 gnus-advanced-integer) + ("message-id" 4 gnus-advanced-string) + ("references" 5 gnus-advanced-string) + ("chars" 6 gnus-advanced-integer) + ("lines" 7 gnus-advanced-integer) ("xref" 8 gnus-advanced-string) ("head" nil gnus-advanced-body) ("body" nil gnus-advanced-body) @@ -65,7 +65,7 @@ (if (setq score (assq (mail-header-number gnus-advanced-headers) gnus-newsgroup-scored)) (setcdr score - (+ (cdr score) + (+ (cdr score) (or (nth 1 rule) gnus-score-interactive-default-score))) (push (cons (mail-header-number gnus-advanced-headers) @@ -200,14 +200,14 @@ ;; If just parts of the article is to be searched and the ;; backend didn't support partial fetching, we just narrow ;; to the relevant parts. - (if ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) + (when ofunc + (if (eq ofunc 'gnus-request-head) (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) + (point) + (or (search-forward "\n\n" nil t) (point-max))) + (narrow-to-region + (or (search-forward "\n\n" nil t) (point)) + (point-max)))) (let* ((case-fold-search (not (eq (downcase (symbol-name type)) (symbol-name type)))) (search-func diff --git a/lisp/gnus-move.el b/lisp/gnus-move.el index ac641062e..9e669ccca 100644 --- a/lisp/gnus-move.el +++ b/lisp/gnus-move.el @@ -56,7 +56,7 @@ Update the .newsrc.eld file to reflect the change of nntp server." (when (gnus-group-native-p (gnus-info-group info)) (gnus-move-group-to-server info from-server to-server)))))) -(defun gnus-move-group-to-server (info from-server to-server) +(defun gnus-move-group-to-server (info from-server to-server) "Move group INFO from FROM-SERVER to TO-SERVER." (let ((group (gnus-info-group info)) to-active hashtb type mark marks diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index adc2a706d..dee696667 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -242,7 +242,7 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (defun gnus-inews-yank-articles (articles) (let (beg article) - (message-goto-body) + (message-goto-body) (while (setq article (pop articles)) (save-window-excursion (set-buffer gnus-summary-buffer) @@ -253,7 +253,8 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (message-reply-headers gnus-current-headers)) (message-yank-original) (setq beg (or beg (mark t)))) - (when articles (insert "\n"))) + (when articles + (insert "\n"))) (push-mark) (goto-char beg))) @@ -301,7 +302,7 @@ header line with the old Message-ID." (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) (buffer-disable-undo gnus-article-copy) (or (memq gnus-article-copy gnus-buffer-list) - (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) + (push gnus-article-copy gnus-buffer-list)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg contents) (when (and (get-buffer article-buffer) @@ -593,15 +594,15 @@ The current group name will be inserted at \"%s\".") (defun gnus-summary-mail-nastygram (n) "Send a nastygram to the author of the current article." (interactive "P") - (if (or gnus-expert-user - (gnus-y-or-n-p - "Really send a nastygram to the author of the current article? ")) - (let ((group gnus-newsgroup-name)) - (gnus-summary-reply-with-original n) - (set-buffer gnus-message-buffer) - (message-goto-body) - (insert (format gnus-nastygram-message group)) - (message-send-and-exit)))) + (when (or gnus-expert-user + (gnus-y-or-n-p + "Really send a nastygram to the author of the current article? ")) + (let ((group gnus-newsgroup-name)) + (gnus-summary-reply-with-original n) + (set-buffer gnus-message-buffer) + (message-goto-body) + (insert (format gnus-nastygram-message group)) + (message-send-and-exit)))) (defun gnus-summary-mail-crosspost-complaint (n) "Send a complaint about crossposting to the current article(s)." @@ -658,13 +659,13 @@ The current group name will be inserted at \"%s\".") (logand (progn (while (search-forward "\"" nil t) (incf i)) - (if (zerop i) 2 i)) 2))))) + (if (zerop i) 2 i)) + 2))))) (skip-chars-forward ",") (skip-chars-forward "^,")) (skip-chars-backward " ") - (setq accumulated - (cons (buffer-substring beg (point)) - accumulated)) + (push (buffer-substring beg (point)) + accumulated) (skip-chars-forward "^,") (skip-chars-forward ", ")) accumulated)) @@ -687,8 +688,8 @@ The current group name will be inserted at \"%s\".") (or (and group (not (gnus-group-read-only-p group))) (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) - (and (gnus-gethash group gnus-newsrc-hashtb) - (error "No such group: %s" group)) + (when (gnus-gethash group gnus-newsrc-hashtb) + (error "No such group: %s" group)) (save-excursion (save-restriction @@ -704,15 +705,14 @@ The current group name will be inserted at \"%s\".") (gnus-inews-do-gcc) - (if (get-buffer gnus-group-buffer) - (progn - (if (gnus-buffer-exists-p (car-safe reply)) - (progn - (set-buffer (car reply)) - (and (cdr reply) - (gnus-summary-mark-article-as-replied - (cdr reply))))) - (and winconf (set-window-configuration winconf)))))) + (when (get-buffer gnus-group-buffer) + (when (gnus-buffer-exists-p (car-safe reply)) + (set-buffer (car reply)) + (and (cdr reply) + (gnus-summary-mark-article-as-replied + (cdr reply)))) + (when winconf + (set-window-configuration winconf))))) (defun gnus-article-mail (yank) "Send a reply to the address near point. @@ -753,8 +753,8 @@ If YANK is non-nil, include the original article." (message ""))) (defun gnus-bug-kill-buffer () - (and (get-buffer "*Gnus Help Bug*") - (kill-buffer "*Gnus Help Bug*"))) + (when (get-buffer "*Gnus Help Bug*") + (kill-buffer "*Gnus Help Bug*"))) (defun gnus-debug () "Attempts to go through the Gnus source file and report what variables have been changed. @@ -780,7 +780,7 @@ The source file has to be in the Emacs load path." (gnus-message 4 "Malformed sources in file %s" file) (narrow-to-region (point-min) (point)) (goto-char (point-min)) - (while (setq expr (condition-case () + (while (setq expr (condition-case () (read (current-buffer)) (error nil))) (condition-case () (and (eq (car expr) 'defvar) @@ -810,7 +810,7 @@ The source file has to be in the Emacs load path." (setq olist (cdr olist))) (insert "\n\n") ;; Remove any null chars - they seem to cause trouble for some - ;; mailers. (Byte-compiled output from the stuff above.) + ;; mailers. (Byte-compiled output from the stuff above.) (goto-char (point-min)) (while (re-search-forward "[\000\200]" nil t) (replace-match "" t t)))) @@ -971,7 +971,8 @@ this is a reply." name (gnus-group-prefixed-name name gnus-message-archive-method))) - (if groups (insert " "))) + (when groups + (insert " "))) (insert "\n"))))))) (defun gnus-summary-send-draft () diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index ce78e1dba..94de18a62 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -106,7 +106,7 @@ isn't bound, the message will be used unconditionally.") (setq articles (gnus-uncompress-range (cons - (if active (1+ (cdr active)) + (if active (1+ (cdr active)) (car gactive)) (cdr gactive)))) group)) @@ -121,7 +121,7 @@ isn't bound, the message will be used unconditionally.") (gnus-nocem-check-article group (car headers))) (setq headers (cdr headers))))))) (setq gnus-nocem-active - (cons (list group gactive) + (cons (list group gactive) (delq (assoc group gnus-nocem-active) gnus-nocem-active))))) ;; Save the results, if any. @@ -190,7 +190,7 @@ isn't bound, the message will be used unconditionally.") (when ncm (setq gnus-nocem-touched-alist t) (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) - ncm) + ncm) gnus-nocem-alist))))) (defun gnus-nocem-load-cache () diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 1c4ece0d5..f52bf89d8 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -95,8 +95,8 @@ This has only an effect if `gnus-picons-display-where' hs value article.") (defun gnus-picons-remove (plist) (let ((listitem (car plist))) (while (setq listitem (car plist)) - (if (annotationp listitem) - (delete-annotation listitem)) + (when (annotationp listitem) + (delete-annotation listitem)) (setq plist (cdr plist))))) (defun gnus-picons-remove-all () @@ -108,8 +108,8 @@ This has only an effect if `gnus-picons-display-where' hs value article.") (setq gnus-article-annotations nil gnus-group-annotations nil gnus-x-face-annotations nil) - (if (bufferp gnus-picons-buffer) - (kill-buffer gnus-picons-buffer))) + (when (bufferp gnus-picons-buffer) + (kill-buffer gnus-picons-buffer))) (defun gnus-get-buffer-name (variable) "Returns the buffer name associated with the contents of a variable." @@ -172,7 +172,7 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (sit-for 0)) (let ((first t) from at-idx databases) - (when (and (featurep 'xpm) + (when (and (featurep 'xpm) (or (not (fboundp 'device-type)) (equal (device-type) 'x)) (setq from (mail-fetch-field "from")) (setq from (downcase @@ -249,7 +249,7 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" ;; let display catch up so far (when gnus-picons-refresh-before-display (sit-for 0)) - (when (and (featurep 'xpm) + (when (and (featurep 'xpm) (or (not (fboundp 'device-type)) (equal (device-type) 'x))) (save-excursion (set-buffer (get-buffer-create @@ -258,14 +258,15 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (goto-char (point-min)) (if (and (eq gnus-picons-display-where 'article) gnus-picons-display-article-move-p) - (if (search-forward "\n\n" nil t) - (forward-line -1)) + (when (search-forward "\n\n" nil t) + (forward-line -1)) (unless (eolp) (push (make-annotation "\n" (point) 'text) gnus-group-annotations))) (cond ((listp gnus-group-annotations) - (mapc #'(lambda (ext) (if (extent-live-p ext) (delete-annotation ext))) + (mapc #'(lambda (ext) (when (extent-live-p ext) + (delete-annotation ext))) gnus-group-annotations) (setq gnus-group-annotations nil)) ((annotationp gnus-group-annotations) @@ -310,8 +311,8 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" database "/")) (domainp (and gnus-picons-display-as-address dots)) picons found bar-ann cur first) - (if (string-match "/MISC" database) - (setq addrs '(""))) + (when (string-match "/MISC" database) + (setq addrs '(""))) (while (and addrs (file-accessible-directory-p path)) (setq cur (pop addrs) @@ -328,14 +329,15 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (setq picons (nconc (when (and domainp first) (list (make-annotation "." (point) 'text - nil nil nil t) picons)) + nil nil nil t) + picons)) (gnus-picons-try-to-find-face found nil (if domainp cur filename)) picons))) (when domainp (setq picons (nconc (list (make-annotation (if first (concat cur ".") cur) - (point) 'text nil nil nil t)) + (point) 'text nil nil nil t)) picons)))) (setq first t)) (when (and addrs domainp) diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index cb352ba4a..ed615edce 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -73,8 +73,8 @@ Both lists have to be sorted over <." (defun gnus-intersection (list1 list2) (let ((result nil)) (while list2 - (if (memq (car list2) list1) - (setq result (cons (car list2) result))) + (when (memq (car list2) list1) + (setq result (cons (car list2) result))) (setq list2 (cdr list2))) result)) @@ -128,7 +128,8 @@ ranges." (t ;End of one sequence (setq result (cons (if (= first last) first - (cons first last)) result)) + (cons first last)) + result)) (setq first (car numbers)) (setq last (car numbers)))) (setq numbers (cdr numbers))) @@ -156,8 +157,8 @@ these ranges." (t (while ranges (if (atom (car ranges)) - (if (numberp (car ranges)) - (setq result (cons (car ranges) result))) + (when (numberp (car ranges)) + (setq result (cons (car ranges) result))) (setq first (caar ranges)) (setq last (cdar ranges)) (while (<= first last) @@ -172,8 +173,8 @@ Note: LIST has to be sorted over `<'." (if (not ranges) (gnus-compress-sequence list t) (setq list (copy-sequence list)) - (or (listp (cdr ranges)) - (setq ranges (list ranges))) + (unless (listp (cdr ranges)) + (setq ranges (list ranges))) (let ((out ranges) ilist lowest highest temp) (while (and ranges list) @@ -182,47 +183,42 @@ Note: LIST has to be sorted over `<'." (caar ranges))) (while (and list (cdr list) (< (cadr list) lowest)) (setq list (cdr list))) - (if (< (car ilist) lowest) - (progn - (setq temp list) - (setq list (cdr list)) - (setcdr temp nil) - (setq out (nconc (gnus-compress-sequence ilist t) out)))) + (when (< (car ilist) lowest) + (setq temp list) + (setq list (cdr list)) + (setcdr temp nil) + (setq out (nconc (gnus-compress-sequence ilist t) out))) (setq highest (or (and (atom (car ranges)) (car ranges)) (cdar ranges))) (while (and list (<= (car list) highest)) (setq list (cdr list))) (setq ranges (cdr ranges))) - (if list - (setq out (nconc (gnus-compress-sequence list t) out))) + (when list + (setq out (nconc (gnus-compress-sequence list t) out))) (setq out (sort out (lambda (r1 r2) (< (or (and (atom r1) r1) (car r1)) (or (and (atom r2) r2) (car r2)))))) (setq ranges out) (while ranges (if (atom (car ranges)) - (if (cdr ranges) - (if (atom (cadr ranges)) - (if (= (1+ (car ranges)) (cadr ranges)) - (progn - (setcar ranges (cons (car ranges) - (cadr ranges))) - (setcdr ranges (cddr ranges)))) - (if (= (1+ (car ranges)) (caadr ranges)) - (progn - (setcar (cadr ranges) (car ranges)) - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges)))))) - (if (cdr ranges) + (when (cdr ranges) (if (atom (cadr ranges)) - (if (= (1+ (cdar ranges)) (cadr ranges)) - (progn - (setcdr (car ranges) (cadr ranges)) - (setcdr ranges (cddr ranges)))) - (if (= (1+ (cdar ranges)) (caadr ranges)) - (progn - (setcdr (car ranges) (cdadr ranges)) - (setcdr ranges (cddr ranges))))))) + (when (= (1+ (car ranges)) (cadr ranges)) + (setcar ranges (cons (car ranges) + (cadr ranges))) + (setcdr ranges (cddr ranges))) + (when (= (1+ (car ranges)) (caadr ranges)) + (setcar (cadr ranges) (car ranges)) + (setcar ranges (cadr ranges)) + (setcdr ranges (cddr ranges))))) + (when (cdr ranges) + (if (atom (cadr ranges)) + (when (= (1+ (cdar ranges)) (cadr ranges)) + (setcdr (car ranges) (cadr ranges)) + (setcdr ranges (cddr ranges))) + (when (= (1+ (cdar ranges)) (caadr ranges)) + (setcdr (car ranges) (cdadr ranges)) + (setcdr ranges (cddr ranges)))))) (setq ranges (cdr ranges))) out))) @@ -244,11 +240,11 @@ Note: LIST has to be sorted over `<'." (>= number (car ranges)) (>= number (caar ranges))) not-stop) - (if (if (numberp (car ranges)) - (= number (car ranges)) - (and (>= number (caar ranges)) - (<= number (cdar ranges)))) - (setq not-stop nil)) + (when (if (numberp (car ranges)) + (= number (car ranges)) + (and (>= number (caar ranges)) + (<= number (cdar ranges)))) + (setq not-stop nil)) (setq ranges (cdr ranges))) (not not-stop)))) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 3cbbf1411..451a69c31 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -145,7 +145,9 @@ If given a prefix, mark all unpicked articles as read." (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow - (gnus-summary-next-group) + (if (gnus-group-quit-config gnus-newsgroup-name) + (gnus-summary-exit) + (gnus-summary-next-group)) (error "No articles have been picked")))) (defun gnus-pick-article (&optional arg) @@ -192,8 +194,8 @@ This must be bound to a button-down mouse event." (mouse-set-point start-event) ;; In case the down click is in the middle of some intangible text, ;; use the end of that text, and put it in START-POINT. - (if (< (point) start-point) - (goto-char start-point)) + (when (< (point) start-point) + (goto-char start-point)) (gnus-pick-article) (setq start-point (point)) ;; end-of-range is used only in the single-click case. @@ -201,64 +203,64 @@ This must be bound to a button-down mouse event." ;; (but not outside the window where the drag started). (let (event end end-point last-end-point (end-of-range (point))) (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (eq (car-safe event) 'switch-frame))) - (if (eq (car-safe event) 'switch-frame) - nil - (setq end (event-end event) - end-point (posn-point end)) - (if end-point - (setq last-end-point end-point)) - - (cond - ;; Are we moving within the original window? - ((and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (gnus-pick-article) - ;; In case the user moved his mouse really fast, pick - ;; articles on the line between this one and the last one. - (let* ((this-line (1+ (count-lines 1 end-point))) - (min-line (min this-line start-line)) - (max-line (max this-line start-line))) - (while (< min-line max-line) - (goto-line min-line) - (gnus-pick-article) - (setq min-line (1+ min-line))) - (setq start-line this-line)) - (if (zerop (% click-count 3)) - (setq end-of-range (point)))) - (t - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top))) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window - (1+ (- mouse-row bottom))))))))))) - (if (consp event) - (let ((fun (key-binding (vector (car event))))) - ;; Run the binding of the terminating up-event, if possible. - ;; In the case of a multiple click, it gives the wrong results, - ;; because it would fail to set up a region. - (if nil ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) - ;; In this case, we can just let the up-event execute normally. - (let ((end (event-end event))) - ;; Set the position in the event before we replay it, - ;; because otherwise it may have a position in the wrong - ;; buffer. - (setcar (cdr end) end-of-range) - ;; Delete the overlay before calling the function, - ;; because delete-overlay increases buffer-modified-tick. - (setq unread-command-events - (cons event unread-command-events))))))))) + (while (progn + (setq event (read-event)) + (or (mouse-movement-p event) + (eq (car-safe event) 'switch-frame))) + (if (eq (car-safe event) 'switch-frame) + nil + (setq end (event-end event) + end-point (posn-point end)) + (when end-point + (setq last-end-point end-point)) + + (cond + ;; Are we moving within the original window? + ((and (eq (posn-window end) start-window) + (integer-or-marker-p end-point)) + ;; Go to START-POINT first, so that when we move to END-POINT, + ;; if it's in the middle of intangible text, + ;; point jumps in the direction away from START-POINT. + (goto-char start-point) + (goto-char end-point) + (gnus-pick-article) + ;; In case the user moved his mouse really fast, pick + ;; articles on the line between this one and the last one. + (let* ((this-line (1+ (count-lines 1 end-point))) + (min-line (min this-line start-line)) + (max-line (max this-line start-line))) + (while (< min-line max-line) + (goto-line min-line) + (gnus-pick-article) + (setq min-line (1+ min-line))) + (setq start-line this-line)) + (when (zerop (% click-count 3)) + (setq end-of-range (point)))) + (t + (let ((mouse-row (cdr (cdr (mouse-position))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top))) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window + (1+ (- mouse-row bottom))))))))))) + (when (consp event) + (let ((fun (key-binding (vector (car event))))) + ;; Run the binding of the terminating up-event, if possible. + ;; In the case of a multiple click, it gives the wrong results, + ;; because it would fail to set up a region. + (when nil + ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) + ;; In this case, we can just let the up-event execute normally. + (let ((end (event-end event))) + ;; Set the position in the event before we replay it, + ;; because otherwise it may have a position in the wrong + ;; buffer. + (setcar (cdr end) end-of-range) + ;; Delete the overlay before calling the function, + ;; because delete-overlay increases buffer-modified-tick. + (push event unread-command-events)))))))) (defun gnus-pick-next-page () "Go to the next page. If at the end of the buffer, start reading articles." @@ -485,7 +487,7 @@ Two predefined functions are available: (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) - (t 2))) + (t 2))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) @@ -514,7 +516,7 @@ Two predefined functions are available: tot-win-height) (walk-windows (lambda (window) (incf windows))) (setq tot-win-height - (- (frame-height) + (- (frame-height) (* window-min-height (1- windows)) 2)) (let* ((window-min-height 2) @@ -562,7 +564,7 @@ Two predefined functions are available: "***") (t gnus-tmp-from))) (gnus-tmp-open-bracket - (cond ((memq gnus-tmp-number sparse) + (cond ((memq gnus-tmp-number sparse) (caadr gnus-tree-brackets)) (dummy (caaddr gnus-tree-brackets)) (adopted (car (nth 3 gnus-tree-brackets))) @@ -662,11 +664,11 @@ Two predefined functions are available: ;; Recurse downwards in all children of this article. (while thread (gnus-generate-horizontal-tree - (pop thread) (if do (1+ level) level) + (pop thread) (if do (1+ level) level) (or dummyp dummy) dummy))))) (defsubst gnus-tree-indent-vertical () - (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) + (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) (- (point) (gnus-point-at-bol))))) (when (> len 0) (insert (make-string len ? ))))) @@ -723,7 +725,7 @@ Two predefined functions are available: ;; Recurse downwards in all children of this article. (while thread (gnus-generate-vertical-tree - (pop thread) (if do (1+ level) level) + (pop thread) (if do (1+ level) level) (or dummyp dummy) dummy))))) ;;; Interface functions. @@ -741,7 +743,8 @@ Two predefined functions are available: (gnus-cut-thread (gnus-remove-thread (mail-header-id - (gnus-summary-article-header article)) t)))) + (gnus-summary-article-header article)) + t)))) (gnus-tmp-limit gnus-newsgroup-limit) (gnus-tmp-sparse gnus-newsgroup-sparse)) (when (or force @@ -946,7 +949,7 @@ The following commands are available: gnus-mouse-face-prop 'highlight)))) (let ((fill-column (- (window-width) 2))) (fill-region (point-min) (point-max))) - (set-window-point (get-buffer-window (current-buffer)) + (set-window-point (get-buffer-window (current-buffer)) (point-min))))))) (defun gnus-carpal-select () diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 81946477b..5ee09d390 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -297,7 +297,7 @@ expunge: Automatically expunge articles below this. files: List of other score files to load when loading this one. eval: Sexp to be evaluated when the score file is loaded. -String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) +String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) where HEADER is the header being scored, MATCH is the string we are looking for, TYPE is a flag indicating whether it should use regexp or substring matching, SCORE is the score to add and DATE is the date @@ -314,10 +314,10 @@ of the last successful match.") ("subject" 1 gnus-score-string) ("from" 2 gnus-score-string) ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) + ("message-id" 4 gnus-score-string) + ("references" 5 gnus-score-string) + ("chars" 6 gnus-score-integer) + ("lines" 7 gnus-score-integer) ("xref" 8 gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) @@ -370,8 +370,8 @@ used as score." (defun gnus-score-kill-help-buffer () (when (get-buffer "*Score Help*") (kill-buffer "*Score Help*") - (and gnus-score-help-winconf - (set-window-configuration gnus-score-help-winconf)))) + (when gnus-score-help-winconf + (set-window-configuration gnus-score-help-winconf)))) (defun gnus-summary-increase-score (&optional score) "Make a score entry based on the current article. @@ -403,13 +403,13 @@ used as score." (?z s "substring" body-string) (?p r "regexp string" body-string) (?b before "before date" date) - (?a at "at date" date) + (?a at "at date" date) (?n now "this date" date) (?< < "less than number" number) - (?> > "greater than number" number) + (?> > "greater than number" number) (?= = "equal to number" number))) (char-to-perm - (list (list ?t (current-time-string) "temporary") + (list (list ?t (current-time-string) "temporary") '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) (hchar (and gnus-score-default-header @@ -455,8 +455,8 @@ used as score." (message "%s header '%s' with match type (%s?): " (if increase "Increase" "Lower") (nth 1 entry) - (mapconcat (lambda (s) - (if (eq (nth 4 entry) + (mapconcat (lambda (s) + (if (eq (nth 4 entry) (nth 3 s)) (char-to-string (car s)) "")) @@ -467,8 +467,8 @@ used as score." (gnus-score-insert-help "Match type" (delq nil - (mapcar (lambda (s) - (if (eq (nth 4 entry) + (mapcar (lambda (s) + (if (eq (nth 4 entry) (nth 3 s)) s nil)) char-to-type )) @@ -548,8 +548,8 @@ used as score." ;; find the longest string to display (while list (setq n (length (nth idx (car list)))) - (or (> max n) - (setq max n)) + (unless (> max n) + (setq max n)) (setq list (cdr list))) (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end (setq n (/ (1- (window-width)) max)) ; items per line @@ -631,7 +631,8 @@ If optional argument `SILENT' is nil, show effect of score entry." (current-time-string)) (t nil)))) ;; Regexp is the default type. - (if (eq type t) (setq type 'r)) + (when (eq type t) + (setq type 'r)) ;; Simplify matches... (cond ((or (eq type 'r) (eq type 's) (eq type nil)) (setq match (if match (gnus-simplify-subject-re match) ""))) @@ -658,8 +659,8 @@ If optional argument `SILENT' is nil, show effect of score entry." (setq match (format "%s" match)) ;; If this is an integer comparison, we transform from string to int. - (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) - (setq match (string-to-int match))) + (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) + (setq match (string-to-int match))) (unless (eq date 'now) ;; Add the score entry to the score file. @@ -686,7 +687,7 @@ If optional argument `SILENT' is nil, show effect of score entry." (or (and (numberp (nth 2 elem)) (numberp (nth 2 new))) (and (not (nth 2 elem)) (not (nth 2 new))))) ;; Yup, we just add this new score to the old elem. - (setcar (cdr elem) (+ (or (nth 1 elem) + (setcar (cdr elem) (+ (or (nth 1 elem) gnus-score-interactive-default-score) (or (nth 1 new) gnus-score-interactive-default-score))) @@ -719,12 +720,12 @@ SCORE is the score to add." (y-or-n-p "Use regexp match? ") (prefix-numeric-value current-prefix-arg))) (save-excursion - (or (and (stringp match) (> (length match) 0)) - (error "No match")) + (unless (and (stringp match) (> (length match) 0)) + (error "No match")) (goto-char (point-min)) (let ((regexp (cond ((eq type 'f) (gnus-simplify-subject-fuzzy match)) - ((eq type 'r) + ((eq type 'r) match) ((eq type 'e) (concat "\\`" (regexp-quote match) "\\'")) @@ -734,11 +735,11 @@ SCORE is the score to add." (let ((content (gnus-summary-header header 'noerr)) (case-fold-search t)) (and content - (if (if (eq type 'f) - (string-equal (gnus-simplify-subject-fuzzy content) - regexp) - (string-match regexp content)) - (gnus-summary-raise-score score)))) + (when (if (eq type 'f) + (string-equal (gnus-simplify-subject-fuzzy content) + regexp) + (string-match regexp content)) + (gnus-summary-raise-score score)))) (beginning-of-line 2))))) (defun gnus-summary-score-crossposting (score date) @@ -748,15 +749,16 @@ SCORE is the score to add." (let ((xref (gnus-summary-header "xref")) (start 0) group) - (or xref (error "This article is not crossposted")) + (unless xref + (error "This article is not crossposted")) (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) - (if (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-summary-score-entry - "xref" (concat " " group ":") nil score date t))))) + (when (not (string= + (setq group + (substring xref (match-beginning 1) (match-end 1))) + gnus-newsgroup-name)) + (gnus-summary-score-entry + "xref" (concat " " group ":") nil score date t))))) ;;; @@ -861,7 +863,7 @@ SCORE is the score to add." "Raise the score of the current article by N." (interactive "p") (gnus-set-global-variables) - (gnus-summary-set-score (+ (gnus-summary-article-score) + (gnus-summary-set-score (+ (gnus-summary-article-score) (or n gnus-score-interactive-default-score )))) (defun gnus-summary-set-score (n) @@ -875,12 +877,12 @@ SCORE is the score to add." (gnus-summary-update-mark (if (= n (or gnus-summary-default-score 0)) ? (if (< n (or gnus-summary-default-score 0)) - gnus-score-below-mark gnus-score-over-mark)) 'score)) + gnus-score-below-mark gnus-score-over-mark)) + 'score)) (let* ((article (gnus-summary-article-number)) (score (assq article gnus-newsgroup-scored))) (if score (setcdr score n) - (setq gnus-newsgroup-scored - (cons (cons article n) gnus-newsgroup-scored)))) + (push (cons article n) gnus-newsgroup-scored))) (gnus-summary-update-line))) (defun gnus-summary-current-score () @@ -901,7 +903,8 @@ SCORE is the score to add." "Edit the current score alist." (interactive (list gnus-current-score-file)) (let ((winconf (current-window-configuration))) - (and (buffer-name gnus-summary-buffer) (gnus-score-save)) + (when (buffer-name gnus-summary-buffer) + (gnus-score-save)) (gnus-make-directory (file-name-directory file)) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) @@ -918,7 +921,8 @@ SCORE is the score to add." (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (gnus-make-directory (file-name-directory file)) - (and (buffer-name gnus-summary-buffer) (gnus-score-save)) + (when (buffer-name gnus-summary-buffer) + (gnus-score-save)) (let ((winconf (current-window-configuration))) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) @@ -935,7 +939,7 @@ SCORE is the score to add." (let* ((file (expand-file-name (or (and (string-match (concat "^" (expand-file-name - gnus-kill-files-directory)) + gnus-kill-files-directory)) (expand-file-name file)) file) (concat (file-name-as-directory gnus-kill-files-directory) @@ -951,13 +955,13 @@ SCORE is the score to add." (setq alist (gnus-score-load-score-alist file)) ;; We add '(touched) to the alist to signify that it hasn't been ;; touched (yet). - (or (assq 'touched alist) (setq alist (cons (list 'touched nil) alist))) + (unless (assq 'touched alist) + (push (list 'touched nil) alist)) ;; If it is a global score file, we make it read-only. (and global (not (assq 'read-only alist)) - (setq alist (cons (list 'read-only t) alist))) - (setq gnus-score-cache - (cons (cons file alist) gnus-score-cache))) + (push (list 'read-only t) alist)) + (push (cons file alist) gnus-score-cache)) (let ((a alist) found) (while a @@ -995,7 +999,7 @@ SCORE is the score to add." (and files (not global) (setq lists (apply 'append lists (mapcar (lambda (file) - (gnus-score-load-file file)) + (gnus-score-load-file file)) (if adapt-file (cons adapt-file files) files))))) (and eval (not global) (eval eval)) @@ -1003,9 +1007,10 @@ SCORE is the score to add." (setq gnus-scores-exclude-files (nconc (mapcar - (lambda (sfile) + (lambda (sfile) (expand-file-name sfile (file-name-directory file))) - exclude-files) gnus-scores-exclude-files)) + exclude-files) + gnus-scores-exclude-files)) (if (not local) () (save-excursion @@ -1017,7 +1022,8 @@ SCORE is the score to add." (make-local-variable (caar local)) (set (caar local) (nth 1 (car local))))) (setq local (cdr local))))) - (if orphan (setq gnus-orphan-score orphan)) + (when orphan + (setq gnus-orphan-score orphan)) (setq gnus-adaptive-score-alist (cond ((equal adapt '(t)) (setq gnus-newsgroup-adaptive t) @@ -1049,10 +1055,9 @@ SCORE is the score to add." (setq gnus-score-alist (cdr cache)) (setq gnus-score-alist nil) (gnus-score-load-score-alist file) - (or gnus-score-alist - (setq gnus-score-alist (copy-alist '((touched nil))))) - (setq gnus-score-cache - (cons (cons file gnus-score-alist) gnus-score-cache))))) + (unless gnus-score-alist + (setq gnus-score-alist (copy-alist '((touched nil))))) + (push (cons file gnus-score-alist) gnus-score-cache)))) (defun gnus-score-remove-from-cache (file) (setq gnus-score-cache @@ -1131,18 +1136,18 @@ SCORE is the score to add." (gnus-message 3 err) (sit-for 2) nil) - alist))))) + alist))))) (defun gnus-score-transform-old-to-new (alist) (let* ((alist (nth 2 alist)) out entry) - (if (eq (car alist) 'quote) - (setq alist (nth 1 alist))) + (when (eq (car alist) 'quote) + (setq alist (nth 1 alist))) (while alist (setq entry (car alist)) (if (stringp (car entry)) (let ((scor (cdr entry))) - (setq out (cons entry out)) + (push entry out) (while scor (setcar scor (list (caar scor) (nth 2 (car scor)) @@ -1150,10 +1155,10 @@ SCORE is the score to add." (gnus-day-number (nth 3 (car scor)))) (if (nth 1 (car scor)) 'r 's))) (setq scor (cdr scor)))) - (setq out (cons (if (not (listp (cdr entry))) - (list (car entry) (cdr entry)) - entry) - out))) + (push (if (not (listp (cdr entry))) + (list (car entry) (cdr entry)) + entry) + out)) (setq alist (cdr alist))) (cons (list 'touched t) (nreverse out)))) @@ -1179,7 +1184,8 @@ SCORE is the score to add." (let (emacs-lisp-mode-hook) (if (string-match (concat (regexp-quote gnus-adaptive-file-suffix) - "$") file) + "$") + file) ;; This is an adaptive score file, so we do not run ;; it through `pp'. These files can get huge, and ;; are not meant to be edited by human hands. @@ -1193,7 +1199,7 @@ SCORE is the score to add." (delete-file file) ;; There are scores, so we write the file. (when (file-writable-p file) - (write-region (point-min) (point-max) file nil 'silent) + (gnus-write-buffer file) (when gnus-score-after-write-file-function (funcall gnus-score-after-write-file-function file))))) (and gnus-score-uncacheable-files @@ -1253,10 +1259,10 @@ SCORE is the score to add." ;; WARNING: The assq makes the function O(N*S) while it could ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) ;; and S is (length gnus-newsgroup-scored). - (or (assq (mail-header-number header) gnus-newsgroup-scored) - (setq gnus-scores-articles ;Total of 2 * N cons-cells used. - (cons (cons header (or gnus-summary-default-score 0)) - gnus-scores-articles)))) + (unless (assq (mail-header-number header) gnus-newsgroup-scored) + (setq gnus-scores-articles ;Total of 2 * N cons-cells used. + (cons (cons header (or gnus-summary-default-score 0)) + gnus-scores-articles)))) (save-excursion (set-buffer (get-buffer-create "*Headers*")) @@ -1314,8 +1320,8 @@ SCORE is the score to add." this (aref (car art) index) tref (aref (car art) refind) articles (cdr articles)) - (if (string-equal tref "") ;no references line - (setq id-list (cons this id-list)))) + (when (string-equal tref "") ;no references line + (push this id-list))) id-list)) ;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers). @@ -1333,24 +1339,22 @@ SCORE is the score to add." this (aref (car art) gnus-score-index) articles (cdr articles)) ;;completely skip if this is empty (not a child, so not an orphan) - (if (not (string= this "")) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (setq alike (cons art alike)) - (if last - (progn - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) - (setq alike (list art) - last this)))) - (and last ; Bwadr, duplicate code. - (progn - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) + (when (not (string= this "")) + (if (equal last this) + ;; O(N*H) cons-cells used here, where H is the number of + ;; headers. + (push art alike) + (when last + ;; Insert the line, with a text property on the + ;; terminating newline referring to the articles with + ;; this line. + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike)) + (setq alike (list art) + last this)))) + (when last ; Bwadr, duplicate code. + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike)) ;; PLM: now delete those lines that contain an entry from new-thread-ids (while new-thread-ids @@ -1385,7 +1389,7 @@ SCORE is the score to add." scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) + (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) '>)) @@ -1434,7 +1438,7 @@ SCORE is the score to add." scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) + (let* ((rest (cdr entries)) (kill (car rest)) (type (or (nth 3 kill) 'before)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) @@ -1534,11 +1538,11 @@ SCORE is the score to add." (setq alist (pop scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) + (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) + (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) @@ -1609,17 +1613,15 @@ SCORE is the score to add." this (aref (car art) gnus-score-index) articles (cdr articles)) (if (equal last this) - (setq alike (cons art alike)) - (if last - (progn - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) + (push art alike) + (when last + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike)) (setq alike (list art) last this))) - (and last ; Bwadr, duplicate code. - (progn - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike))) + (when last ; Bwadr, duplicate code. + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike)) ;; Find matches. (while scores @@ -1627,7 +1629,7 @@ SCORE is the score to add." scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) + (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) @@ -1729,7 +1731,7 @@ SCORE is the score to add." (if (equal last this) ;; O(N*H) cons-cells used here, where H is the number of ;; headers. - (setq alike (cons art alike)) + (push art alike) (when last ;; Insert the line, with a text property on the ;; terminating newline referring to the articles with @@ -1739,7 +1741,7 @@ SCORE is the score to add." (setq alike (list art) last this))) (when last ; Bwadr, duplicate code. - (insert last ?\n) + (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike)) ;; Go through all the score alists and pick out the entries @@ -1775,7 +1777,7 @@ SCORE is the score to add." ((= dmt ?e) ;; Do exact matching. (goto-char (point-min)) - (while (and (not (eobp)) + (while (and (not (eobp)) (funcall search-func match nil t)) ;; Is it really exact? (and (eolp) @@ -1848,7 +1850,7 @@ SCORE is the score to add." (case-fold-search (not (= mt ?F))) found) (goto-char (point-min)) - (while (and (not (eobp)) + (while (and (not (eobp)) (search-forward match nil t)) (when (and (= (gnus-point-at-bol) (match-beginning 0)) (eolp)) @@ -1873,7 +1875,7 @@ SCORE is the score to add." (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ;; Old entry, remove. - ((and expire (< date expire)) + ((and expire (< date expire)) (gnus-score-set 'touched '(t) alist) (setcdr (car fuzzies) (cddar fuzzies)))) (setq fuzzies (cdr fuzzies))))) @@ -1908,7 +1910,7 @@ SCORE is the score to add." (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ;; Old entry, remove. - ((and expire (< date expire)) + ((and expire (< date expire)) (gnus-score-set 'touched '(t) alist) (setcdr (car words) (cddar words)))) (setq words (cdr words)))))) @@ -1969,23 +1971,23 @@ SCORE is the score to add." (save-excursion (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) (alist malist) - (date (current-time-string)) + (date (current-time-string)) (data gnus-newsgroup-data) elem headers match) ;; First we transform the adaptive rule alist into something ;; that's faster to process. (while malist (setq elem (car malist)) - (if (symbolp (car elem)) - (setcar elem (symbol-value (car elem)))) + (when (symbolp (car elem)) + (setcar elem (symbol-value (car elem)))) (setq elem (cdr elem)) (while elem - (setcdr (car elem) + (setcdr (car elem) (cons (if (eq (caar elem) 'followup) "references" (symbol-name (caar elem))) (cdar elem))) - (setcar (car elem) + (setcar (car elem) `(lambda (h) (,(intern (concat "mail-header-" @@ -2074,7 +2076,8 @@ SCORE is the score to add." (defun gnus-score-edit-done () (let ((bufnam (buffer-file-name (current-buffer))) (winconf gnus-prev-winconf)) - (and winconf (set-window-configuration winconf)) + (when winconf + (set-window-configuration winconf)) (gnus-score-remove-from-cache bufnam) (gnus-score-load-file bufnam))) @@ -2187,7 +2190,7 @@ SCORE is the score to add." (gnus-summary-next-subject 1 t))) (defun gnus-score-default (level) - (if level (prefix-numeric-value level) + (if level (prefix-numeric-value level) gnus-score-interactive-default-score)) (defun gnus-summary-raise-thread (&optional score) @@ -2203,8 +2206,8 @@ SCORE is the score to add." (setq articles (cdr articles)))) (setq e (point))) (let ((gnus-summary-check-current t)) - (or (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) + (unless (zerop (gnus-summary-next-subject 1 t)) + (goto-char e)))) (gnus-summary-recenter) (gnus-summary-position-point) (gnus-set-mode-line 'summary)) @@ -2229,9 +2232,9 @@ SCORE is the score to add." (defun gnus-score-score-files (group) "Return a list of all possible score files." ;; Search and set any global score files. - (and gnus-global-score-files - (or gnus-internal-global-score-files - (gnus-score-search-global-directories gnus-global-score-files))) + (when gnus-global-score-files + (unless gnus-internal-global-score-files + (gnus-score-search-global-directories gnus-global-score-files))) ;; Fix the kill-file dir variable. (setq gnus-kill-files-directory (file-name-as-directory gnus-kill-files-directory)) @@ -2312,7 +2315,7 @@ GROUP using BNews sys file syntax." (goto-char (point-min)) ;; First remove the suffix itself. (when (re-search-forward (concat "." score-regexp) nil t) - (replace-match "" t t) + (replace-match "" t t) (goto-char (point-min)) (if (looking-at (regexp-quote kill-dir)) ;; If the file name was just "SCORE", `klen' is one character @@ -2329,11 +2332,11 @@ GROUP using BNews sys file syntax." (replace-match "." t t))) ;; Kludge to get rid of "nntp+" problems. (goto-char (point-min)) - (and (looking-at "nn[a-z]+\\+") - (progn - (search-forward "+") - (forward-char -1) - (insert "\\"))) + (when (looking-at "nn[a-z]+\\+") + (progn + (search-forward "+") + (forward-char -1) + (insert "\\"))) ;; Kludge to deal with "++". (goto-char (point-min)) (while (search-forward "++" nil t) @@ -2353,11 +2356,11 @@ GROUP using BNews sys file syntax." ;; Finally - if this resulting regexp matches the group name, ;; we add this score file to the list of score files ;; applicable to this group. - (if (or (and not-match - (not (string-match regexp group))) - (and (not not-match) - (string-match regexp group))) - (setq ofiles (cons (car sfiles) ofiles)))) + (when (or (and not-match + (not (string-match regexp group))) + (and (not not-match) + (string-match regexp group))) + (push (car sfiles) ofiles))) (setq sfiles (cdr sfiles))) (kill-buffer (current-buffer)) ;; Slight kludge here - the last score file returned should be @@ -2381,8 +2384,8 @@ This includes the score file for the group and all its parents." (start 0)) (while (string-match "\\." group (1+ start)) (setq start (match-beginning 0)) - (setq all (cons (substring group 0 start) all))) - (setq all (cons group all)) + (push (substring group 0 start) all)) + (push group all) (nconc (mapcar (lambda (newsgroup) (gnus-score-file-name newsgroup gnus-adaptive-file-suffix)) @@ -2403,7 +2406,7 @@ Destroys the current buffer." (let ((beg (point)) elems) (while (re-search-forward "[./]" nil t) - (push (buffer-substring beg (1- (point))) + (push (buffer-substring beg (1- (point))) elems)) (erase-buffer) (setq elems (delete "all" elems)) @@ -2431,26 +2434,24 @@ The list is determined from the variable gnus-score-file-alist." (cdr score-files) ;ensures caching groups with no matches ;; handle the multiple match alist (while alist - (and (string-match (caar alist) group) - (setq score-files - (nconc score-files (copy-sequence (cdar alist))))) + (when (string-match (caar alist) group) + (setq score-files + (nconc score-files (copy-sequence (cdar alist))))) (setq alist (cdr alist))) (setq alist gnus-score-file-single-match-alist) ;; handle the single match alist (while alist - (and (string-match (caar alist) group) - ;; progn used just in case ("regexp") has no files - ;; and score-files is still nil. -sj - ;; this can be construed as a "stop searching here" feature :> - ;; and used to simplify regexps in the single-alist - (progn - (setq score-files - (nconc score-files (copy-sequence (cdar alist)))) - (setq alist nil))) + (when (string-match (caar alist) group) + ;; progn used just in case ("regexp") has no files + ;; and score-files is still nil. -sj + ;; this can be construed as a "stop searching here" feature :> + ;; and used to simplify regexps in the single-alist + (setq score-files + (nconc score-files (copy-sequence (cdar alist)))) + (setq alist nil)) (setq alist (cdr alist))) ;; cache the score files - (setq gnus-score-file-alist-cache - (cons (cons group score-files) gnus-score-file-alist-cache)) + (push (cons group score-files) gnus-score-file-alist-cache) score-files))) (defun gnus-all-score-files () @@ -2493,7 +2494,9 @@ The list is determined from the variable gnus-score-file-alist." ;; Expand all files names. (let ((files score-files)) (while files - (setcar files (expand-file-name (pop files))))) + (when (stringp (car files)) + (setcar files (expand-file-name (car files)))) + (pop files))) ;; Remove any duplicate score files. (while (and score-files (member (car score-files) (cdr score-files))) @@ -2544,7 +2547,7 @@ The list is determined from the variable gnus-score-file-alist." (setq out (nconc (directory-files (car files) t (concat (gnus-score-file-regexp) "$")))) - (setq out (cons (car files) out))) + (push (car files) out)) (setq files (cdr files))) (setq gnus-internal-global-score-files out))) diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el index a564c1ae2..b84f35e81 100644 --- a/lisp/gnus-setup.el +++ b/lisp/gnus-setup.el @@ -80,8 +80,8 @@ (let ((gnus-directory (if gnus-use-september gnus-sgnus-lisp-directory gnus-gnus-lisp-directory))) - (if (null (member gnus-directory load-path)) - (setq load-path (cons gnus-directory load-path)))) + (when (null (member gnus-directory load-path)) + (push gnus-directory load-path))) ;;; We can't do this until we know where Gnus is. (require 'message) @@ -90,80 +90,71 @@ ;;; UMEDA Masanobu ;;; MORIOKA Tomohiko -(if gnus-use-tm - (progn - (if (null (member gnus-tm-lisp-directory load-path)) - (setq load-path (cons gnus-tm-lisp-directory load-path))) - (load "mime-setup"))) +(when gnus-use-tm + (when (null (member gnus-tm-lisp-directory load-path)) + (setq load-path (cons gnus-tm-lisp-directory load-path))) + (load "mime-setup")) ;;; Mailcrypt by ;;; Jin Choi ;;; Patrick LoPresti -(if gnus-use-mailcrypt - (progn - (if (null (member gnus-mailcrypt-lisp-directory load-path)) - (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) - (autoload 'mc-install-write-mode "mailcrypt" nil t) - (autoload 'mc-install-read-mode "mailcrypt" nil t) - (add-hook 'message-mode-hook 'mc-install-write-mode) - (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) - (if gnus-use-mhe - (progn - (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) - (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))))) +(when gnus-use-mailcrypt + (when (null (member gnus-mailcrypt-lisp-directory load-path)) + (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) + (autoload 'mc-install-write-mode "mailcrypt" nil t) + (autoload 'mc-install-read-mode "mailcrypt" nil t) + (add-hook 'message-mode-hook 'mc-install-write-mode) + (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) + (when gnus-use-mhe + (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) + (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))) ;;; BBDB by ;;; Jamie Zawinski -(if gnus-use-bbdb - (progn - (if (null (member gnus-bbdb-lisp-directory load-path)) - (setq load-path (cons gnus-bbdb-lisp-directory load-path))) - (autoload 'bbdb "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-name "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-company "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-net "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-notes "bbdb-com" - "Insidious Big Brother Database" t) - - (if gnus-use-vm - (progn - (autoload 'bbdb-insinuate-vm "bbdb-vm" - "Hook BBDB into VM" t))) - - (if gnus-use-rmail - (progn - (autoload 'bbdb-insinuate-rmail "bbdb-rmail" - "Hook BBDB into RMAIL" t) - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail))) - - (if gnus-use-mhe - (progn - (autoload 'bbdb-insinuate-mh "bbdb-mh" - "Hook BBDB into MH-E" t) - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh))) - - (autoload 'bbdb-insinuate-gnus "bbdb-gnus" - "Hook BBDB into Gnus" t) - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) - - (if gnus-use-sendmail - (progn - (autoload 'bbdb-insinuate-sendmail "bbdb" - "Insidious Big Brother Database" t) - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) - (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))))) - -(if gnus-use-sc - (progn - (add-hook 'mail-citation-hook 'sc-cite-original) - (setq message-cite-function 'sc-cite-original) - (autoload 'sc-cite-original "supercite"))) +(when gnus-use-bbdb + (when (null (member gnus-bbdb-lisp-directory load-path)) + (setq load-path (cons gnus-bbdb-lisp-directory load-path))) + (autoload 'bbdb "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-name "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-company "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-net "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-notes "bbdb-com" + "Insidious Big Brother Database" t) + + (when gnus-use-vm + (autoload 'bbdb-insinuate-vm "bbdb-vm" + "Hook BBDB into VM" t)) + + (when gnus-use-rmail + (autoload 'bbdb-insinuate-rmail "bbdb-rmail" + "Hook BBDB into RMAIL" t) + (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) + + (when gnus-use-mhe + (autoload 'bbdb-insinuate-mh "bbdb-mh" + "Hook BBDB into MH-E" t) + (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) + + (autoload 'bbdb-insinuate-gnus "bbdb-gnus" + "Hook BBDB into Gnus" t) + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) + + (when gnus-use-sendmail + (autoload 'bbdb-insinuate-sendmail "bbdb" + "Insidious Big Brother Database" t) + (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) + (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))) + +(when gnus-use-sc + (add-hook 'mail-citation-hook 'sc-cite-original) + (setq message-cite-function 'sc-cite-original) + (autoload 'sc-cite-original "supercite")) ;;;### (autoloads (gnus-batch-score gnus-fetch-group gnus gnus-slave gnus-no-server gnus-update-format) "gnus" "lisp/gnus.el" (12473 2137)) ;;; Generated autoloads from lisp/gnus.el diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index cfeb1ef3f..7b29fc8ab 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -73,7 +73,7 @@ format.") (defvar gnus-soup-index-type ?c "*Soup index type. `n' means no index file and `c' means standard Cnews overview -format.") +format.") (defvar gnus-soup-areas nil) (defvar gnus-soup-last-prefix nil) @@ -119,8 +119,8 @@ format.") (let ((packets (directory-files gnus-soup-packet-directory t gnus-soup-packet-regexp))) (while packets - (and (gnus-soup-send-packet (car packets)) - (delete-file (car packets))) + (when (gnus-soup-send-packet (car packets)) + (delete-file (car packets))) (setq packets (cdr packets))))) (defun gnus-soup-add-article (n) @@ -185,8 +185,8 @@ Uses the process/prefix convention." (let ((level (or level gnus-level-subscribed)) (newsrc (cdr gnus-newsrc-alist))) (while newsrc - (and (<= (nth 1 (car newsrc)) level) - (gnus-soup-group-brew (caar newsrc) t)) + (when (<= (nth 1 (car newsrc)) level) + (gnus-soup-group-brew (caar newsrc) t)) (setq newsrc (cdr newsrc))) (gnus-soup-save-areas))) @@ -219,15 +219,14 @@ $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" from head-line beg type) (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) (buffer-disable-undo msg-buf) - (and idx-buf - (progn - (setq gnus-soup-buffers (cons idx-buf gnus-soup-buffers)) - (buffer-disable-undo idx-buf))) + (when idx-buf + (push idx-buf gnus-soup-buffers) + (buffer-disable-undo idx-buf)) (save-excursion ;; Make sure the last char in the buffer is a newline. (goto-char (point-max)) - (or (= (current-column) 0) - (insert "\n")) + (unless (= (current-column) 0) + (insert "\n")) ;; Find the "from". (goto-char (point-min)) (setq from @@ -302,7 +301,7 @@ If NOT-ALL, don't pack ticked articles." (lambda (time) (int-to-string time)) (current-time) "-"))) (or (mail-header-references header) "") - (or (mail-header-chars header) 0) + (or (mail-header-chars header) 0) (or (mail-header-lines header) "0")))) (defun gnus-soup-save-areas () @@ -315,21 +314,20 @@ If NOT-ALL, don't pack ticked articles." (if (not (buffer-name buf)) () (set-buffer buf) - (and (buffer-modified-p) (save-buffer)) + (when (buffer-modified-p) + (save-buffer)) (kill-buffer (current-buffer))))) (gnus-soup-write-prefixes))) (defun gnus-soup-write-prefixes () - (let ((prefix gnus-soup-last-prefix)) + (let ((prefixes gnus-soup-last-prefix) + prefix) (save-excursion - (while prefix - (gnus-set-work-buffer) - (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix))) - (gnus-make-directory (caar prefix)) - (write-region (point-min) (point-max) - (concat (caar prefix) gnus-soup-prefix-file) - nil 'nomesg) - (setq prefix (cdr prefix)))))) + (gnus-set-work-buffer) + (while (setq prefix (pop prefixes)) + (erase-buffer) + (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix))) + (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))) (defun gnus-soup-pack (dir packer) (let* ((files (mapconcat 'identity @@ -368,17 +366,16 @@ though the two last may be nil if they are missing." (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (not (eobp)) - (setq areas - (cons (vector (gnus-soup-field) - (gnus-soup-field) - (gnus-soup-field) - (and (eq (preceding-char) ?\t) - (gnus-soup-field)) - (and (eq (preceding-char) ?\t) - (string-to-int (gnus-soup-field)))) - areas)) - (if (eq (preceding-char) ?\t) - (beginning-of-line 2))) + (push (vector (gnus-soup-field) + (gnus-soup-field) + (gnus-soup-field) + (and (eq (preceding-char) ?\t) + (gnus-soup-field)) + (and (eq (preceding-char) ?\t) + (string-to-int (gnus-soup-field)))) + areas) + (when (eq (preceding-char) ?\t) + (beginning-of-line 2))) (kill-buffer (current-buffer))) areas)) @@ -392,12 +389,11 @@ file. The vector contain three strings, [prefix name encoding]." (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (not (eobp)) - (setq replies - (cons (vector (gnus-soup-field) (gnus-soup-field) - (gnus-soup-field)) - replies)) - (if (eq (preceding-char) ?\t) - (beginning-of-line 2))) + (push (vector (gnus-soup-field) (gnus-soup-field) + (gnus-soup-field)) + replies) + (when (eq (preceding-char) ?\t) + (beginning-of-line 2))) (kill-buffer (current-buffer))) replies)) @@ -423,9 +419,9 @@ file. The vector contain three strings, [prefix name encoding]." (format "%s\t%s\t%s%s\n" (gnus-soup-area-prefix area) - (gnus-soup-area-name area) + (gnus-soup-area-name area) (gnus-soup-area-encoding area) - (if (or (gnus-soup-area-description area) + (if (or (gnus-soup-area-description area) (gnus-soup-area-number area)) (concat "\t" (or (gnus-soup-area-description area) "") @@ -441,7 +437,7 @@ file. The vector contain three strings, [prefix name encoding]." (while (setq area (pop areas)) (insert (format "%s\t%s\t%s\n" (gnus-soup-reply-prefix area) - (gnus-soup-reply-kind area) + (gnus-soup-reply-kind area) (gnus-soup-reply-encoding area))))))) (defun gnus-soup-area (group) @@ -452,18 +448,18 @@ file. The vector contain three strings, [prefix name encoding]." (while areas (setq area (car areas) areas (cdr areas)) - (if (equal (gnus-soup-area-name area) real-group) - (setq result area))) - (or result - (setq result - (vector (gnus-soup-unique-prefix) - real-group - (format "%c%c%c" - gnus-soup-encoding-type - gnus-soup-index-type - (if (gnus-member-of-valid 'mail group) ?m ?n)) - nil nil) - gnus-soup-areas (cons result gnus-soup-areas))) + (when (equal (gnus-soup-area-name area) real-group) + (setq result area))) + (unless result + (setq result + (vector (gnus-soup-unique-prefix) + real-group + (format "%c%c%c" + gnus-soup-encoding-type + gnus-soup-index-type + (if (gnus-member-of-valid 'mail group) ?m ?n)) + nil nil) + gnus-soup-areas (cons result gnus-soup-areas))) result)) (defun gnus-soup-unique-prefix (&optional dir) @@ -472,13 +468,12 @@ file. The vector contain three strings, [prefix name encoding]." gnus-soup-prev-prefix) (if entry () - (and (file-exists-p (concat dir gnus-soup-prefix-file)) - (condition-case nil - (load (concat dir gnus-soup-prefix-file) nil t t) - (error nil))) - (setq gnus-soup-last-prefix - (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0))) - gnus-soup-last-prefix))) + (when (file-exists-p (concat dir gnus-soup-prefix-file)) + (condition-case nil + (load (concat dir gnus-soup-prefix-file) nil t t) + (error nil))) + (push (setq entry (cons dir (or gnus-soup-prev-prefix 0))) + gnus-soup-last-prefix)) (setcdr entry (1+ (cdr entry))) (gnus-soup-write-prefixes) (int-to-string (cdr entry)))) @@ -491,7 +486,7 @@ Return whether the unpacking was successful." (prog1 (zerop (call-process shell-file-name nil nil nil shell-command-switch - (format "cd %s ; %s" (expand-file-name dir) + (format "cd %s ; %s" (expand-file-name dir) (format unpacker packet)))) (gnus-message 4 "Unpacking...done"))) @@ -511,7 +506,8 @@ Return whether the unpacking was successful." beg end) (cond ((/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) ?n) + (gnus-soup-reply-encoding (car replies))) + ?n) (error "Unsupported encoding")) ((null msg-buf) t) @@ -521,8 +517,8 @@ Return whether the unpacking was successful." (set-buffer msg-buf) (goto-char (point-min)) (while (not (eobp)) - (or (looking-at "#! *rnews +\\([0-9]+\\)") - (error "Bad header.")) + (unless (looking-at "#! *rnews +\\([0-9]+\\)") + (error "Bad header.")) (forward-line 1) (setq beg (point) end (+ (point) (string-to-int diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index e23b911cf..ec2efe65a 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -411,7 +411,8 @@ (list (list (intern (format "gnus-user-format-function-%c" user-defined)) - 'gnus-tmp-header) ?s))) + 'gnus-tmp-header) + ?s))) ;; Find the specification from `spec-alist'. ((setq elem (cdr (assq spec spec-alist)))) (t diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 6f9f9c060..f492757a3 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -240,7 +240,8 @@ The following commands are available: (when entry (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string (cdr entry)) ")"))) + (prin1-to-string (cdr entry)) ") +"))) (when (or entry oentry) ;; Buffer may be narrowed. (save-restriction @@ -279,8 +280,7 @@ The following commands are available: (gnus-dribble-enter "") (let ((buffer-read-only nil)) (gnus-delete-line)) - (setq gnus-server-killed-servers - (cons (assoc server gnus-server-alist) gnus-server-killed-servers)) + (push (assoc server gnus-server-alist) gnus-server-killed-servers) (setq gnus-server-alist (delq (car gnus-server-killed-servers) gnus-server-alist)) (gnus-server-position-point)) @@ -288,15 +288,15 @@ The following commands are available: (defun gnus-server-yank-server () "Yank the previously killed server." (interactive) - (or gnus-server-killed-servers - (error "No killed servers to be yanked")) + (unless gnus-server-killed-servers + (error "No killed servers to be yanked")) (let ((alist gnus-server-alist) (server (gnus-server-server-name)) (killed (car gnus-server-killed-servers))) - (if (not server) + (if (not server) (setq gnus-server-alist (nconc gnus-server-alist (list killed))) (if (string= server (caar gnus-server-alist)) - (setq gnus-server-alist (cons killed gnus-server-alist)) + (push killed gnus-server-alist) (while (and (cdr alist) (not (string= server (caadr alist)))) (setq alist (cdr alist))) @@ -340,7 +340,8 @@ The following commands are available: "Force an open of SERVER." (interactive (list (gnus-server-server-name))) (let ((method (gnus-server-to-method server))) - (or method (error "No such server: %s" server)) + (unless method + (error "No such server: %s" server)) (gnus-server-set-status method 'ok) (prog1 (or (gnus-open-server method) @@ -359,7 +360,8 @@ The following commands are available: "Close SERVER." (interactive (list (gnus-server-server-name))) (let ((method (gnus-server-to-method server))) - (or method (error "No such server: %s" server)) + (unless method + (error "No such server: %s" server)) (gnus-server-set-status method 'closed) (prog1 (gnus-close-server method) @@ -377,7 +379,8 @@ The following commands are available: "Make sure SERVER will never be attempted opened." (interactive (list (gnus-server-server-name))) (let ((method (gnus-server-to-method server))) - (or method (error "No such server: %s" server)) + (unless method + (error "No such server: %s" server)) (gnus-server-set-status method 'denied)) (gnus-server-update-server server) (gnus-server-position-point) @@ -396,19 +399,21 @@ The following commands are available: (defun gnus-server-copy-server (from to) (interactive (list - (or (gnus-server-server-name) - (error "No server on the current line")) + (unless (gnus-server-server-name) + (error "No server on the current line")) (read-string "Copy to: "))) - (or from (error "No server on current line")) - (or (and to (not (string= to ""))) (error "No name to copy to")) - (and (assoc to gnus-server-alist) (error "%s already exists" to)) - (or (assoc from gnus-server-alist) - (error "%s: no such server" from)) + (unless from + (error "No server on current line")) + (unless (and to (not (string= to ""))) + (error "No name to copy to")) + (when (assoc to gnus-server-alist) + (error "%s already exists" to)) + (unless (assoc from gnus-server-alist) + (error "%s: no such server" from)) (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist)))) (setcar to-entry to) (setcar (nthcdr 2 to-entry) to) - (setq gnus-server-killed-servers - (cons to-entry gnus-server-killed-servers)) + (push to-entry gnus-server-killed-servers) (gnus-server-yank-server))) (defun gnus-server-add-server (how where) @@ -416,20 +421,18 @@ The following commands are available: (list (intern (completing-read "Server method: " gnus-valid-select-methods nil t)) (read-string "Server name: "))) - (setq gnus-server-killed-servers - (cons (list where how where) gnus-server-killed-servers)) + (push (list where how where) gnus-server-killed-servers) (gnus-server-yank-server)) (defun gnus-server-goto-server (server) "Jump to a server line." (interactive (list (completing-read "Goto server: " gnus-server-alist nil t))) - (let ((to (text-property-any (point-min) (point-max) + (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) - (and to - (progn - (goto-char to) - (gnus-server-position-point))))) + (when to + (goto-char to) + (gnus-server-position-point)))) (defun gnus-server-edit-server (server) "Edit the server on the current line." @@ -547,7 +550,8 @@ The following commands are available: (t (get-buffer-create gnus-browse-buffer) (gnus-add-current-to-buffer-list) - (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) + (when gnus-carpal + (gnus-carpal-setup-buffer 'browse)) (gnus-configure-windows 'browse) (buffer-disable-undo (current-buffer)) (let ((buffer-read-only nil)) @@ -561,14 +565,14 @@ The following commands are available: (set-buffer nntp-server-buffer) (let ((cur (current-buffer))) (goto-char (point-min)) - (or (string= gnus-ignored-newsgroups "") - (delete-matching-lines gnus-ignored-newsgroups)) + (unless (string= gnus-ignored-newsgroups "") + (delete-matching-lines gnus-ignored-newsgroups)) (while (re-search-forward "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) (goto-char (match-end 1)) - (setq groups (cons (cons (match-string 1) - (max 0 (- (1+ (read cur)) (read cur)))) - groups))))) + (push (cons (match-string 1) + (max 0 (- (1+ (read cur)) (read cur)))) + groups)))) (setq groups (sort groups (lambda (l1 l2) (string< (car l1) (car l2))))) @@ -654,7 +658,8 @@ buffer. (zerop (gnus-browse-next-group ward))) (decf arg)) (gnus-group-position-point) - (if (/= 0 arg) (gnus-message 7 "No more newsgroups")) + (when (/= 0 arg) + (gnus-message 7 "No more newsgroups")) arg)) (defun gnus-browse-group-name () @@ -671,7 +676,8 @@ buffer. (save-excursion (beginning-of-line) ;; If this group it killed, then we want to subscribe it. - (if (= (following-char) ?K) (setq sub t)) + (when (= (following-char) ?K) + (setq sub t)) (setq group (gnus-browse-group-name)) ;; Make sure the group has been properly removed before we ;; subscribe to it. diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 57a9dde68..287746b98 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -333,7 +333,7 @@ Can be used to turn version control on or off.") (concat "^" (substring (car groups) 0 (match-end 0)))) (string-match prefix (cadr groups))) (progn - (setq prefixes (cons prefix prefixes)) + (push prefix prefixes) (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix)))) (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q))) @@ -344,8 +344,7 @@ Can be used to turn version control on or off.") (while (and groups (string-match prefix (setq group (car groups)))) - (setq gnus-killed-list - (cons group gnus-killed-list)) + (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups))) (setq starts (cdr starts))) @@ -360,7 +359,7 @@ Can be used to turn version control on or off.") ((= ans ?q) (while groups (setq group (car groups)) - (setq gnus-killed-list (cons group gnus-killed-list)) + (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) (t nil))) @@ -375,11 +374,11 @@ Can be used to turn version control on or off.") ((= ans ?q) (while groups (setq group (car groups)) - (setq gnus-killed-list (cons group gnus-killed-list)) + (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) (t - (setq gnus-killed-list (cons group gnus-killed-list)) + (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb))) (setq groups (cdr groups))))))) @@ -414,8 +413,8 @@ Can be used to turn version control on or off.") (string< before newgroup))))) ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) (setq groupkey - (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) - (substring groupkey (match-beginning 1) (match-end 1))))) + (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey) + (substring groupkey (match-beginning 1) (match-end 1))))) (gnus-subscribe-newsgroup newgroup before)) (kill-buffer (current-buffer)))) @@ -547,15 +546,15 @@ prompt the user for the name of an NNTP server to use." (setq gnus-slave slave) (when (string-match "XEmacs" (emacs-version)) - (gnus-splash)) + (gnus-xmas-splash)) (let ((level (and (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect (progn - (or dont-connect - (setq did-connect - (gnus-start-news-server (and arg (not level)))))) + (unless dont-connect + (setq did-connect + (gnus-start-news-server (and arg (not level)))))) (if (and (not dont-connect) (not did-connect)) (gnus-group-quit) @@ -587,8 +586,8 @@ prompt the user for the name of an NNTP server to use." (defun gnus-unload () "Unload all Gnus features." (interactive) - (or (boundp 'load-history) - (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) + (unless (boundp 'load-history) + (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) (let ((history load-history) feature) (while history @@ -616,15 +615,15 @@ prompt the user for the name of an NNTP server to use." (defun gnus-dribble-enter (string) "Enter STRING into the dribble buffer." - (if (and (not gnus-dribble-ignore) - gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (let ((obuf (current-buffer))) - (set-buffer gnus-dribble-buffer) - (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) - (bury-buffer gnus-dribble-buffer) - (set-buffer obuf)))) + (when (and (not gnus-dribble-ignore) + gnus-dribble-buffer + (buffer-name gnus-dribble-buffer)) + (let ((obuf (current-buffer))) + (set-buffer gnus-dribble-buffer) + (insert string "\n") + (set-window-point (get-buffer-window (current-buffer)) (point-max)) + (bury-buffer gnus-dribble-buffer) + (set-buffer obuf)))) (defun gnus-dribble-read-file () "Read the dribble file from disk." @@ -676,8 +675,8 @@ prompt the user for the name of an NNTP server to use." (save-excursion (set-buffer gnus-dribble-buffer) (let ((auto (make-auto-save-file-name))) - (if (file-exists-p auto) - (delete-file auto)) + (when (file-exists-p auto) + (delete-file auto)) (erase-buffer) (set-buffer-modified-p nil))))) @@ -827,7 +826,7 @@ the server for new groups." (setq groups (1+ groups)) (gnus-sethash group group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive - (setq new-newsgroups (cons group new-newsgroups)) + (push group new-newsgroups) (funcall gnus-subscribe-newsgroup-method group))))))) gnus-active-hashtb) (when new-newsgroups @@ -928,7 +927,8 @@ the server for new groups." (when (> groups 0) (gnus-message 6 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has"))) - (and got-new (setq gnus-newsrc-last-checked-date new-date)) + (when got-new + (setq gnus-newsrc-last-checked-date new-date)) got-new)) (defun gnus-check-first-time-used () @@ -958,16 +958,16 @@ the server for new groups." ((eq do-sub 'ignore) nil) (t - (setq gnus-killed-list (cons group gnus-killed-list))))))) + (push group gnus-killed-list)))))) gnus-active-hashtb) (while groups - (if (gnus-active (car groups)) - (gnus-group-change-level - (car groups) gnus-level-default-subscribed gnus-level-killed)) + (when (gnus-active (car groups)) + (gnus-group-change-level + (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) (gnus-group-make-help-group) - (and gnus-novice-user - (gnus-message 7 "`A k' to list killed groups")))))) + (when gnus-novice-user + (gnus-message 7 "`A k' to list killed groups")))))) (defun gnus-subscribe-group (group previous &optional method) (gnus-group-change-level @@ -1000,16 +1000,16 @@ the server for new groups." (if fromkilled (setq group (nth 1 entry)) (setq group (car (nth 2 entry)))) (setq group entry)) - (if (and (stringp entry) - oldlevel - (< oldlevel gnus-level-zombie)) - (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) + (when (and (stringp entry) + oldlevel + (< oldlevel gnus-level-zombie)) + (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) (consp entry)) (setq oldlevel (gnus-info-level (nth 2 entry))) (setq oldlevel (or oldlevel 9))) - (if (stringp previous) - (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) + (when (stringp previous) + (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) (if (and (>= oldlevel gnus-level-zombie) (gnus-gethash group gnus-newsrc-hashtb)) @@ -1017,10 +1017,10 @@ the server for new groups." ;; subscribed. () ; Do nothing. - (or (gnus-ephemeral-group-p group) - (gnus-dribble-enter - (format "(gnus-group-change-level %S %S %S %S %S)" - group level oldlevel (car (nth 2 previous)) fromkilled))) + (unless (gnus-ephemeral-group-p group) + (gnus-dribble-enter + (format "(gnus-group-change-level %S %S %S %S %S)" + group level oldlevel (car (nth 2 previous)) fromkilled))) ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie @@ -1032,15 +1032,14 @@ the server for new groups." (setq gnus-zombie-list (delete group gnus-zombie-list)) (setq gnus-killed-list (delete group gnus-killed-list)))) (t - (if (and (>= level gnus-level-zombie) - entry) - (progn - (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) - (if (nth 3 entry) - (setcdr (gnus-gethash (car (nth 3 entry)) - gnus-newsrc-hashtb) - (cdr entry))) - (setcdr (cdr entry) (cdddr entry)))))) + (when (and (>= level gnus-level-zombie) + entry) + (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) + (when (nth 3 entry) + (setcdr (gnus-gethash (car (nth 3 entry)) + gnus-newsrc-hashtb) + (cdr entry))) + (setcdr (cdr entry) (cdddr entry))))) ;; Finally we enter (if needed) the list where it is supposed to ;; go, and change the subscription level. If it is to be killed, @@ -1053,8 +1052,8 @@ the server for new groups." ;; groups. (unless (gnus-group-foreign-p group) (if (= level gnus-level-zombie) - (setq gnus-zombie-list (cons group gnus-zombie-list)) - (setq gnus-killed-list (cons group gnus-killed-list))))) + (push group gnus-zombie-list) + (push group gnus-killed-list)))) (t ;; If the list is to be entered into the newsrc assoc, and ;; it was killed, we have to create an entry in the newsrc @@ -1219,9 +1218,9 @@ newsgroup." (cdadr range)))) (setcdr range (cddr range))) ;; Adjust the first element to be the same as the lower limit. - (if (and (not (atom (car range))) - (< (cdar range) (car active))) - (setcdr (car range) (1- (car active)))) + (when (and (not (atom (car range))) + (< (cdar range) (car active))) + (setcdr (car range) (1- (car active)))) ;; Then we want to peel off any elements that are higher ;; than the upper active limit. (let ((srange range)) @@ -1229,16 +1228,17 @@ newsgroup." (while (and (cdr srange) (<= (or (and (atom (cadr srange)) (cadr srange)) - (caadr srange)) (cdr active))) + (caadr srange)) + (cdr active))) (setq srange (cdr srange))) - (if (cdr srange) - ;; Nuke all remaining illegal elements. - (setcdr srange nil)) + (when (cdr srange) + ;; Nuke all remaining illegal elements. + (setcdr srange nil)) ;; Adjust the final element. - (if (and (not (atom (car srange))) - (> (cdar srange) (cdr active))) - (setcdr (car srange) (cdr active)))) + (when (and (not (atom (car srange))) + (> (cdar srange) (cdr active))) + (setcdr (car srange) (cdr active)))) ;; Compute the number of unread articles. (while range (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) @@ -1384,7 +1384,7 @@ newsgroup." (while articles (when (gnus-member-of-range (setq article (pop articles)) ranges) - (setq news (cons article news)))) + (push article news))) (when news (gnus-info-set-read info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) @@ -1408,7 +1408,8 @@ newsgroup." (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t)) (gnus-read-active-file))) - (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) + (unless gnus-killed-hashtb + (gnus-make-hashtable-from-killed)) ;; Go through all newsgroups that are known to Gnus - enlarge kill list. (mapatoms (lambda (sym) @@ -1422,8 +1423,7 @@ newsgroup." (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) () (setq groups (1+ groups)) - (setq gnus-killed-list - (cons group gnus-killed-list)) + (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb)))))) gnus-active-hashtb) (gnus-dribble-enter "")) @@ -1458,8 +1458,8 @@ newsgroup." (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. - (and (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) + (when (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan nil method)) (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) @@ -1471,7 +1471,7 @@ newsgroup." (gnus-find-method-for-group (gnus-info-group info) info) gmethod) - (push (gnus-group-real-name (gnus-info-group info)) + (push (gnus-group-real-name (gnus-info-group info)) groups))) (when groups (gnus-check-server method) @@ -1516,10 +1516,9 @@ newsgroup." (while (search-forward "\nto." nil t) (delete-region (1+ (match-beginning 0)) (progn (forward-line 1) (point)))) - (or (string= gnus-ignored-newsgroups "") - (progn - (goto-char (point-min)) - (delete-matching-lines gnus-ignored-newsgroups))) + (unless (string= gnus-ignored-newsgroups "") + (goto-char (point-min)) + (delete-matching-lines gnus-ignored-newsgroups)) ;; Make the group names readable as a lisp expression even if they ;; contain special characters. ;; Fix by Luc Van Eycken . @@ -1561,9 +1560,8 @@ newsgroup." (set group (cons min max)) (set group nil)) ;; Enter moderated groups into a list. - (if (eq (let ((obarray mod-hashtb)) (read cur)) m) - (setq gnus-moderated-list - (cons (symbol-name group) gnus-moderated-list)))) + (when (eq (let ((obarray mod-hashtb)) (read cur)) m) + (push (symbol-name group) gnus-moderated-list))) (error (and group (symbolp group) @@ -1595,10 +1593,10 @@ newsgroup." (and group (symbolp group) (set group nil)) - (or ignore-errors - (gnus-message 3 "Warning - illegal active: %s" - (buffer-substring - (gnus-point-at-bol) (gnus-point-at-eol))))))) + (unless ignore-errors + (gnus-message 3 "Warning - illegal active: %s" + (buffer-substring + (gnus-point-at-bol) (gnus-point-at-eol))))))) (widen) (forward-line 1)))))) @@ -1639,13 +1637,12 @@ newsgroup." (let (min max group) (while (not (eobp)) (condition-case () - (if (= (following-char) ?2) - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur)) - (set (setq group (let ((obarray hashtb)) (read cur))) - (cons min max)))) + (when (= (following-char) ?2) + (read cur) (read cur) + (setq min (read cur) + max (read cur)) + (set (setq group (let ((obarray hashtb)) (read cur))) + (cons min max))) (error (and group (symbolp group) (set group nil)))) (forward-line 1)))))) @@ -1665,26 +1662,26 @@ If FORCE is non-nil, the .newsrc file is read." ;; file (ticked articles, killed groups, foreign methods, etc.) (gnus-read-newsrc-el-file quick-file) - (if (and (file-exists-p gnus-current-startup-file) - (or force - (and (file-newer-than-file-p newsrc-file quick-file) - (file-newer-than-file-p newsrc-file - (concat quick-file "d"))) - (not gnus-newsrc-alist))) - ;; We read the .newsrc file. Note that if there if a - ;; .newsrc.eld file exists, it has already been read, and - ;; the `gnus-newsrc-hashtb' has been created. While reading - ;; the .newsrc file, Gnus will only use the information it - ;; can find there for changing the data already read - - ;; i. e., reading the .newsrc file will not trash the data - ;; already read (except for read articles). - (save-excursion - (gnus-message 5 "Reading %s..." newsrc-file) - (set-buffer (find-file-noselect newsrc-file)) - (buffer-disable-undo (current-buffer)) - (gnus-newsrc-to-gnus-format) - (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) + (when (and (file-exists-p gnus-current-startup-file) + (or force + (and (file-newer-than-file-p newsrc-file quick-file) + (file-newer-than-file-p newsrc-file + (concat quick-file "d"))) + (not gnus-newsrc-alist))) + ;; We read the .newsrc file. Note that if there if a + ;; .newsrc.eld file exists, it has already been read, and + ;; the `gnus-newsrc-hashtb' has been created. While reading + ;; the .newsrc file, Gnus will only use the information it + ;; can find there for changing the data already read - + ;; i. e., reading the .newsrc file will not trash the data + ;; already read (except for read articles). + (save-excursion + (gnus-message 5 "Reading %s..." newsrc-file) + (set-buffer (find-file-noselect newsrc-file)) + (buffer-disable-undo (current-buffer)) + (gnus-newsrc-to-gnus-format) + (kill-buffer (current-buffer)) + (gnus-message 5 "Reading %s...done" newsrc-file))) ;; Convert old to new. (gnus-convert-old-newsrc)))) @@ -1755,7 +1752,7 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-info-set-level info (if (nth 1 group) gnus-level-default-subscribed gnus-level-default-unsubscribed)) - (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) + (push info gnus-newsrc-alist)) (push (setq info (list (car group) (if (nth 1 group) gnus-level-default-subscribed @@ -1777,16 +1774,15 @@ If FORCE is non-nil, the .newsrc file is read." ;; The .el file version of this variable does not begin with ;; "options", while the .eld version does, so we just add it if it ;; isn't there. - (and - gnus-newsrc-options - (progn - (and (not (string-match "^ *options" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) - (and (not (string-match "\n$" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) - ;; Finally, if we read some options lines, we parse them. - (or (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options)))) + (when + gnus-newsrc-options + (when (not (string-match "^ *options" gnus-newsrc-options)) + (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) + (when (not (string-match "\n$" gnus-newsrc-options)) + (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) + ;; Finally, if we read some options lines, we parse them. + (unless (string= gnus-newsrc-options "") + (gnus-newsrc-parse-options gnus-newsrc-options))) (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist))) @@ -1804,8 +1800,8 @@ If FORCE is non-nil, the .newsrc file is read." (setq gnus-newsrc-options "") (setq gnus-newsrc-options-n nil) - (or gnus-active-hashtb - (setq gnus-active-hashtb (make-vector 4095 0))) + (unless gnus-active-hashtb + (setq gnus-active-hashtb (make-vector 4095 0))) (let ((buf (current-buffer)) (already-read (> (length gnus-newsrc-alist) 1)) group subscribed options-symbol newsrc Options-symbol @@ -1849,9 +1845,10 @@ If FORCE is non-nil, the .newsrc file is read." (forward-line -1)) (symbol ;; Group names can be just numbers. - (when (numberp symbol) + (when (numberp symbol) (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) - (or (boundp symbol) (set symbol nil)) + (unless (boundp symbol) + (set symbol nil)) ;; It was a group name. (setq subscribed (= (following-char) ?:) group (symbol-name symbol) @@ -1885,19 +1882,18 @@ If FORCE is non-nil, the .newsrc file is read." ;; This is a buggy line, by we pretend that ;; it's kinda OK. Perhaps the user should be ;; dinged? - (setq reads (cons num1 reads)) - (setq reads - (cons - (cons num1 - (progn - (narrow-to-region (match-beginning 0) - (match-end 0)) - (read buf))) - reads)) + (push num1 reads) + (push + (cons num1 + (progn + (narrow-to-region (match-beginning 0) + (match-end 0)) + (read buf))) + reads) (widen))) ;; It was just a simple number, so we add it to the ;; list of ranges. - (setq reads (cons num1 reads))) + (push num1 reads)) ;; If the next char in ?\n, then we have reached the end ;; of the line and return nil. (/= (following-char) ?\n)) @@ -1907,14 +1903,13 @@ If FORCE is non-nil, the .newsrc file is read." (t ;; Not numbers and not eol, so this might be a buggy ;; line... - (or (eobp) - ;; If it was eob instead of ?\n, we allow it. - (progn - ;; The line was buggy. - (setq group nil) - (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (gnus-point-at-bol) - (gnus-point-at-eol))))) + (unless (eobp) + ;; If it was eob instead of ?\n, we allow it. + ;; The line was buggy. + (setq group nil) + (gnus-error 3.1 "Mangled line: %s" + (buffer-substring (gnus-point-at-bol) + (gnus-point-at-eol)))) nil)) ;; Skip past ", ". Spaces are illegal in these ranges, but ;; we allow them, because it's a common mistake to put a @@ -1951,7 +1946,7 @@ If FORCE is non-nil, the .newsrc file is read." (1+ gnus-level-subscribed) gnus-level-default-unsubscribed)) (nreverse reads)))) - (setq newsrc (cons info newsrc)))))) + (push info newsrc))))) (forward-line 1)) (setq newsrc (nreverse newsrc)) @@ -1972,7 +1967,7 @@ If FORCE is non-nil, the .newsrc file is read." (if (setq entry (assoc (caar prev) newsrc)) (setcdr (setq mentry (memq entry newsrc)) (cons (car rc) (cdr mentry))) - (setq newsrc (cons (car rc) newsrc)))) + (push (car rc) newsrc))) (setq prev rc rc (cdr rc))))) @@ -1981,8 +1976,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-make-hashtable-from-newsrc-alist) ;; Finally, if we read some options lines, we parse them. - (or (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options)))) + (unless (string= gnus-newsrc-options "") + (gnus-newsrc-parse-options gnus-newsrc-options)))) ;; Parse options lines to find "options -n !all rec.all" and stuff. ;; The return value will be a list on the form @@ -2032,14 +2027,16 @@ If FORCE is non-nil, the .newsrc file is read." ;; If the word begins with a bang (!), this is a "not" ;; spec. We put this spec (minus the bang) and the ;; symbol `ignore' into the list. - (setq out (cons (cons (concat - "^" (buffer-substring - (1+ (match-beginning 0)) - (match-end 0))) - 'ignore) out)) + (push (cons (concat + "^" (buffer-substring + (1+ (match-beginning 0)) + (match-end 0))) + 'ignore) + out) ;; There was no bang, so this is a "yes" spec. - (setq out (cons (cons (concat "^" (match-string 0)) - 'subscribe) out))))) + (push (cons (concat "^" (match-string 0)) + 'subscribe) + out)))) (setq gnus-newsrc-options-n out)))) @@ -2138,7 +2135,8 @@ If FORCE is non-nil, the .newsrc file is read." (buffer-disable-undo (current-buffer)) (erase-buffer) ;; Write options. - (if gnus-newsrc-options (insert gnus-newsrc-options)) + (when gnus-newsrc-options + (insert gnus-newsrc-options)) ;; Write subscribed and unsubscribed. (while (setq info (pop newsrc)) ;; Don't write foreign groups to .newsrc. @@ -2162,7 +2160,8 @@ If FORCE is non-nil, the .newsrc file is read." (princ (car range)) (insert "-") (princ (cdr range))) - (if ranges (insert ","))))) + (when ranges + (insert ","))))) (insert "\n"))) (make-local-variable 'version-control) (setq version-control 'never) @@ -2190,7 +2189,7 @@ If FORCE is non-nil, the .newsrc file is read." (set-buffer gnus-dribble-buffer) (let ((slave-name (make-temp-name (concat gnus-current-startup-file "-slave-")))) - (write-region (point-min) (point-max) slave-name nil 'nomesg)))) + (gnus-write-buffer slave-name)))) (defun gnus-master-read-slave-newsrc () (let ((slave-files @@ -2220,17 +2219,17 @@ If FORCE is non-nil, the .newsrc file is read." (erase-buffer) (setq file (nth 1 (car slave-files))) (insert-file-contents file) - (if (condition-case () - (progn - (eval-buffer (current-buffer)) - t) - (error - (gnus-error 3.2 "Possible error in %s" file) - nil)) - (or gnus-slave ; Slaves shouldn't delete these files. - (condition-case () - (delete-file file) - (error nil)))) + (when (condition-case () + (progn + (eval-buffer (current-buffer)) + t) + (error + (gnus-error 3.2 "Possible error in %s" file) + nil)) + (unless gnus-slave ; Slaves shouldn't delete these files. + (condition-case () + (delete-file file) + (error nil)))) (setq slave-files (cdr slave-files)))) (gnus-message 7 "Reading slave newsrcs...done")))) @@ -2257,9 +2256,9 @@ If FORCE is non-nil, the .newsrc file is read." (setq method (gnus-server-to-method method))) ;; We create the hashtable whether we manage to read the desc file ;; to avoid trying to re-read after a failed read. - (or gnus-description-hashtb - (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb)))) + (unless gnus-description-hashtb + (setq gnus-description-hashtb + (gnus-make-hashtable (length gnus-active-hashtb)))) ;; Mark this method's desc file as read. (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" gnus-description-hashtb) @@ -2304,9 +2303,9 @@ If FORCE is non-nil, the .newsrc file is read." (error 0))) (skip-chars-forward " \t") ;; ... which leads to this line being effectively ignored. - (and (symbolp group) - (set group (buffer-substring - (point) (progn (end-of-line) (point))))) + (when (symbolp group) + (set group (buffer-substring + (point) (progn (end-of-line) (point))))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") t)))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 4443c15ae..8b0ef0c8e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -436,12 +436,12 @@ automatically when it is selected.") '(= mark gnus-canceled-mark) (custom-face-lookup "yellow" "black" nil nil nil nil)) - (cons '(and (> score default) + (cons '(and (> score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "pink" nil nil t nil nil)) - (cons '(and (< score default) + (cons '(and (< score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "pink" nil nil @@ -481,12 +481,12 @@ automatically when it is selected.") '(= mark gnus-canceled-mark) (custom-face-lookup "yellow" "black" nil nil nil nil)) - (cons '(and (> score default) + (cons '(and (> score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "firebrick" nil nil t nil nil)) - (cons '(and (< score default) + (cons '(and (< score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "firebrick" nil nil @@ -788,10 +788,10 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) (setq subject (substring subject (match-end 0)))) ;; Remove uninteresting prefixes. - (if (and (not re-only) - gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) + (when (and (not re-only) + gnus-simplify-ignored-prefixes + (string-match gnus-simplify-ignored-prefixes subject)) + (setq subject (substring subject (match-end 0)))) ;; Remove words in parentheses from end. (unless re-only (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) @@ -1551,7 +1551,7 @@ increase the score of each group you read." ["Go to subject number..." gnus-summary-goto-subject t] ["Go to article number..." gnus-summary-goto-article t] ["Go to the last article" gnus-summary-goto-last-article t] - ["Pop article off history" gnus-summary-pop-article t]) + ["Pop article off history" gnus-summary-pop-article t]) ("Sort" ["Sort by number" gnus-summary-sort-by-number t] ["Sort by author" gnus-summary-sort-by-author t] @@ -1648,11 +1648,11 @@ increase the score of each group you read." (setq outp (cons (vector - (caar ps) + (caar ps) (list 'gnus-summary-score-entry (nth 1 header) - (if (or (string= (nth 1 header) + (if (or (string= (nth 1 header) "head") (string= (nth 1 header) "body")) @@ -1801,7 +1801,8 @@ The following commands are available: (defun gnus-data-enter (after-article number mark pos header level offset) (let ((data (gnus-data-find-list after-article))) - (or data (error "No such article: %d" after-article)) + (unless data + (error "No such article: %d" after-article)) (setcdr data (cons (gnus-data-make number mark pos header level) (cdr data))) (setq gnus-newsgroup-data-reverse nil) @@ -1820,10 +1821,12 @@ The following commands are available: (progn (setcdr list gnus-newsgroup-data) (setq gnus-newsgroup-data ilist) - (and offset (gnus-data-update-list (cdr list) offset))) + (when offset + (gnus-data-update-list (cdr list) offset))) (setcdr list (cdr data)) (setcdr data ilist) - (and offset (gnus-data-update-list (cdr data) offset))) + (when offset + (gnus-data-update-list (cdr data) offset))) (setq gnus-newsgroup-data-reverse nil)))) (defun gnus-data-remove (article &optional offset) @@ -1832,12 +1835,12 @@ The following commands are available: (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) gnus-newsgroup-data-reverse nil) (while (cdr data) - (and (= (gnus-data-number (cadr data)) article) - (progn - (setcdr data (cddr data)) - (and offset (gnus-data-update-list (cdr data) offset)) - (setq data nil - gnus-newsgroup-data-reverse nil))) + (when (= (gnus-data-number (cadr data)) article) + (setcdr data (cddr data)) + (when offset + (gnus-data-update-list (cdr data) offset)) + (setq data nil + gnus-newsgroup-data-reverse nil)) (setq data (cdr data)))))) (defmacro gnus-data-list (backward) @@ -1958,8 +1961,8 @@ article number." (while (and (setq data (cdr data)) (> (setq l (gnus-data-level (car data))) level)) (and (= (1+ level) l) - (setq children (cons (gnus-data-number (car data)) - children)))) + (push (gnus-data-number (car data)) + children))) (nreverse children))) (defun gnus-summary-article-parent (&optional number) @@ -2131,7 +2134,7 @@ This is all marks except unread, ticked, dormant, and expirable." (setq pos (list (cons 'unread (and (search-forward "\200" nil t) (- (point) 2))))) (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) + (push (cons 'replied (and (search-forward "\201" nil t) (- (point) 2))) pos) (goto-char (point-min)) @@ -2158,16 +2161,18 @@ This is all marks except unread, ticked, dormant, and expirable." (gnus-tmp-score-char (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) ? + gnus-summary-zcore-fuzz)) + ? (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) - (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) - ((memq gnus-tmp-current gnus-newsgroup-cached) - gnus-cached-mark) - (gnus-tmp-replied gnus-replied-mark) - ((memq gnus-tmp-current gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark))) + (gnus-tmp-replied + (cond (gnus-tmp-process gnus-process-mark) + ((memq gnus-tmp-current gnus-newsgroup-cached) + gnus-cached-mark) + (gnus-tmp-replied gnus-replied-mark) + ((memq gnus-tmp-current gnus-newsgroup-saved) + gnus-saved-mark) + (t gnus-unread-mark))) (gnus-tmp-from (mail-header-from gnus-tmp-header)) (gnus-tmp-name (cond @@ -2188,7 +2193,8 @@ This is all marks except unread, ticked, dormant, and expirable." (buffer-read-only nil)) (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) - (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) + (unless (numberp gnus-tmp-lines) + (setq gnus-tmp-lines 0)) (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) @@ -2220,9 +2226,11 @@ This is all marks except unread, ticked, dormant, and expirable." (gnus-summary-update-mark (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) ? + gnus-summary-zcore-fuzz)) + ? (if (< score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) 'score)) + gnus-score-below-mark gnus-score-over-mark)) + 'score)) ;; Do visual highlighting. (when (gnus-visual-p 'summary-highlight 'highlight) (run-hooks 'gnus-summary-update-hook))))) @@ -2267,7 +2275,7 @@ the thread are to be displayed." (and (consp elem) ; Has to be a cons. (consp (cdr elem)) ; The cdr has to be a list. (symbolp (car elem)) ; Has to be a symbol in there. - (not (memq (car elem) + (not (memq (car elem) '(quit-config to-address to-list to-group))) (progn ; So we set it. (make-local-variable (car elem)) @@ -2304,12 +2312,7 @@ If NO-DISPLAY, don't generate a summary buffer." (set-buffer gnus-group-buffer) (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1)) - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (and (eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - (gnus-configure-windows (cdr quit-config))))) + (gnus-handle-ephemeral-exit quit-config))) (gnus-message 3 "Can't select group") nil) ;; The user did a `C-g' while prompting for number of articles, @@ -2326,12 +2329,7 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1) (gnus-configure-windows 'group 'force)) - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (and (eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - (gnus-configure-windows (cdr quit-config)))) + (gnus-handle-ephemeral-exit quit-config)) ;; Finally signal the quit. (signal 'quit nil)) ;; The group was successfully selected. @@ -2490,22 +2488,22 @@ If NO-DISPLAY, don't generate a summary buffer." (setq subject (gnus-general-simplify-subject (setq whole-subject (mail-header-subject (caar threads))))) - (if subject - (if (setq hthread (gnus-gethash subject hashtb)) - (progn - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar hthread)) - (setcar hthread (list whole-subject (car hthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car hthread) - (nconc (cdar hthread) (list (car threads)))) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)) - ;; Enter this thread into the hash table. - (gnus-sethash subject threads hashtb))) + (when subject + (if (setq hthread (gnus-gethash subject hashtb)) + (progn + ;; We enter a dummy root into the thread, if we + ;; haven't done that already. + (unless (stringp (caar hthread)) + (setcar hthread (list whole-subject (car hthread)))) + ;; We add this new gathered thread to this gathered + ;; thread. + (setcdr (car hthread) + (nconc (cdar hthread) (list (car threads)))) + ;; Remove it from the list of threads. + (setcdr prev (cdr threads)) + (setq threads prev)) + ;; Enter this thread into the hash table. + (gnus-sethash subject threads hashtb))) (setq prev threads) (setq threads (cdr threads))) result))) @@ -2592,7 +2590,7 @@ If NO-DISPLAY, don't generate a summary buffer." (while (search-backward ">" nil t) (setq end (1+ (point))) (when (search-backward "<" nil t) - (push (list (incf generation) + (push (list (incf generation) child (setq child (buffer-substring (point) end)) subject) relations))) @@ -2607,13 +2605,13 @@ If NO-DISPLAY, don't generate a summary buffer." ;; Make this article the parent of these threads. (setcar (symbol-value cthread) (vector gnus-reffed-article-number - (cadddr relation) + (cadddr relation) "" "" - (cadr relation) + (cadr relation) (or (caddr relation) "") 0 0 ""))) (set cthread (list (vector gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) + (cadddr relation) + "" "" (cadr relation) (or (caddr relation) "") 0 0 "")))) (push gnus-reffed-article-number gnus-newsgroup-limit) (push gnus-reffed-article-number gnus-newsgroup-sparse) @@ -2721,9 +2719,9 @@ If NO-DISPLAY, don't generate a summary buffer." (parent (gnus-id-to-thread (or (gnus-parent-id - (if (and references - (not (equal "" references))) - references)) + (when (and references + (not (equal "" references))) + references)) "none"))) (buffer-read-only nil) (old (car thread)) @@ -2772,7 +2770,9 @@ If NO-DISPLAY, don't generate a summary buffer." (let (threads) ;; We then insert this thread into the summary buffer. (let (gnus-newsgroup-data gnus-newsgroup-threads) - (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) + (if gnus-show-threads + (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) + (gnus-summary-prepare-unthreaded thread)) (setq data (nreverse gnus-newsgroup-data)) (setq threads gnus-newsgroup-threads)) ;; We splice the new data into the data structure. @@ -3026,10 +3026,10 @@ Unscored articles will be counted as having a score of zero." (mapcar 'gnus-thread-total-score (cdr (gnus-gethash (mail-header-id root) gnus-newsgroup-dependencies))) - (if (> (mail-header-number root) 0) - (list (or (cdr (assq (mail-header-number root) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)))) + (when (> (mail-header-number root) 0) + (list (or (cdr (assq (mail-header-number root) + gnus-newsgroup-scored)) + gnus-summary-default-score 0)))) (list gnus-summary-default-score) '(0)))) @@ -3082,10 +3082,10 @@ or a straight list of headers." thread (list (car gnus-tmp-new-adopts)) gnus-tmp-header (caar thread) gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) - (if new-roots - (setq thread (list (car new-roots)) - gnus-tmp-header (caar thread) - new-roots (cdr new-roots)))) + (when new-roots + (setq thread (list (car new-roots)) + gnus-tmp-header (caar thread) + new-roots (cdr new-roots)))) (if threads ;; If there are some threads, we do them before the @@ -3234,7 +3234,8 @@ or a straight list of headers." gnus-tmp-score-char (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) ? + gnus-summary-zcore-fuzz)) + ? (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) gnus-tmp-replied @@ -3262,7 +3263,8 @@ or a straight list of headers." (t gnus-tmp-from))) (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) - (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) + (unless (numberp gnus-tmp-lines) + (setq gnus-tmp-lines 0)) (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) @@ -3305,11 +3307,11 @@ or a straight list of headers." gnus-newsgroup-reads))) (setq mark (gnus-article-mark number)) - (setq gnus-newsgroup-data - (cons (gnus-data-make number mark (1+ (point)) header 0) - gnus-newsgroup-data)) + (push (gnus-data-make number mark (1+ (point)) header 0) + gnus-newsgroup-data) (gnus-summary-insert-line - header 0 nil mark (memq number gnus-newsgroup-replied) + header 0 number + mark (memq number gnus-newsgroup-replied) (memq number gnus-newsgroup-expirable) (mail-header-subject header) nil (cdr (assq number gnus-newsgroup-scored)) @@ -3322,9 +3324,9 @@ If READ-ALL is non-nil, all articles in the group are selected." (info (nth 2 entry)) articles fetched-articles cached) - (or (gnus-check-server - (setq gnus-current-select-method (gnus-find-method-for-group group))) - (error "Couldn't open server")) + (unless (gnus-check-server + (setq gnus-current-select-method (gnus-find-method-for-group group))) + (error "Couldn't open server")) (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... @@ -3338,7 +3340,7 @@ If READ-ALL is non-nil, all articles in the group are selected." (when (equal major-mode 'gnus-summary-mode) (kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" - group (gnus-status-message group))) + group (gnus-status-message group))) (setq gnus-newsgroup-name group) (setq gnus-newsgroup-unselected nil) @@ -3483,12 +3485,12 @@ If READ-ALL is non-nil, all articles in the group are selected." (setq number (length articles))) (setq articles (copy-sequence articles))) - (if (< (abs select) number) - (if (< select 0) - ;; Select the N oldest articles. - (setcdr (nthcdr (1- (abs select)) articles) nil) - ;; Select the N most recent articles. - (setq articles (nthcdr (- number select) articles)))) + (when (< (abs select) number) + (if (< select 0) + ;; Select the N oldest articles. + (setcdr (nthcdr (1- (abs select)) articles) nil) + ;; Select the N most recent articles. + (setq articles (nthcdr (- number select) articles)))) (setq gnus-newsgroup-unselected (gnus-sorted-intersection gnus-newsgroup-unreads @@ -3498,8 +3500,8 @@ If READ-ALL is non-nil, all articles in the group are selected." (defun gnus-killed-articles (killed articles) (let (out) (while articles - (if (inline (gnus-member-of-range (car articles) killed)) - (setq out (cons (car articles) out))) + (when (inline (gnus-member-of-range (car articles) killed)) + (push (car articles) out)) (setq articles (cdr articles))) out)) @@ -3620,7 +3622,8 @@ If WHERE is `summary', the summary mode line format will be used." (gnus-tmp-unselected (length gnus-newsgroup-unselected)) (gnus-tmp-unread-and-unselected (cond ((and (zerop gnus-tmp-unread-and-unticked) - (zerop gnus-tmp-unselected)) "") + (zerop gnus-tmp-unselected)) + "") ((zerop gnus-tmp-unselected) (format "{%d more}" gnus-tmp-unread-and-unticked)) (t (format "{%d(+%d) more}" @@ -3630,7 +3633,8 @@ If WHERE is `summary', the summary mode line format will be used." (if (and gnus-current-headers (vectorp gnus-current-headers)) (gnus-mode-string-quote - (mail-header-subject gnus-current-headers)) "")) + (mail-header-subject gnus-current-headers)) + "")) max-len gnus-tmp-header);; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) @@ -3694,8 +3698,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." (and (prog1 (setq entry (gnus-gethash name gnus-newsrc-hashtb) info (nth 2 entry)) - (if (stringp (setq nth4 (gnus-info-method info))) - (setq nth4 (gnus-server-to-method nth4)))) + (when (stringp (setq nth4 (gnus-info-method info))) + (setq nth4 (gnus-server-to-method nth4)))) ;; Only do the xrefs if the group has the same ;; select method as the group we have just read. (or (gnus-methods-equal-p @@ -3913,7 +3917,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." (mail-header-set-xref (car (symbol-value id-dep)) (concat (or (mail-header-xref - (car (symbol-value id-dep))) "") + (car (symbol-value id-dep))) + "") (or (mail-header-xref header) ""))) (setq header nil)) (setcar (symbol-value id-dep) header)) @@ -3924,7 +3929,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (nconc (cdr (symbol-value ref-dep)) (list (symbol-value id-dep)))) (set ref-dep (list nil (symbol-value id-dep)))) - (setq headers (cons header headers))) + (push header headers)) (goto-char (point-max)) (widen)) (nreverse headers))))) @@ -3938,7 +3943,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." 0 (let ((num (condition-case nil (read buffer) (error nil)))) (if (numberp num) num 0))) - (or (eobp) (forward-char 1)))) + (unless (eobp) + (forward-char 1)))) (defmacro gnus-nov-skip-field () '(search-forward "\t" eol 'move)) @@ -3957,7 +3963,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; overview: [num subject from date id refs chars lines misc] (narrow-to-region (point) eol) - (or (eobp) (forward-char)) + (unless (eobp) + (forward-char)) (setq header (vector @@ -4004,7 +4011,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." (mail-header-set-xref (car (symbol-value id-dep)) (concat (or (mail-header-xref - (car (symbol-value id-dep))) "") + (car (symbol-value id-dep))) + "") (or (mail-header-xref header) ""))) (setq header nil)) (setcar (symbol-value id-dep) header)) @@ -4068,14 +4076,13 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (if (or (and (eq (downcase (following-char)) ?x) - (looking-at "Xref:")) - (search-forward "\nXref:" nil t)) - (progn - (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) - (progn (end-of-line) (point)))) - (mail-header-set-xref headers xref)))))))) + (when (or (and (eq (downcase (following-char)) ?x) + (looking-at "Xref:")) + (search-forward "\nXref:" nil t)) + (goto-char (1+ (match-end 0))) + (setq xref (buffer-substring (point) + (progn (end-of-line) (point)))) + (mail-header-set-xref headers xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) "Find article ID and insert the summary line for that article." @@ -4097,7 +4104,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (when old-header (mail-header-set-number header (mail-header-number old-header))) (setq gnus-newsgroup-sparse - (delq (setq number (mail-header-number header)) + (delq (setq number (mail-header-number header)) gnus-newsgroup-sparse)) (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) (gnus-rebuild-thread (mail-header-id header)) @@ -4108,10 +4115,10 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." ;; article if ID is a number -- so that the next `P' or `N' ;; command will fetch the previous (or next) article even ;; if the one we tried to fetch this time has been canceled. - (and (> number gnus-newsgroup-end) - (setq gnus-newsgroup-end number)) - (and (< number gnus-newsgroup-begin) - (setq gnus-newsgroup-begin number)) + (when (> number gnus-newsgroup-end) + (setq gnus-newsgroup-end number)) + (when (< number gnus-newsgroup-begin) + (setq gnus-newsgroup-begin number)) (setq gnus-newsgroup-unselected (delq number gnus-newsgroup-unselected))) ;; Report back a success? @@ -4195,9 +4202,9 @@ taken into consideration." If optional argument BACKWARD is non-nil, search backward instead." (save-excursion (set-buffer gnus-group-buffer) - (if (gnus-group-search-forward - backward nil (if use-level (gnus-group-group-level) nil)) - (gnus-group-group-name)))) + (when (gnus-group-search-forward + backward nil (if use-level (gnus-group-group-level) nil)) + (gnus-group-group-name)))) (defun gnus-summary-best-group (&optional exclude-group) "Find the name of the best unread group. @@ -4241,19 +4248,18 @@ If EXCLUDE-GROUP, do not go to this group." (not unread) (not (gnus-data-unread-p (car arts))))) (setq arts (cdr arts))) - (if (setq result - (if unread - (progn - (while arts - (and (gnus-data-unread-p (car arts)) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - result) - (car arts))) - (progn - (goto-char (gnus-data-pos result)) - (gnus-data-number result))))) + (when (setq result + (if unread + (progn + (while arts + (when (gnus-data-unread-p (car arts)) + (setq result (car arts) + arts nil)) + (setq arts (cdr arts))) + result) + (car arts))) + (goto-char (gnus-data-pos result)) + (gnus-data-number result)))) (defun gnus-summary-find-subject (subject &optional unread backward article) (let* ((simp-subject (gnus-simplify-subject-fully subject)) @@ -4334,8 +4340,8 @@ displayed, no centering will be performed." (if (eq (current-buffer) (get-buffer gnus-group-buffer)) (save-window-excursion ;; Take care of tree window mode. - (if (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer)) + (when (get-buffer-window gnus-group-buffer) + (pop-to-buffer gnus-group-buffer)) (gnus-group-jump-to-group newsgroup)) (save-excursion ;; Take care of tree window mode. @@ -4361,20 +4367,21 @@ displayed, no centering will be performed." (if (not (listp (cdr read))) (setq first (1+ (cdr read))) ;; `read' is a list of ranges. - (if (/= (setq nlast (or (and (numberp (car read)) (car read)) - (caar read))) 1) - (setq first 1)) + (when (/= (setq nlast (or (and (numberp (car read)) (car read)) + (caar read))) + 1) + (setq first 1)) (while read - (if first - (while (< first nlast) - (setq unread (cons first unread)) - (setq first (1+ first)))) + (when first + (while (< first nlast) + (push first unread) + (setq first (1+ first)))) (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) (setq read (cdr read))))) ;; And add the last unread articles. (while (<= first last) - (setq unread (cons first unread)) + (push first unread) (setq first (1+ first))) ;; Return the list of unread articles. (nreverse unread))) @@ -4464,7 +4471,8 @@ The prefix argument ALL means to select all articles." (setq gnus-newsgroup-unselected (sort gnus-newsgroup-unselected '<))) (setq gnus-newsgroup-unreads - (sort gnus-newsgroup-unreads '<))) t))) + (sort gnus-newsgroup-unreads '<))) + t))) (unless (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) (let ((headers gnus-newsgroup-headers)) @@ -4486,8 +4494,8 @@ The prefix argument ALL means to select all articles." (gnus-score-save)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) - (or (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group))))) + (unless (gnus-ephemeral-group-p gnus-newsgroup-name) + (gnus-group-update-group group))))) (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. @@ -4545,8 +4553,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) ;; Return to group mode buffer. - (if (eq mode 'gnus-summary-mode) - (gnus-kill-buffer buf))) + (when (eq mode 'gnus-summary-mode) + (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) ;; Clear the current group name. @@ -4555,21 +4563,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1) (gnus-configure-windows 'group 'force)) - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (cond ((eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - ((eq major-mode 'gnus-article-mode) - (save-excursion - ;; The `gnus-summary-buffer' variable may point - ;; to the old summary buffer when using a single - ;; article buffer. - (unless (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-group-buffer)) - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables)))) - (gnus-configure-windows (cdr quit-config) 'force))) + (gnus-handle-ephemeral-exit quit-config)) (unless quit-config (setq gnus-newsgroup-name nil))))) @@ -4610,12 +4604,35 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (when (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (when quit-config - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (when (eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - (gnus-configure-windows (cdr quit-config))))))) + (gnus-handle-ephemeral-exit quit-config))))) + +(defun gnus-handle-ephemeral-exit (quit-config) + "Handle movement when leaving an ephemeral group. The state +which existed when entering the ephemeral is reset." + (if (not (buffer-name (car quit-config))) + (gnus-configure-windows 'group 'force) + (set-buffer (car quit-config)) + (cond ((eq major-mode 'gnus-summary-mode) + (gnus-set-global-variables)) + ((eq major-mode 'gnus-article-mode) + (save-excursion + ;; The `gnus-summary-buffer' variable may point + ;; to the old summary buffer when using a single + ;; article buffer. + (unless (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-group-buffer)) + (set-buffer gnus-summary-buffer) + (gnus-set-global-variables)))) + (if (or (eq (cdr quit-config) 'article) + (eq (cdr quit-config) 'pick)) + (progn + ;; The current article may be from the ephemeral group + ;; thus it is best that we reload this article + (gnus-summary-show-article) + (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) + (gnus-configure-windows 'pick 'force) + (gnus-configure-windows (cdr quit-config) 'force))) + (gnus-configure-windows (cdr quit-config) 'force)))) ;;; Dead summaries. @@ -4665,7 +4682,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (when (string-match "Summary" name) (rename-buffer (concat (substring name 0 (match-beginning 0)) "Dead " - (substring name (match-beginning 0))) t)))) + (substring name (match-beginning 0))) + t)))) (defun gnus-kill-or-deaden-summary (buffer) "Kill or deaden the summary BUFFER." @@ -4697,7 +4715,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (when (string-match "Dead " name) (rename-buffer (concat (substring name 0 (match-beginning 0)) - (substring name (match-end 0))) t))) + (substring name (match-end 0))) + t))) (gnus-message 3 "This dead summary is now alive again")) ;; Suggested by Andrew Eskilsson . @@ -4707,14 +4726,14 @@ If FAQ-DIR (the prefix), prompt for a directory to search for the faq in." (interactive (list - (if current-prefix-arg - (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) - gnus-group-faq-directory))))) + (when current-prefix-arg + (completing-read + "Faq dir: " (and (listp gnus-group-faq-directory) + gnus-group-faq-directory))))) (let (gnus-faq-buffer) - (and (setq gnus-faq-buffer - (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) - (gnus-configure-windows 'summary-faq)))) + (when (setq gnus-faq-buffer + (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) + (gnus-configure-windows 'summary-faq)))) ;; Suggested by Per Abrahamsen . (defun gnus-summary-describe-group (&optional force) @@ -4807,10 +4826,9 @@ Returns the article selected or nil if there are no unread articles." (while (and data (not (gnus-data-unread-p (car data)))) (setq data (cdr data))) - (if data - (progn - (goto-char (gnus-data-pos (car data))) - (gnus-data-number (car data))))))) + (when data + (goto-char (gnus-data-pos (car data))) + (gnus-data-number (car data)))))) (gnus-summary-position-point))) (defun gnus-summary-next-subject (n &optional unread dont-display) @@ -4827,8 +4845,9 @@ returned." (gnus-summary-find-prev unread) (gnus-summary-find-next unread))) (setq n (1- n))) - (if (/= 0 n) (gnus-message 7 "No more%s articles" - (if unread " unread" ""))) + (when (/= 0 n) + (gnus-message 7 "No more%s articles" + (if unread " unread" ""))) (unless dont-display (gnus-summary-recenter) (gnus-summary-position-point)) @@ -4936,12 +4955,12 @@ be displayed." (prog1 (gnus-summary-display-article article all-headers) (setq did article)) - (if (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) + (when (or all-headers gnus-show-all-headers) + (gnus-article-show-all-headers)) 'old)) - (if did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) + (when did + (gnus-article-set-window-start + (cdr (assq article gnus-newsgroup-bookmarks))))))) (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." @@ -4979,8 +4998,8 @@ If BACKWARD, the previous article is selected instead of the next." nil t)) ;; Go to next/previous group. (t - (or (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-jump-to-group gnus-newsgroup-name)) + (unless (gnus-ephemeral-group-p gnus-newsgroup-name) + (gnus-summary-jump-to-group gnus-newsgroup-name)) (let ((cmd last-command-char) (group (if (eq gnus-keep-same-level 'best) @@ -5041,8 +5060,8 @@ If BACKWARD, the previous article is selected instead of the next." ((assq key keystrokes) (let ((obuf (current-buffer))) (switch-to-buffer gnus-group-buffer) - (and group - (gnus-group-jump-to-group group)) + (when group + (gnus-group-jump-to-group group)) (eval (cadr (assq key keystrokes))) (setq group (gnus-group-group-name)) (switch-to-buffer obuf)) @@ -5141,8 +5160,8 @@ Argument LINES specifies lines to be scrolled up (or down if negative)." (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) (gnus-eval-in-buffer-window gnus-article-buffer (cond ((> lines 0) - (if (gnus-article-next-page lines) - (gnus-message 3 "End of message"))) + (when (gnus-article-next-page lines) + (gnus-message 3 "End of message"))) ((< lines 0) (gnus-article-prev-page (- lines)))))) (gnus-summary-recenter) @@ -5233,8 +5252,8 @@ If ALL-HEADERS is non-nil, no header lines are hidden." "Go to the previously read article." (interactive) (prog1 - (and gnus-last-article - (gnus-summary-goto-article gnus-last-article)) + (when gnus-last-article + (gnus-summary-goto-article gnus-last-article)) (gnus-summary-position-point))) (defun gnus-summary-pop-article (number) @@ -5286,7 +5305,8 @@ If given a prefix, remove all limits." (prog1 (let ((articles (gnus-summary-find-matching (or header "subject") subject 'all))) - (or articles (error "Found no matches for \"%s\"" subject)) + (unless articles + (error "Found no matches for \"%s\"" subject)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) @@ -5331,9 +5351,9 @@ Returns how many articles were removed." (append marks nil))) ; Transform to list. articles) (while data - (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) - (memq (gnus-data-mark (car data)) marks)) - (setq articles (cons (gnus-data-number (car data)) articles))) + (when (if reverse (not (memq (gnus-data-mark (car data)) marks)) + (memq (gnus-data-mark (car data)) marks)) + (push (gnus-data-number (car data)) articles)) (setq data (cdr data))) (gnus-summary-limit articles)) (gnus-summary-position-point))) @@ -5360,8 +5380,8 @@ Returns how many articles were removed." "Display all the hidden articles that are marked as dormant." (interactive) (gnus-set-global-variables) - (or gnus-newsgroup-dormant - (error "There are no dormant articles in this group")) + (unless gnus-newsgroup-dormant + (error "There are no dormant articles in this group")) (prog1 (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) (gnus-summary-position-point))) @@ -5429,8 +5449,7 @@ If ALL, mark even excluded ticked and dormants as read." (setq articles (car gnus-newsgroup-limits) gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) ;; We use the new limit, so we push the old limit on the stack. - (setq gnus-newsgroup-limits - (cons gnus-newsgroup-limit gnus-newsgroup-limits))) + (push gnus-newsgroup-limit gnus-newsgroup-limits)) ;; Set the limit. (setq gnus-newsgroup-limit articles) (let ((total (length gnus-newsgroup-data)) @@ -5595,7 +5614,7 @@ fetch-old-headers verbiage, and so on." 0 ;; Ok, this article is to be visible, so we add it to the limit ;; and return 1. - (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit)) + (push number gnus-newsgroup-limit) 1)))) (defun gnus-expunge-thread (thread) @@ -5746,22 +5765,18 @@ to guess what the document format is." (delete-matching-lines "^\\(Path\\):\\|^From ") (widen)) (unwind-protect - (let ((gnus-current-window-configuration - (if (and (boundp 'gnus-pick-mode) - (symbol-value (intern "gnus-pick-mode"))) - 'pick 'summary))) - (if (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type - ,(if force 'digest 'guess))) t) - ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info name)) - params) - ;; Couldn't select this doc group. - (switch-to-buffer buf) - (gnus-set-global-variables) - (gnus-configure-windows 'summary) - (gnus-message 3 "Article couldn't be entered?"))) + (if (gnus-group-read-ephemeral-group + name `(nndoc ,name (nndoc-address ,(get-buffer dig)) + (nndoc-article-type + ,(if force 'digest 'guess))) t) + ;; Make all postings to this group go to the parent group. + (nconc (gnus-info-params (gnus-get-info name)) + params) + ;; Couldn't select this doc group. + (switch-to-buffer buf) + (gnus-set-global-variables) + (gnus-configure-windows 'summary) + (gnus-message 3 "Article couldn't be entered?")) (kill-buffer dig))))) (defun gnus-summary-read-document (n) @@ -5917,15 +5932,15 @@ in the comparisons." (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) articles d) - (or (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) + (unless (fboundp (intern (concat "mail-header-" header))) + (error "%s is not a valid header" header)) (while data (setq d (car data)) (and (or (not unread) ; We want all articles... (gnus-data-unread-p d)) ; Or just unreads. (vectorp (gnus-data-header d)) ; It's not a pseudo. (string-match regexp (funcall func (gnus-data-header d))) ; Match. - (setq articles (cons (gnus-data-number d) articles))) ; Success! + (push (gnus-data-number d) articles)) ; Success! (setq data (cdr data))) (nreverse articles))) @@ -5968,7 +5983,8 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-min)) - (and gnus-break-pages (gnus-narrow-to-page)))) + (when gnus-break-pages + (gnus-narrow-to-page)))) (defun gnus-summary-end-of-article () "Scroll to the end of the article." @@ -5980,7 +5996,8 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (widen) (goto-char (point-max)) (recenter -3) - (and gnus-break-pages (gnus-narrow-to-page)))) + (when gnus-break-pages + (gnus-narrow-to-page)))) (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. @@ -6041,8 +6058,8 @@ If ARG is a negative number, hide the unwanted header lines." (insert-buffer-substring gnus-original-article-buffer 1 e) (let ((article-inhibit-hiding t)) (run-hooks 'gnus-article-display-hook)) - (if (or (not hidden) (and (numberp arg) (< arg 0))) - (gnus-article-hide-headers))))) + (when (or (not hidden) (and (numberp arg) (< arg 0))) + (gnus-article-hide-headers))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -6098,7 +6115,8 @@ For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' and `request-accept' functions." (interactive "P") - (unless action (setq action 'move)) + (unless action + (setq action 'move)) (gnus-set-global-variables) ;; Check whether the source group supports the required functions. (cond ((and (eq action 'move) @@ -6131,10 +6149,10 @@ and `request-accept' functions." (setq to-method (or select-method (gnus-group-name-to-method to-newsgroup))) ;; Check the method we are to move this article to... - (or (gnus-check-backend-function 'request-accept-article (car to-method)) - (error "%s does not support article copying" (car to-method))) - (or (gnus-check-server to-method) - (error "Can't open server %s" (car to-method))) + (unless (gnus-check-backend-function 'request-accept-article (car to-method)) + (error "%s does not support article copying" (car to-method))) + (unless (gnus-check-server to-method) + (error "Can't open server %s" (car to-method))) (gnus-message 6 "%s to %s: %s..." (caddr (assq action names)) (or (car select-method) to-newsgroup) articles) @@ -6328,8 +6346,8 @@ latter case, they will be copied into the relevant groups." (let ((group gnus-newsgroup-name) (now (current-time)) atts lines) - (or (gnus-check-backend-function 'request-accept-article group) - (error "%s does not support article importing" group)) + (unless (gnus-check-backend-function 'request-accept-article group) + (error "%s does not support article importing" group)) (or (file-readable-p file) (not (file-regular-p file)) (error "Can't read %s" file)) @@ -6348,7 +6366,8 @@ latter case, they will be copied into the relevant groups." "Date: " (timezone-make-date-arpa-standard (current-time-string (nth 5 atts)) (current-time-zone now) - (current-time-zone now)) "\n" + (current-time-zone now)) + "\n" "Message-ID: " (message-make-message-id) "\n" "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) @@ -6434,16 +6453,16 @@ If N is nil and articles have been marked with the process mark, delete these instead." (interactive "P") (gnus-set-global-variables) - (or (gnus-check-backend-function 'request-expire-articles - gnus-newsgroup-name) - (error "The current newsgroup does not support article deletion.")) + (unless (gnus-check-backend-function 'request-expire-articles + gnus-newsgroup-name) + (error "The current newsgroup does not support article deletion.")) ;; Compute the list of articles to delete. (let ((articles (gnus-summary-work-articles n)) not-deleted) (if (and gnus-novice-user (not (gnus-y-or-n-p (format "Do you really want to delete %s forever? " - (if (> (length articles) 1) + (if (> (length articles) 1) (format "these %s articles" (length articles)) "this article"))))) () @@ -6454,8 +6473,8 @@ delete these instead." (gnus-summary-remove-process-mark (car articles)) ;; The backend might not have been able to delete the article ;; after all. - (or (memq (car articles) not-deleted) - (gnus-summary-mark-article (car articles) gnus-canceled-mark)) + (unless (memq (car articles) not-deleted) + (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (setq articles (cdr articles)))) (gnus-summary-position-point) (gnus-set-mode-line 'summary) @@ -6555,8 +6574,8 @@ If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") (gnus-set-global-variables) - (if unmark - (setq unmark (prefix-numeric-value unmark))) + (when unmark + (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject (gnus-summary-article-subject) unmark))) @@ -6574,15 +6593,15 @@ If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") (gnus-set-global-variables) - (if unmark - (setq unmark (prefix-numeric-value unmark))) + (when unmark + (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject (gnus-summary-article-subject) unmark))) ;; If marked as read, go to next unread subject. - (if (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t)) + (when (null unmark) + ;; Go to next unread subject. + (gnus-summary-next-subject 1 t)) (gnus-message 7 "%d articles are marked as %s" count (if unmark "unread" "read")))) @@ -6635,7 +6654,8 @@ number of articles marked is returned." (gnus-summary-set-process-mark (gnus-summary-article-number))) (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) (setq n (1- n))) - (if (/= 0 n) (gnus-message 7 "No more articles")) + (when (/= 0 n) + (gnus-message 7 "No more articles")) (gnus-summary-recenter) (gnus-summary-position-point) n)) @@ -6667,7 +6687,7 @@ the actual number of articles marked is returned." (defun gnus-summary-mark-article-as-replied (article) "Mark ARTICLE replied and update the summary line." - (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) + (push article gnus-newsgroup-replied) (let ((buffer-read-only nil)) (when (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article)))) @@ -6676,30 +6696,30 @@ the actual number of articles marked is returned." "Set a bookmark in current article." (interactive (list (gnus-summary-article-number))) (gnus-set-global-variables) - (if (or (not (get-buffer gnus-article-buffer)) - (not gnus-current-article) - (not gnus-article-current) - (not (equal gnus-newsgroup-name (car gnus-article-current)))) - (error "No current article selected")) + (when (or (not (get-buffer gnus-article-buffer)) + (not gnus-current-article) + (not gnus-article-current) + (not (equal gnus-newsgroup-name (car gnus-article-current)))) + (error "No current article selected")) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) - (if old (setq gnus-newsgroup-bookmarks - (delq old gnus-newsgroup-bookmarks)))) + (when old + (setq gnus-newsgroup-bookmarks + (delq old gnus-newsgroup-bookmarks)))) ;; Set the new bookmark, which is on the form ;; (article-number . line-number-in-body). - (setq gnus-newsgroup-bookmarks - (cons - (cons article - (save-excursion - (set-buffer gnus-article-buffer) - (count-lines - (min (point) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (point))) - (point)))) - gnus-newsgroup-bookmarks)) + (push + (cons article + (save-excursion + (set-buffer gnus-article-buffer) + (count-lines + (min (point) + (save-excursion + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (point))) + (point)))) + gnus-newsgroup-bookmarks) (gnus-message 6 "A bookmark has been added to the current article.")) (defun gnus-summary-remove-bookmark (article) @@ -6769,7 +6789,8 @@ returned." (not (eq gnus-summary-goto-unread 'never))) t))) (setq n (1- n))) - (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) + (when (/= 0 n) + (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) (gnus-summary-recenter) (gnus-summary-position-point) (gnus-set-mode-line 'summary) @@ -6781,10 +6802,10 @@ returned." (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (setq gnus-newsgroup-reads - (cons (cons article mark) gnus-newsgroup-reads)) + (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. - (and gnus-use-cache (gnus-cache-enter-remove-article article)) + (when gnus-use-cache + (gnus-cache-enter-remove-article article)) ;; Allow the backend to change the mark. (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) ;; Check for auto-expiry. @@ -6841,8 +6862,8 @@ If MARK is nil, then the default character `?D' is used. If ARTICLE is nil, then the article on the current line will be marked." ;; The mark might be a string. - (and (stringp mark) - (setq mark (aref mark 0))) + (when (stringp mark) + (setq mark (aref mark 0))) ;; If no mark is given, then we check auto-expiring. (and (not no-expire) gnus-newsgroup-auto-expire @@ -6855,7 +6876,8 @@ marked." (setq mark gnus-expirable-mark)) (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) - (or article (error "No article on current line")) + (unless article + (error "No article on current line")) (if (or (= mark gnus-unread-mark) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) @@ -6873,12 +6895,12 @@ marked." (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - (if (gnus-summary-goto-subject article nil t) - (let ((buffer-read-only nil)) - (gnus-summary-show-thread) - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t)))) + (when (gnus-summary-goto-subject article nil t) + (let ((buffer-read-only nil)) + (gnus-summary-show-thread) + ;; Fix the mark. + (gnus-summary-update-mark mark 'unread) + t)))) (defun gnus-summary-update-secondary-mark (article) "Update the secondary (read, process, cache) mark." @@ -6901,7 +6923,7 @@ marked." (let ((forward (cdr (assq type gnus-summary-mark-positions))) (buffer-read-only nil)) (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) - (when (looking-at "\r") + (when (looking-at "\r") (incf forward)) (when (and forward (<= (+ forward (point)) (point-max))) @@ -6920,7 +6942,7 @@ marked." ;; Make the article expirable. (let ((mark (or mark gnus-del-mark))) (if (= mark gnus-expirable-mark) - (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) + (push article gnus-newsgroup-expirable) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) ;; Remove from unread and marked lists. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) @@ -7094,8 +7116,8 @@ even ticked and dormant ones." (set-buffer gnus-summary-buffer) (goto-char (point-min)) (while (and (progn - (if (> (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) + (when (> (gnus-summary-article-score) score) + (gnus-summary-mark-article nil mark)) t) (gnus-summary-find-next))))) @@ -7109,10 +7131,10 @@ even ticked and dormant ones." (let ((scored gnus-newsgroup-scored) headers h) (while scored - (or (gnus-summary-goto-subject (caar scored)) - (and (setq h (gnus-summary-article-header (caar scored))) - (< (cdar scored) gnus-summary-expunge-below) - (setq headers (cons h headers)))) + (unless (gnus-summary-goto-subject (caar scored)) + (and (setq h (gnus-summary-article-header (caar scored))) + (< (cdar scored) gnus-summary-expunge-below) + (push h headers))) (setq scored (cdr scored))) (if (not headers) (when (not no-error) @@ -7231,7 +7253,7 @@ with that article." (mail-header-subject (gnus-data-header (car data))))) (t nil))) (end-point (save-excursion - (if (gnus-summary-go-to-next-thread) + (if (gnus-summary-go-to-next-thread) (point) (point-max)))) articles) (while (and data @@ -7271,10 +7293,10 @@ with that article." Note that the re-threading will only work if `gnus-thread-ignore-subject' is non-nil or the Subject: of both articles are the same." (interactive) - (or (not (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing.")) - (or (<= (length gnus-newsgroup-processable) 1) - (error "No more than one article may be marked.")) + (unless (not (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing.")) + (unless (<= (length gnus-newsgroup-processable) 1) + (error "No more than one article may be marked.")) (save-window-excursion (let ((gnus-article-buffer " *reparent*") (current-article (gnus-summary-article-number)) @@ -7285,12 +7307,12 @@ is non-nil or the Subject: of both articles are the same." (if (eq (forward-line -1) 0) (gnus-summary-article-number) (error "Beginning of summary buffer.")))))) - (or (not (eq current-article parent-article)) - (error "An article may not be self-referential.")) + (unless (not (eq current-article parent-article)) + (error "An article may not be self-referential.")) (let ((message-id (mail-header-id (gnus-summary-article-header parent-article)))) - (or (and message-id (not (equal message-id ""))) - (error "No message-id in desired parent.")) + (unless (and message-id (not (equal message-id ""))) + (error "No message-id in desired parent.")) (gnus-summary-select-article t t nil current-article) (set-buffer gnus-article-buffer) (setq buffer-read-only nil) @@ -7301,10 +7323,10 @@ is non-nil or the Subject: of both articles are the same." (if (search-forward-regexp "^References: " nil t) (insert message-id " " ) (insert "References: " message-id "\n")) - (or (gnus-request-replace-article current-article - (car gnus-article-current) - gnus-article-buffer) - (error "Couldn't replace article.")) + (unless (gnus-request-replace-article current-article + (car gnus-article-current) + gnus-article-buffer) + (error "Couldn't replace article.")) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-rethread-current) @@ -7438,14 +7460,14 @@ done." (defun gnus-summary-go-down-thread () "Go down one level in the current thread." (let ((children (gnus-summary-article-children))) - (and children - (gnus-summary-goto-subject (car children))))) + (when children + (gnus-summary-goto-subject (car children))))) (defun gnus-summary-go-up-thread () "Go up one level in the current thread." (let ((parent (gnus-summary-article-parent))) - (and parent - (gnus-summary-goto-subject parent)))) + (when parent + (gnus-summary-goto-subject parent)))) (defun gnus-summary-down-thread (n) "Go down thread N steps. @@ -7461,7 +7483,8 @@ taken." (gnus-summary-go-down-thread))) (setq n (1- n))) (gnus-summary-position-point) - (if (/= 0 n) (gnus-message 7 "Can't go further")) + (when (/= 0 n) + (gnus-message 7 "Can't go further")) n)) (defun gnus-summary-up-thread (n) @@ -7507,9 +7530,9 @@ If the prefix argument is negative, tick articles instead." gnus-thread-hide-killed (gnus-summary-hide-thread)) ;; If marked as read, go to next unread subject. - (if (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t))) + (when (null unmark) + ;; Go to next unread subject. + (gnus-summary-next-subject 1 t))) (gnus-set-mode-line 'summary)) ;; Summary sorting commands @@ -7707,7 +7730,7 @@ save those articles instead." (minibuffer-confirm-incomplete nil) ; XEmacs group-map (dum (mapatoms - (lambda (g) + (lambda (g) (and (boundp g) (symbol-name g) (memq 'respool @@ -7740,19 +7763,19 @@ save those articles instead." nil nil nil 'gnus-group-history))))) (when to-newsgroup - (if (or (string= to-newsgroup "") - (string= to-newsgroup prefix)) - (setq to-newsgroup (or default ""))) + (when (or (string= to-newsgroup "") + (string= to-newsgroup prefix)) + (setq to-newsgroup (or default ""))) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) - (if (gnus-y-or-n-p (format "No such group: %s. Create it? " - to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) - (gnus-activate-group to-newsgroup nil nil - (gnus-group-name-to-method - to-newsgroup))) - (error "Couldn't create group %s" to-newsgroup))) + (when (gnus-y-or-n-p (format "No such group: %s. Create it? " + to-newsgroup)) + (or (and (gnus-request-create-group + to-newsgroup (gnus-group-name-to-method to-newsgroup)) + (gnus-activate-group to-newsgroup nil nil + (gnus-group-name-to-method + to-newsgroup))) + (error "Couldn't create group %s" to-newsgroup))) (error "No such group: %s" to-newsgroup))) to-newsgroup)) @@ -7762,8 +7785,8 @@ save those articles instead." (let ((buffer-read-only nil) (article (gnus-summary-article-number)) after-article b e) - (or (gnus-summary-goto-subject article) - (error (format "No such article: %d" article))) + (unless (gnus-summary-goto-subject article) + (error (format "No such article: %d" article))) (gnus-summary-position-point) ;; If all commands are to be bunched up on one line, we collect ;; them here. @@ -7777,13 +7800,13 @@ save those articles instead." (while (and ps (cdr ps) (string= (or action "1") (or (cdr (assq 'action (cadr ps))) "2"))) - (setq files (cons (cdr (assq 'name (cadr ps))) files)) + (push (cdr (assq 'name (cadr ps))) files) (setcdr ps (cddr ps))) (if (not files) () - (if (not (string-match "%s" action)) - (setq files (cons " " files))) - (setq files (cons " " files)) + (when (not (string-match "%s" action)) + (push " " files)) + (push " " files) (and (assq 'execute (car ps)) (setcdr (assq 'execute (car ps)) (funcall (if (string-match "%s" action) @@ -7793,9 +7816,9 @@ save those articles instead." (setq ps (cdr ps))))) (if (and gnus-view-pseudos (not not-view)) (while pslist - (and (assq 'execute (car pslist)) - (gnus-execute-command (cdr (assq 'execute (car pslist))) - (eq gnus-view-pseudos 'not-confirm))) + (when (assq 'execute (car pslist)) + (gnus-execute-command (cdr (assq 'execute (car pslist))) + (eq gnus-view-pseudos 'not-confirm))) (setq pslist (cdr pslist))) (save-excursion (while pslist @@ -7873,7 +7896,7 @@ save those articles instead." (let ((group gnus-newsgroup-name) (gnus-override-method (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) + gnus-refer-article-method)) where) ;; First we check to see whether the header in question is already ;; fetched. @@ -7887,10 +7910,12 @@ save those articles instead." ;; We have found the header. header ;; We have to really fetch the header to this article. - (when (setq where (gnus-request-head id group)) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-max)) + (save-excursion + (set-buffer nntp-server-buffer) + (when (setq where (gnus-request-article-this-buffer id group)) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (delete-region (1- (point)) (point-max))) (insert ".\n") (goto-char (point-min)) (insert "211 ") @@ -7901,21 +7926,23 @@ save those articles instead." (t gnus-reffed-article-number)) (current-buffer)) (insert " Article retrieved.\n")) - (if (not (setq header (car (gnus-get-newsgroup-headers)))) + (if (not (setq header (car (gnus-get-newsgroup-headers nil t)))) () ; Malformed head. (unless (memq (mail-header-number header) gnus-newsgroup-sparse) - (if (and (stringp id) - (not (string= (gnus-group-real-name group) - (car where)))) - ;; If we fetched by Message-ID and the article came - ;; from a different group, we fudge some bogus article - ;; numbers for this article. - (mail-header-set-number header gnus-reffed-article-number)) - (decf gnus-reffed-article-number) - (gnus-remove-header (mail-header-number header)) - (push header gnus-newsgroup-headers) - (setq gnus-current-headers header) - (push (mail-header-number header) gnus-newsgroup-limit)) + (when (and (stringp id) + (not (string= (gnus-group-real-name group) + (car where)))) + ;; If we fetched by Message-ID and the article came + ;; from a different group, we fudge some bogus article + ;; numbers for this article. + (mail-header-set-number header gnus-reffed-article-number)) + (save-excursion + (set-buffer gnus-summary-buffer) + (decf gnus-reffed-article-number) + (gnus-remove-header (mail-header-number header)) + (push header gnus-newsgroup-headers) + (setq gnus-current-headers header) + (push (mail-header-number header) gnus-newsgroup-limit))) header))))) (defun gnus-remove-header (number) @@ -7942,10 +7969,10 @@ save those articles instead." (let* ((beg (progn (beginning-of-line) (point))) (end (progn (end-of-line) (point))) ;; Fix by Mike Dugan . - (from (if (get-text-property beg gnus-mouse-face-prop) + (from (if (get-text-property beg gnus-mouse-face-prop) beg (or (next-single-property-change - beg gnus-mouse-face-prop nil end) + beg gnus-mouse-face-prop nil end) beg))) (to (if (= from end) @@ -8019,13 +8046,14 @@ save those articles instead." ;; Compute the ranges of read articles by looking at the list of ;; unread articles. (while unread - (if (/= (car unread) prev) - (setq read (cons (if (= prev (1- (car unread))) prev - (cons prev (1- (car unread)))) read))) + (when (/= (car unread) prev) + (push (if (= prev (1- (car unread))) prev + (cons prev (1- (car unread)))) + read)) (setq prev (1+ (car unread))) (setq unread (cdr unread))) (when (<= prev (cdr active)) - (setq read (cons (cons prev (cdr active)) read))) + (push (cons prev (cdr active)) read)) (gnus-undo-register `(progn (gnus-info-set-marks ,info ,(gnus-info-marks info)) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index fee823a38..2d64ac1c9 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -189,7 +189,7 @@ with some simple extensions. (if (member group gnus-zombie-list) 8 9))) (and unread ; nil means that the group is dead. - (<= clevel level) + (<= clevel level) (>= clevel lowest) ; Is inside the level we want. (or all (if (eq unread t) @@ -347,7 +347,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." ;; List dead groups? (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) + (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) @@ -401,12 +401,13 @@ articles in the topic and its subtopics." (gnus-group-insert-group-line entry (if (member entry gnus-zombie-list) 8 9) nil (- (1+ (cdr (setq active (gnus-active entry)))) - (car active)) nil) + (car active)) + nil) ;; Living groups. (when (setq info (nth 2 entry)) (gnus-group-insert-group-line (gnus-info-group info) - (gnus-info-level info) (gnus-info-marks info) + (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))))) (when (and (listp entry) (numberp (car entry)) @@ -453,7 +454,7 @@ articles in the topic and its subtopics." (defun gnus-topic-fold (&optional insert) "Remove/insert the current topic." - (let ((topic (gnus-group-topic-name))) + (let ((topic (gnus-group-topic-name))) (when topic (save-excursion (if (not (gnus-group-active-topic-p)) @@ -476,7 +477,7 @@ articles in the topic and its subtopics." ;; Insert the text. (gnus-add-text-properties (point) - (prog1 (1+ (point)) + (prog1 (1+ (point)) (eval gnus-topic-line-format-spec) (gnus-topic-remove-excess-properties)1) (list 'gnus-topic (intern name) @@ -514,7 +515,7 @@ articles in the topic and its subtopics." (gnus-group-goto-group group) (gnus-group-position-point))))) -(defun gnus-topic-goto-missing-group (group) +(defun gnus-topic-goto-missing-group (group) "Place point where GROUP is supposed to be inserted." (let* ((topic (gnus-group-topic group)) (groups (cdr (assoc topic gnus-topic-alist))) @@ -573,7 +574,9 @@ articles in the topic and its subtopics." (or (save-excursion (forward-line -1) (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) 0)) ? )) + (gnus-group-topic-level)) + 0)) + ? )) ;;; Initialization @@ -586,7 +589,7 @@ articles in the topic and its subtopics." gnus-topic-tallied-groups nil gnus-topology-checked-p nil)) -(defun gnus-topic-check-topology () +(defun gnus-topic-check-topology () ;; The first time we set the topology to whatever we have ;; gotten here, which can be rather random. (unless gnus-topic-alist @@ -657,10 +660,10 @@ articles in the topic and its subtopics." (let ((topic-name (pop topic)) group filtered-topic) (while (setq group (pop topic)) - (if (and (or (gnus-gethash group gnus-active-hashtb) - (gnus-info-method (gnus-get-info group))) - (not (gnus-gethash group gnus-killed-hashtb))) - (push group filtered-topic))) + (when (and (or (gnus-gethash group gnus-active-hashtb) + (gnus-info-method (gnus-get-info group))) + (not (gnus-gethash group gnus-killed-hashtb))) + (push group filtered-topic))) (push (cons topic-name (nreverse filtered-topic)) result))) (setq gnus-topic-alist (nreverse result)))) @@ -688,7 +691,9 @@ articles in the topic and its subtopics." (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) 0)) ? )) + (gnus-group-topic-level)) + 0)) + ? )) (yanked (list group)) alist talist end) ;; Then we enter the yanked groups into the topics they belong @@ -989,7 +994,7 @@ If COPYP, copy the groups instead." (start-topic (gnus-group-topic-name)) entry) (mapcar - (lambda (g) + (lambda (g) (gnus-group-remove-mark g) (when (and (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) @@ -1052,7 +1057,9 @@ If COPYP, copy the groups instead." (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) 0)) ? )) + (gnus-group-topic-level)) + 0)) + ? )) yanked alist) ;; We first yank the groups the normal way... (setq yanked (gnus-group-yank-group arg)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 12bcb7121..e9c06fba5 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -86,14 +86,14 @@ (defmacro gnus-buffer-exists-p (buffer) `(let ((buffer ,buffer)) - (and buffer - (funcall (if (stringp buffer) 'get-buffer 'buffer-name) - buffer)))) + (when buffer + (funcall (if (stringp buffer) 'get-buffer 'buffer-name) + buffer)))) (defmacro gnus-kill-buffer (buffer) `(let ((buf ,buffer)) - (if (gnus-buffer-exists-p buf) - (kill-buffer buf)))) + (when (gnus-buffer-exists-p buf) + (kill-buffer buf)))) (defsubst gnus-point-at-bol () "Return point at the beginning of the line." @@ -142,8 +142,8 @@ ;; First find the address - the thing with the @ in it. This may ;; not be accurate in mail addresses, but does the trick most of ;; the time in news messages. - (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (setq address (substring from (match-beginning 0) (match-end 0)))) + (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) + (setq address (substring from (match-beginning 0) (match-end 0)))) ;; Then we check whether the "name
" format is used. (and address ;; Fix by MORIOKA Tomohiko @@ -202,8 +202,8 @@ (setq idx 0)) ;; Replace all occurrences of `.' with `/'. (while (< idx len) - (if (= (aref newsgroup idx) ?.) - (aset newsgroup idx ?/)) + (when (= (aref newsgroup idx) ?.) + (aset newsgroup idx ?/)) (setq idx (1+ idx))) newsgroup)) @@ -331,7 +331,7 @@ ;; it yet. -erik selberg@cs.washington.edu (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string" - (let ((datevec (condition-case () (timezone-parse-date messy-date) + (let ((datevec (condition-case () (timezone-parse-date messy-date) (error nil)))) (if (not datevec) "??-???" @@ -438,7 +438,7 @@ If N, return the Nth ancestor instead." (max 0)) ;; Find the longest line currently displayed in the window. (goto-char (window-start)) - (while (and (not (eobp)) + (while (and (not (eobp)) (< (point) end)) (end-of-line) (setq max (max max (current-column))) @@ -479,10 +479,11 @@ Timezone package is used." (interactive (list (read-file-name "Copy file: " default-directory) (read-file-name "Copy file to: " default-directory))) - (or to (setq to (read-file-name "Copy file to: " default-directory))) - (and (file-directory-p to) - (setq to (concat (file-name-as-directory to) - (file-name-nondirectory file)))) + (unless to + (setq to (read-file-name "Copy file to: " default-directory))) + (when (file-directory-p to) + (setq to (concat (file-name-as-directory to) + (file-name-nondirectory file)))) (copy-file file to)) (defun gnus-kill-all-overlays () @@ -553,6 +554,13 @@ Bind `print-quoted' to t while printing." (make-directory directory t)) t) +(defun gnus-write-buffer (file) + "Write the current buffer's contents to FILE." + ;; Make sure the directory exists. + (gnus-make-directory (file-name-directory file)) + ;; Write the buffer. + (write-region (point-min) (point-max) file nil 'quietly)) + (defmacro gnus-delete-assq (key list) `(let ((listval (eval ,list))) (setq ,list (delq (assq ,key listval) listval)))) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index a0adc3a5d..8e6c247a6 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -320,7 +320,7 @@ The headers will be included in the sequence they are matched.") (defun gnus-uu-decode-uu (&optional n) "Uudecodes the current article." - (interactive "P") + (interactive "P") (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) (defun gnus-uu-decode-uu-and-save (n dir) @@ -450,12 +450,12 @@ The headers will be included in the sequence they are matched.") fs (cdr fs)) (while (and fs (or from subject)) (when from - (or (string= from (caar fs)) - (setq from nil))) + (unless (string= from (caar fs)) + (setq from nil))) (when subject - (or (string= (gnus-simplify-subject-fuzzy (cdar fs)) - subject) - (setq subject nil))) + (unless (string= (gnus-simplify-subject-fuzzy (cdar fs)) + subject) + (setq subject nil))) (setq fs (cdr fs)))) (unless subject (setq subject "Digested Articles")) @@ -594,7 +594,8 @@ The headers will be included in the sequence they are matched.") (gnus-set-global-variables) (let ((marked (nreverse gnus-newsgroup-processable)) subject articles total headers) - (or marked (error "No articles marked with the process mark")) + (unless marked + (error "No articles marked with the process mark")) (setq gnus-newsgroup-processable nil) (save-excursion (while marked @@ -669,7 +670,8 @@ The headers will be included in the sequence they are matched.") (defun gnus-uu-decode-with-method (method n &optional save not-insert scan cdir) (gnus-uu-initialize scan) - (if save (setq gnus-uu-default-dir save)) + (when save + (setq gnus-uu-default-dir save)) ;; Create the directory we save to. (when (and scan cdir save (not (file-exists-p save))) @@ -678,10 +680,12 @@ The headers will be included in the sequence they are matched.") files) (setq files (gnus-uu-grab-articles articles method t)) (let ((gnus-current-article (car articles))) - (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) - (and save (gnus-uu-save-files files save)) - (if (eq gnus-uu-do-not-unpack-archives nil) - (setq files (gnus-uu-unpack-files files))) + (when scan + (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) + (when save + (gnus-uu-save-files files save)) + (when (eq gnus-uu-do-not-unpack-archives nil) + (setq files (gnus-uu-unpack-files files))) (setq files (nreverse (gnus-uu-get-actions files))) (or not-insert (not gnus-insert-pseudo-articles) (gnus-summary-insert-pseudos files save)))) @@ -727,8 +731,8 @@ The headers will be included in the sequence they are matched.") (gnus-uu-save-separate-articles (save-excursion (set-buffer buffer) - (write-region 1 (point-max) (concat gnus-uu-saved-article-name - gnus-current-article)) + (gnus-write-buffer + (concat gnus-uu-saved-article-name gnus-current-article)) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) @@ -737,7 +741,7 @@ The headers will be included in the sequence they are matched.") ((not gnus-uu-save-in-digest) (save-excursion (set-buffer buffer) - (write-region 1 (point-max) gnus-uu-saved-article-name t) + (write-region (point-min) (point-max) gnus-uu-saved-article-name t) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) @@ -745,14 +749,13 @@ The headers will be included in the sequence they are matched.") (t (list 'middle))))) (t (let ((header (gnus-summary-article-header))) - (setq gnus-uu-digest-from-subject - (cons (cons (mail-header-from header) - (mail-header-subject header)) - gnus-uu-digest-from-subject))) + (push (cons (mail-header-from header) + (mail-header-subject header)) + gnus-uu-digest-from-subject)) (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) (delim (concat "^" (make-string 30 ?-) "$")) beg subj headers headline sorthead body end-string state) - (if (or (eq in-state 'first) + (if (or (eq in-state 'first) (eq in-state 'first-and-last)) (progn (setq state (list 'begin)) @@ -764,8 +767,8 @@ The headers will be included in the sequence they are matched.") (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" (current-time-string) name name)))) - (if (not (eq in-state 'end)) - (setq state (list 'middle)))) + (when (not (eq in-state 'end)) + (setq state (list 'middle)))) (save-excursion (set-buffer (get-buffer "*gnus-uu-body*")) (goto-char (setq beg (point-max))) @@ -806,30 +809,29 @@ The headers will be included in the sequence they are matched.") (insert body) (goto-char (point-max)) (insert (concat "\n" (make-string 30 ?-) "\n\n")) (goto-char beg) - (if (re-search-forward "^Subject: \\(.*\\)$" nil t) - (progn - (setq subj (buffer-substring (match-beginning 1) (match-end 1))) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format " %s\n" subj)))))) - (if (or (eq in-state 'last) - (eq in-state 'first-and-last)) - (progn - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (write-region 1 (point-max) gnus-uu-saved-article-name)) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (write-region 1 (point-max) gnus-uu-saved-article-name t)) - (kill-buffer (get-buffer "*gnus-uu-pre*")) - (kill-buffer (get-buffer "*gnus-uu-body*")) - (setq state (cons 'end state)))) + (when (re-search-forward "^Subject: \\(.*\\)$" nil t) + (setq subj (buffer-substring (match-beginning 1) (match-end 1))) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-pre*")) + (insert (format " %s\n" subj))))) + (when (or (eq in-state 'last) + (eq in-state 'first-and-last)) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-pre*")) + (insert (format "\n\n%s\n\n" (make-string 70 ?-))) + (gnus-write-buffer gnus-uu-saved-article-name)) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-body*")) + (goto-char (point-max)) + (insert + (concat (setq end-string (format "End of %s Digest" name)) + "\n")) + (insert (concat (make-string (length end-string) ?*) "\n")) + (write-region + (point-min) (point-max) gnus-uu-saved-article-name t)) + (kill-buffer (get-buffer "*gnus-uu-pre*")) + (kill-buffer (get-buffer "*gnus-uu-body*")) + (push 'end state)) (if (memq 'begin state) (cons gnus-uu-saved-article-name state) state))))) @@ -849,9 +851,9 @@ The headers will be included in the sequence they are matched.") (set-buffer buffer) (widen) (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-binhex-begin-line nil t)) - (if (not (re-search-forward gnus-uu-binhex-body-line nil t)) - (setq state (list 'wrong-type)))) + (when (not (re-search-forward gnus-uu-binhex-begin-line nil t)) + (when (not (re-search-forward gnus-uu-binhex-body-line nil t)) + (setq state (list 'wrong-type)))) (if (memq 'wrong-type state) () @@ -864,15 +866,16 @@ The headers will be included in the sequence they are matched.") (setq state (list 'middle))) (goto-char (point-max)) (re-search-backward (concat gnus-uu-binhex-body-line "\\|" - gnus-uu-binhex-end-line) nil t) - (if (looking-at gnus-uu-binhex-end-line) - (setq state (if (memq 'begin state) - (cons 'end state) - (list 'end)))) + gnus-uu-binhex-end-line) + nil t) + (when (looking-at gnus-uu-binhex-end-line) + (setq state (if (memq 'begin state) + (cons 'end state) + (list 'end)))) (beginning-of-line) (forward-line 1) - (if (file-exists-p gnus-uu-binhex-article-name) - (append-to-file start-char (point) gnus-uu-binhex-article-name)))) + (when (file-exists-p gnus-uu-binhex-article-name) + (append-to-file start-char (point) gnus-uu-binhex-article-name)))) (if (memq 'begin state) (cons gnus-uu-binhex-article-name state) state))) @@ -930,11 +933,11 @@ The headers will be included in the sequence they are matched.") nil gnus-uu-default-view-rules) gnus-uu-user-view-rules-end))) - (if (and (not (string= (or action "") "gnus-uu-archive")) - gnus-uu-view-with-metamail) - (if (setq action + (when (and (not (string= (or action "") "gnus-uu-archive")) + gnus-uu-view-with-metamail) + (when (setq action (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) - (setq action (format "metamail -d -b -c \"%s\"" action)))) + (setq action (format "metamail -d -b -c \"%s\"" action)))) action)) @@ -959,10 +962,9 @@ The headers will be included in the sequence they are matched.") (setq case-fold-search nil) (goto-char (point-min)) - (if (looking-at vernum) - (progn - (replace-match vernum t t) - (setq beg (length vernum)))) + (when (looking-at vernum) + (replace-match vernum t t) + (setq beg (length vernum))) (goto-char beg) (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) @@ -975,7 +977,7 @@ The headers will be included in the sequence they are matched.") (end-of-line) (while (and (re-search-backward "[0-9]" nil t) (> count 0)) (while (and - (looking-at "[0-9]") + (looking-at "[0-9]") (< 1 (goto-char (1- (point)))))) (re-search-forward "[0-9]+" nil t) (replace-match "[0-9]+") @@ -1002,8 +1004,8 @@ The headers will be included in the sequence they are matched.") (n (abs n))) (save-excursion (while (and (> n 0) - (setq articles (cons (gnus-summary-article-number) - articles)) + (push (gnus-summary-article-number) + articles) (gnus-summary-search-forward nil nil backward)) (setq n (1- n)))) (nreverse articles))) @@ -1041,16 +1043,15 @@ The headers will be included in the sequence they are matched.") (= mark gnus-dormant-mark)) (setq subj (mail-header-subject (gnus-data-header d))) (string-match subject subj) - (setq list-of-subjects - (cons (cons subj (gnus-data-number d)) - list-of-subjects))))) + (push (cons subj (gnus-data-number d)) + list-of-subjects)))) ;; Expand numbers, sort, and return the list of article ;; numbers. - (mapcar (lambda (sub) (cdr sub)) + (mapcar (lambda (sub) (cdr sub)) (sort (gnus-uu-expand-numbers list-of-subjects - (not do-not-translate)) + (not do-not-translate)) 'gnus-uu-string<)))))) (defun gnus-uu-expand-numbers (string-list &optional translate) @@ -1073,9 +1074,9 @@ The headers will be included in the sequence they are matched.") (replace-match " ")) ;; Translate all characters to "a". (goto-char (point-min)) - (if translate - (while (re-search-forward "[A-Za-z]" nil t) - (replace-match "a" t t))) + (when translate + (while (re-search-forward "[A-Za-z]" nil t) + (replace-match "a" t t))) ;; Expand numbers. (goto-char (point-min)) (while (re-search-forward "[0-9]+" nil t) @@ -1120,15 +1121,14 @@ The headers will be included in the sequence they are matched.") (if (not (and gnus-uu-has-been-grabbed gnus-uu-unmark-articles-not-decoded)) () - (if dont-unmark-last-article - (progn - (setq art (car gnus-uu-has-been-grabbed)) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))) + (when dont-unmark-last-article + (setq art (car gnus-uu-has-been-grabbed)) + (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) (while gnus-uu-has-been-grabbed (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (if dont-unmark-last-article - (setq gnus-uu-has-been-grabbed (list art)))))) + (when dont-unmark-last-article + (setq gnus-uu-has-been-grabbed (list art)))))) ;; This function takes a list of articles and a function to apply to ;; each article grabbed. @@ -1137,7 +1137,7 @@ The headers will be included in the sequence they are matched.") ;; the process-function has been successful and nil otherwise. (defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) - (let ((state 'first) + (let ((state 'first) (gnus-asynchronous nil) has-been-begin article result-file result-files process-state gnus-summary-display-article-function @@ -1177,18 +1177,18 @@ The headers will be included in the sequence they are matched.") ;; If this is the beginning of a decoded file, we push it ;; on to a list. (when (or (memq 'begin process-state) - (and (or (eq state 'first) + (and (or (eq state 'first) (eq state 'first-and-last)) (memq 'ok process-state))) - (if has-been-begin - ;; If there is a `result-file' here, that means that the - ;; file was unsuccessfully decoded, so we delete it. - (when (and result-file - (file-exists-p result-file) - (gnus-y-or-n-p - (format "Delete unsuccessfully decoded file %s" - result-file))) - (delete-file result-file))) + (when has-been-begin + ;; If there is a `result-file' here, that means that the + ;; file was unsuccessfully decoded, so we delete it. + (when (and result-file + (file-exists-p result-file) + (gnus-y-or-n-p + (format "Delete unsuccessfully decoded file %s" + result-file))) + (delete-file result-file))) (when (memq 'begin process-state) (setq result-file (car process-state))) (setq has-been-begin t)) @@ -1252,7 +1252,7 @@ The headers will be included in the sequence they are matched.") (gnus-message 2 "Wrong type file")) ((memq 'error process-state) (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) + ((not (or (memq 'ok process-state) (memq 'end process-state))) (gnus-message 2 "End of articles reached before end of file"))) ;; Make unsuccessfully decoded articles unread. @@ -1330,7 +1330,7 @@ The headers will be included in the sequence they are matched.") ;; If a process is running, we kill it. (when (and gnus-uu-uudecode-process - (memq (process-status gnus-uu-uudecode-process) + (memq (process-status gnus-uu-uudecode-process) '(run stop))) (delete-process gnus-uu-uudecode-process) (gnus-uu-unmark-list-of-grabbed t)) @@ -1355,7 +1355,7 @@ The headers will be included in the sequence they are matched.") ;; We look for the end of the thing to be decoded. (if (re-search-forward gnus-uu-end-string nil t) - (setq state (cons 'end state)) + (push 'end state) (goto-char (point-max)) (re-search-backward gnus-uu-body-line nil t)) @@ -1420,8 +1420,8 @@ The headers will be included in the sequence they are matched.") (let ((oldpoint (point)) res) (goto-char (point-min)) - (if (re-search-forward gnus-uu-shar-name-marker nil t) - (setq res (buffer-substring (match-beginning 1) (match-end 1)))) + (when (re-search-forward gnus-uu-shar-name-marker nil t) + (setq res (buffer-substring (match-beginning 1) (match-end 1)))) (goto-char oldpoint) res)) @@ -1433,21 +1433,21 @@ The headers will be included in the sequence they are matched.") (case-fold-search t) rule action) (and - (or no-ignore - (and (not - (and gnus-uu-ignore-files-by-name - (string-match gnus-uu-ignore-files-by-name file-name))) - (not - (and gnus-uu-ignore-files-by-type - (string-match gnus-uu-ignore-files-by-type - (or (gnus-uu-choose-action - file-name gnus-uu-ext-to-mime-list t) - "")))))) + (unless no-ignore + (and (not + (and gnus-uu-ignore-files-by-name + (string-match gnus-uu-ignore-files-by-name file-name))) + (not + (and gnus-uu-ignore-files-by-type + (string-match gnus-uu-ignore-files-by-type + (or (gnus-uu-choose-action + file-name gnus-uu-ext-to-mime-list t) + "")))))) (while (not (or (eq action-list ()) action)) (setq rule (car action-list)) (setq action-list (cdr action-list)) - (if (string-match (car rule) file-name) - (setq action (cadr rule))))) + (when (string-match (car rule) file-name) + (setq action (cadr rule))))) action)) (defun gnus-uu-treat-archive (file-path) @@ -1460,13 +1460,14 @@ The headers will be included in the sequence they are matched.") nil gnus-uu-default-archive-rules)))) - (if (not action) (error "No unpackers for the file %s" file-path)) + (when (not action) + (error "No unpackers for the file %s" file-path)) (string-match "/[^/]*$" file-path) (setq dir (substring file-path 0 (match-beginning 0))) - (if (member action gnus-uu-destructive-archivers) - (copy-file file-path (concat file-path "~") t)) + (when (member action gnus-uu-destructive-archivers) + (copy-file file-path (concat file-path "~") t)) (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) @@ -1483,8 +1484,8 @@ The headers will be included in the sequence they are matched.") (gnus-message 2 "Error during unpacking of archive") (setq did-unpack nil)) - (if (member action gnus-uu-destructive-archivers) - (rename-file (concat file-path "~") file-path t)) + (when (member action gnus-uu-destructive-archivers) + (rename-file (concat file-path "~") file-path t)) did-unpack)) @@ -1494,7 +1495,7 @@ The headers will be included in the sequence they are matched.") (while dirs (if (file-directory-p (setq file (car dirs))) (setq files (append files (gnus-uu-dir-files file))) - (setq files (cons file files))) + (push file files)) (setq dirs (cdr dirs))) files)) @@ -1505,22 +1506,21 @@ The headers will be included in the sequence they are matched.") file did-unpack) (while files (setq file (cdr (assq 'name (car files)))) - (if (and (not (member file ignore)) - (equal (gnus-uu-get-action (file-name-nondirectory file)) - "gnus-uu-archive")) - (progn - (setq did-unpack (cons file did-unpack)) - (or (gnus-uu-treat-archive file) - (gnus-message 2 "Error during unpacking of %s" file)) - (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (nfiles newfiles)) - (while nfiles - (or (member (car nfiles) totfiles) - (setq ofiles (cons (list (cons 'name (car nfiles)) - (cons 'original file)) - ofiles))) - (setq nfiles (cdr nfiles))) - (setq totfiles newfiles)))) + (when (and (not (member file ignore)) + (equal (gnus-uu-get-action (file-name-nondirectory file)) + "gnus-uu-archive")) + (push file did-unpack) + (unless (gnus-uu-treat-archive file) + (gnus-message 2 "Error during unpacking of %s" file)) + (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) + (nfiles newfiles)) + (while nfiles + (unless (member (car nfiles) totfiles) + (push (list (cons 'name (car nfiles)) + (cons 'original file)) + ofiles)) + (setq nfiles (cdr nfiles))) + (setq totfiles newfiles))) (setq files (cdr files))) (if did-unpack (gnus-uu-unpack-files ofiles (append did-unpack ignore)) @@ -1530,10 +1530,9 @@ The headers will be included in the sequence they are matched.") (let* ((files (gnus-uu-directory-files dir t)) (ofiles files)) (while files - (if (file-directory-p (car files)) - (progn - (setq ofiles (delete (car files) ofiles)) - (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))) + (when (file-directory-p (car files)) + (setq ofiles (delete (car files) ofiles)) + (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))) (setq files (cdr files))) ofiles)) @@ -1545,8 +1544,8 @@ The headers will be included in the sequence they are matched.") (while files (setq file (car files)) (setq files (cdr files)) - (or (member (file-name-nondirectory file) '("." "..")) - (setq out (cons file out)))) + (unless (member (file-name-nondirectory file) '("." "..")) + (push file out))) (setq out (nreverse out)) out)) @@ -1562,25 +1561,25 @@ The headers will be included in the sequence they are matched.") (goto-char start) (while (not (eobp)) (progn - (if (looking-at "\n") (replace-match "")) + (when (looking-at "\n") + (replace-match "")) (forward-line 1)))) (while (not (eobp)) (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) () - (if (not found) - (progn - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg)))) + (when (not found) + (beginning-of-line) + (setq beg (point)) + (end-of-line) + (setq length (- (point) beg))) (setq found t) (beginning-of-line) (setq beg (point)) (end-of-line) - (if (not (= length (- (point) beg))) - (insert (make-string (- length (- (point) beg)) ? )))) + (when (not (= length (- (point) beg))) + (insert (make-string (- length (- (point) beg)) ? )))) (forward-line 1))))))) (defvar gnus-uu-tmp-alist nil) @@ -1588,27 +1587,27 @@ The headers will be included in the sequence they are matched.") (defun gnus-uu-initialize (&optional scan) (let (entry) (if (and (not scan) - (if (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) - (if (file-exists-p (cdr entry)) - (setq gnus-uu-work-dir (cdr entry)) - (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) - nil))) + (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) + (if (file-exists-p (cdr entry)) + (setq gnus-uu-work-dir (cdr entry)) + (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) + nil))) t (setq gnus-uu-tmp-dir (file-name-as-directory (expand-file-name gnus-uu-tmp-dir))) (if (not (file-directory-p gnus-uu-tmp-dir)) (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) - (if (not (file-writable-p gnus-uu-tmp-dir)) - (error "Temp directory %s can't be written to" - gnus-uu-tmp-dir))) + (when (not (file-writable-p gnus-uu-tmp-dir)) + (error "Temp directory %s can't be written to" + gnus-uu-tmp-dir))) (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) (gnus-make-directory gnus-uu-work-dir) (set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) - (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir) - gnus-uu-tmp-alist))))) + (push (cons gnus-newsgroup-name gnus-uu-work-dir) + gnus-uu-tmp-alist)))) ;; Kills the temporary uu buffers, kills any processes, etc. @@ -1618,8 +1617,8 @@ The headers will be included in the sequence they are matched.") (memq (process-status (or gnus-uu-uudecode-process "nevair")) '(stop run)) (delete-process gnus-uu-uudecode-process)) - (and (setq buf (get-buffer gnus-uu-output-buffer-name)) - (kill-buffer buf)))) + (when (setq buf (get-buffer gnus-uu-output-buffer-name)) + (kill-buffer buf)))) ;; Inputs an action and a file and returns a full command, putting ;; quotes round the file name and escaping any quotes in the file name. @@ -1720,9 +1719,9 @@ is t.") (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) - (if gnus-uu-post-include-before-composing - (save-excursion (setq gnus-uu-post-inserted-file-name - (gnus-uu-post-insert-binary))))) + (when gnus-uu-post-include-before-composing + (save-excursion (setq gnus-uu-post-inserted-file-name + (gnus-uu-post-insert-binary))))) (defun gnus-uu-post-insert-binary-in-article () "Inserts an encoded file in the buffer. @@ -1733,33 +1732,30 @@ The user will be asked for a file name." ;; Encodes with uuencode and substitutes all spaces with backticks. (defun gnus-uu-post-encode-uuencode (path file-name) - (if (gnus-uu-post-encode-file "uuencode" path file-name) - (progn - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward " " nil t) - (replace-match "`")) - t))) + (when (gnus-uu-post-encode-file "uuencode" path file-name) + (goto-char (point-min)) + (forward-line 1) + (while (re-search-forward " " nil t) + (replace-match "`")) + t)) ;; Encodes with uuencode and adds MIME headers. (defun gnus-uu-post-encode-mime-uuencode (path file-name) - (if (gnus-uu-post-encode-uuencode path file-name) - (progn - (gnus-uu-post-make-mime file-name "x-uue") - t))) + (when (gnus-uu-post-encode-uuencode path file-name) + (gnus-uu-post-make-mime file-name "x-uue") + t)) ;; Encodes with base64 and adds MIME headers (defun gnus-uu-post-encode-mime (path file-name) - (if (gnus-uu-post-encode-file "mmencode" path file-name) - (progn - (gnus-uu-post-make-mime file-name "base64") - t))) + (when (gnus-uu-post-encode-file "mmencode" path file-name) + (gnus-uu-post-make-mime file-name "base64") + t)) ;; Adds MIME headers. (defun gnus-uu-post-make-mime (file-name encoding) (goto-char (point-min)) (insert (format "Content-Type: %s; name=\"%s\"\n" - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) + (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction @@ -1768,10 +1764,9 @@ The user will be asked for a file name." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line -1) (narrow-to-region 1 (point)) - (or (mail-fetch-field "mime-version") - (progn - (widen) - (insert "MIME-Version: 1.0\n"))) + (unless (mail-fetch-field "mime-version") + (widen) + (insert "MIME-Version: 1.0\n")) (widen))) ;; Encodes a file PATH with COMMAND, leaving the result in the @@ -1801,22 +1796,21 @@ If no file has been included, the user will be asked for a file." (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) gnus-inews-article-hook (list gnus-inews-article-hook))) - (setq gnus-inews-article-hook - (cons - '(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)) + (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))) (setq gnus-uu-post-inserted-file-name nil) - (and gnus-uu-winconf-post-news - (set-window-configuration gnus-uu-winconf-post-news))) + (when gnus-uu-winconf-post-news + (set-window-configuration gnus-uu-winconf-post-news))) ;; Asks for a file to encode, encodes it and inserts the result in ;; the current buffer. Returns the file name the user gave. @@ -1826,14 +1820,14 @@ If no file has been included, the user will be asked for a file." (setq file-path (read-file-name "What file do you want to encode? ")) - (if (not (file-exists-p file-path)) - (error "%s: No such file" file-path)) + (when (not (file-exists-p file-path)) + (error "%s: No such file" file-path)) (goto-char (point-max)) (insert (format "\n%s\n" gnus-uu-post-binary-separator)) - (if (string-match "^~/" file-path) - (setq file-path (concat "$HOME" (substring file-path 1)))) + (when (string-match "^~/" file-path) + (setq file-path (concat "$HOME" (substring file-path 1)))) (if (string-match "/[^/]*$" file-path) (setq file-name (substring file-path (1+ (match-beginning 0)))) (setq file-name file-path)) @@ -1861,12 +1855,13 @@ If no file has been included, the user will be asked for a file." (setq post-buf (current-buffer)) (goto-char (point-min)) - (if (not (re-search-forward - (if gnus-uu-post-separate-description - (concat "^" (regexp-quote gnus-uu-post-binary-separator) - "$") - (concat "^" (regexp-quote mail-header-separator) "$")) nil t)) - (error "Internal error: No binary/header separator")) + (when (not (re-search-forward + (if gnus-uu-post-separate-description + (concat "^" (regexp-quote gnus-uu-post-binary-separator) + "$") + (concat "^" (regexp-quote mail-header-separator) "$")) + nil t)) + (error "Internal error: No binary/header separator")) (beginning-of-line) (forward-line 1) (setq beg-binary (point)) @@ -1879,11 +1874,11 @@ If no file has been included, the user will be asked for a file." (goto-char (point-min)) (setq length (count-lines 1 (point-max))) (setq parts (/ length gnus-uu-post-length)) - (if (not (< (% length gnus-uu-post-length) 4)) - (setq parts (1+ parts)))) + (when (not (< (% length gnus-uu-post-length) 4)) + (setq parts (1+ parts)))) - (if gnus-uu-post-separate-description - (forward-line -1)) + (when gnus-uu-post-separate-description + (forward-line -1)) (kill-region (point) (point-max)) (goto-char (point-min)) @@ -1895,10 +1890,9 @@ If no file has been included, the user will be asked for a file." (goto-char (point-min)) (if (not gnus-uu-post-separate-description) () - (if (and (not threaded) (re-search-forward "^Subject: " nil t)) - (progn - (end-of-line) - (insert (format " (0/%d)" parts)))) + (when (and (not threaded) (re-search-forward "^Subject: " nil t)) + (end-of-line) + (insert (format " (0/%d)" parts))) (message-send)) (save-excursion @@ -1908,17 +1902,17 @@ If no file has been included, the user will be asked for a file." (set-buffer (get-buffer-create send-buffer-name)) (erase-buffer) (insert header) - (if (and threaded gnus-uu-post-message-id) - (insert (format "References: %s\n" gnus-uu-post-message-id))) + (when (and threaded gnus-uu-post-message-id) + (insert (format "References: %s\n" gnus-uu-post-message-id))) (insert separator) (setq whole-len (- 62 (length (format top-string "" file-name i parts "")))) - (if (> 1 (setq minlen (/ whole-len 2))) - (setq minlen 1)) + (when (> 1 (setq minlen (/ whole-len 2))) + (setq minlen 1)) (setq beg-line (format top-string - (make-string minlen ?-) + (make-string minlen ?-) file-name i parts (make-string (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) @@ -1930,9 +1924,9 @@ If no file has been included, the user will be asked for a file." (progn (end-of-line) (insert (format " (%d/%d)" i parts))) - (if (or (and (= i 2) gnus-uu-post-separate-description) - (and (= i 1) (not gnus-uu-post-separate-description))) - (replace-match "Subject: Re: ")))) + (when (or (and (= i 2) gnus-uu-post-separate-description) + (and (= i 1) (not gnus-uu-post-separate-description))) + (replace-match "Subject: Re: ")))) (goto-char (point-max)) (save-excursion @@ -1941,8 +1935,8 @@ If no file has been included, the user will be asked for a file." (if (= i parts) (goto-char (point-max)) (forward-line gnus-uu-post-length)) - (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) - (forward-line -4)) + (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) + (forward-line -4)) (setq end (point))) (insert-buffer-substring uubuf beg end) (insert beg-line) @@ -1954,26 +1948,25 @@ If no file has been included, the user will be asked for a file." (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (forward-line 2) - (if (re-search-forward - (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") - nil t) - (progn - (replace-match "") - (forward-line 1))) + (when (re-search-forward + (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") + nil t) + (replace-match "") + (forward-line 1)) (insert beg-line) (insert "\n") (let (message-sent-message-via) (message-send)))) - (and (setq buf (get-buffer send-buffer-name)) - (kill-buffer buf)) - (and (setq buf (get-buffer encoded-buffer-name)) - (kill-buffer buf)) + (when (setq buf (get-buffer send-buffer-name)) + (kill-buffer buf)) + (when (setq buf (get-buffer encoded-buffer-name)) + (kill-buffer buf)) - (if (not gnus-uu-post-separate-description) - (progn - (set-buffer-modified-p nil) - (and (fboundp 'bury-buffer) (bury-buffer)))))) + (when (not gnus-uu-post-separate-description) + (set-buffer-modified-p nil) + (when (fboundp 'bury-buffer) + (bury-buffer))))) (provide 'gnus-uu) diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index 74a623c21..c5d9716f7 100644 --- a/lisp/gnus-vm.el +++ b/lisp/gnus-vm.el @@ -49,12 +49,12 @@ Has to be set before gnus-vm is loaded.") (or gnus-vm-inhibit-window-system (condition-case nil - (if window-system - (require 'win-vm)) + (when window-system + (require 'win-vm)) (error nil))) -(if (not (featurep 'vm)) - (load "vm")) +(when (not (featurep 'vm)) + (load "vm")) (defun gnus-vm-make-folder (&optional buffer) (let ((article (or buffer (current-buffer))) diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 25ea55444..9dd08d9c9 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -378,7 +378,8 @@ buffer configuration.") (split-window window (cadar comp-subs) (eq type 'horizontal)))) (setq result (or (gnus-configure-frame - (car comp-subs) window) result)) + (car comp-subs) window) + result)) (select-window new-win) (setq window new-win) (setq comp-subs (cdr comp-subs)))) @@ -493,39 +494,35 @@ should have point." ;; Remove windows on all known Gnus buffers. (while buffers (setq buf (cdar buffers)) - (if (symbolp buf) - (setq buf (and (boundp buf) (symbol-value buf)))) + (when (symbolp buf) + (setq buf (and (boundp buf) (symbol-value buf)))) (and buf (get-buffer-window buf) (progn - (setq bufs (cons buf bufs)) + (push buf bufs) (pop-to-buffer buf) - (if (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (progn - (setq lowest (gnus-window-top-edge)) - (setq lowest-buf buf))))) + (when (or (not lowest) + (< (gnus-window-top-edge) lowest)) + (setq lowest (gnus-window-top-edge)) + (setq lowest-buf buf)))) (setq buffers (cdr buffers))) ;; Remove windows on *all* summary buffers. (walk-windows (lambda (win) (let ((buf (window-buffer win))) - (if (string-match "^\\*Summary" (buffer-name buf)) - (progn - (setq bufs (cons buf bufs)) - (pop-to-buffer buf) - (if (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (progn - (setq lowest-buf buf) - (setq lowest (gnus-window-top-edge))))))))) - (and lowest-buf - (progn - (pop-to-buffer lowest-buf) - (switch-to-buffer nntp-server-buffer))) + (when (string-match "^\\*Summary" (buffer-name buf)) + (push buf bufs) + (pop-to-buffer buf) + (when (or (not lowest) + (< (gnus-window-top-edge) lowest)) + (setq lowest-buf buf) + (setq lowest (gnus-window-top-edge))))))) + (when lowest-buf + (pop-to-buffer lowest-buf) + (switch-to-buffer nntp-server-buffer)) (while bufs - (and (not (eq (car bufs) lowest-buf)) - (delete-windows-on (car bufs))) + (when (not (eq (car bufs) lowest-buf)) + (delete-windows-on (car bufs))) (setq bufs (cdr bufs)))))) (provide 'gnus-win) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index ab4048f98..41d4fc137 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -36,8 +36,8 @@ If this variable is nil, Gnus will try to locate the directory automatically.") (defvar gnus-xmas-logo-color-alist - '((flame "#cc3300" "#ff2200") - (pine "#c0cc93" "#f8ffb8") + '((flame "#cc3300" "#ff2200") + (pine "#c0cc93" "#f8ffb8") (moss "#a1cc93" "#d2ffb8") (irish "#04cc90" "#05ff97") (sky "#049acc" "#05deff") @@ -118,7 +118,7 @@ asynchronously. The compressed face will be piped to this command.") (defun gnus-xmas-set-text-properties (start end props &optional buffer) "You should NEVER use this function. It is ideologically blasphemous. It is provided only to ease porting of broken FSF Emacs programs." - (if (stringp buffer) + (if (stringp buffer) nil (map-extents (lambda (extent ignored) (remove-text-properties @@ -131,8 +131,8 @@ It is provided only to ease porting of broken FSF Emacs programs." (defun gnus-xmas-highlight-selected-summary () ;; Highlight selected article in summary buffer (when gnus-summary-selected-face - (if gnus-newsgroup-selected-overlay - (delete-extent gnus-newsgroup-selected-overlay)) + (when gnus-newsgroup-selected-overlay + (delete-extent gnus-newsgroup-selected-overlay)) (setq gnus-newsgroup-selected-overlay (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) (set-extent-face gnus-newsgroup-selected-overlay @@ -161,8 +161,7 @@ displayed, no centering will be performed." ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start - window (min bottom (save-excursion - (forward-line (- top)) (point))))) + window (min bottom (save-excursion (forward-line (- top)) (point))))) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) (not (eq gnus-auto-center-summary 'vertical))) @@ -197,7 +196,8 @@ call it with the value of the `gnus-data' text property." (let* ((pos (event-closest-point event)) (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) - (if fun (funcall fun data)))) + (when fun + (funcall fun data)))) (defun gnus-xmas-move-overlay (extent start end &optional buffer) (set-extent-endpoints extent start end)) @@ -205,9 +205,9 @@ call it with the value of the `gnus-data' text property." ;; Fixed by Christopher Davis . (defun gnus-xmas-article-add-button (from to fun &optional data) "Create a button between FROM and TO with callback FUN and data DATA." - (and gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay from to) + 'face gnus-article-button-face)) (gnus-add-text-properties from to (nconc @@ -249,16 +249,14 @@ call it with the value of the `gnus-data' text property." (next-bottom-edge (car (cdr (cdr (cdr (window-pixel-edges this-window))))))) - (if (< bottom-edge next-bottom-edge) - (progn - (setq bottom-edge next-bottom-edge) - (setq lowest-window this-window))) + (when (< bottom-edge next-bottom-edge) + (setq bottom-edge next-bottom-edge) + (setq lowest-window this-window)) (select-window this-window) - (if (eq last-window this-window) - (progn - (select-window lowest-window) - (setq window-search nil))))))) + (when (eq last-window this-window) + (select-window lowest-window) + (setq window-search nil)))))) (defmacro gnus-xmas-menu-add (type &rest menus) `(gnus-xmas-menu-add-1 ',type ',menus)) @@ -318,9 +316,8 @@ call it with the value of the `gnus-data' text property." (let ((event (next-command-event))) ;; We junk all non-key events. Is this naughty? (while (not (key-press-event-p event)) - (setq event (next-event))) + (setq event (next-command-event))) (cons (and (key-press-event-p event) - ; (numberp (event-key event)) (event-to-character event)) event))) @@ -365,14 +362,14 @@ call it with the value of the `gnus-data' text property." (defun gnus-xmas-define () (setq gnus-mouse-2 [button2]) - (or (memq 'underline (face-list)) - (and (fboundp 'make-face) - (funcall (intern "make-face") 'underline))) + (unless (memq 'underline (face-list)) + (and (fboundp 'make-face) + (funcall (intern "make-face") 'underline))) ;; Must avoid calling set-face-underline-p directly, because it ;; is a defsubst in emacs19, and will make the .elc files non ;; portable! - (or (face-differs-from-default-p 'underline) - (funcall (intern "set-face-underline-p") 'underline t)) + (unless (face-differs-from-default-p 'underline) + (funcall (intern "set-face-underline-p") 'underline t)) (fset 'gnus-make-overlay 'make-extent) (fset 'gnus-overlay-put 'set-extent-property) @@ -383,10 +380,11 @@ call it with the value of the `gnus-data' text property." (fset 'gnus-put-text-property 'gnus-xmas-put-text-property) (require 'text-props) - (if (< emacs-minor-version 14) - (fset 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) + (when (< emacs-minor-version 14) + (fset 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) - (or (boundp 'standard-display-table) (setq standard-display-table nil)) + (unless (boundp 'standard-display-table) + (setq standard-display-table nil)) (defvar gnus-mouse-face-prop 'highlight) @@ -498,7 +496,8 @@ pounce directly on the real variables themselves.") (when (and (<= emacs-major-version 19) (<= emacs-minor-version 13)) - (setq gnus-article-x-face-too-ugly (if (eq (device-type) 'tty) ".")) + (setq gnus-article-x-face-too-ugly (when (eq (device-type) 'tty) + ".")) (fset 'gnus-highlight-selected-summary 'gnus-xmas-highlight-selected-summary) (fset 'gnus-group-remove-excess-properties @@ -570,7 +569,7 @@ pounce directly on the real variables themselves.") " "")) ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) + (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) (goto-char (point-min)) (forward-line 1) @@ -580,8 +579,8 @@ pounce directly on the real variables themselves.") (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))) ;; Fontify some. (goto-char (point-min)) - (and (search-forward "Praxis" nil t) - (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) + (when (search-forward "Praxis" nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) (goto-char (point-min)) (setq modeline-buffer-identification (list (concat gnus-version ": *Group*"))) @@ -800,6 +799,10 @@ If HIDE, hide the text instead." (cons gnus-xmas-modeline-left-extent (substring line 0 chop))) (cons gnus-xmas-modeline-right-extent (substring line chop))))))) +(defun gnus-xmas-splash () + (when (eq (device-type) 'x) + (gnus-splash))) + (provide 'gnus-xmas) ;;; gnus-xmas.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el index 9d8c1ea83..bbe72c3d4 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -42,7 +42,7 @@ "Score and kill file handling." :group 'gnus ) -(defconst gnus-version-number "0.45" +(defconst gnus-version-number "0.46" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) @@ -182,8 +182,8 @@ (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. (goto-char (point-min)) - (and (search-forward "Praxis" nil t) - (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) + (when (search-forward "Praxis" nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) (goto-char (point-min)) (setq mode-line-buffer-identification gnus-version) (set-buffer-modified-p t)) @@ -351,7 +351,7 @@ ;; Add the current buffer to the list of buffers to be killed on exit. (defun gnus-add-current-to-buffer-list () (or (memq (current-buffer) gnus-buffer-list) - (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))) + (push (current-buffer) gnus-buffer-list))) (defun gnus-version (&optional arg) "Version number of this version of Gnus. @@ -594,13 +594,13 @@ that that variable is buffer-local to the summary buffers." (if (not method) group (concat (format "%s" (car method)) - (if (and - (or (assoc (format "%s" (car method)) - (gnus-methods-using 'address)) - (gnus-server-equal method gnus-message-archive-method)) - (nth 1 method) - (not (string= (nth 1 method) ""))) - (concat "+" (nth 1 method))) + (when (and + (or (assoc (format "%s" (car method)) + (gnus-methods-using 'address)) + (gnus-server-equal method gnus-message-archive-method)) + (nth 1 method) + (not (string= (nth 1 method) ""))) + (concat "+" (nth 1 method))) ":" group))) (defun gnus-group-real-prefix (group) @@ -696,9 +696,9 @@ If SYMBOL, return the value of that symbol in the group parameters." (let ((old-params (gnus-info-params info)) (new-params (list (cons name value)))) (while old-params - (if (or (not (listp (car old-params))) - (not (eq (caar old-params) name))) - (setq new-params (append new-params (list (car old-params))))) + (when (or (not (listp (car old-params))) + (not (eq (caar old-params) name))) + (setq new-params (append new-params (list (car old-params))))) (setq old-params (cdr old-params))) (gnus-group-set-info new-params group 'params))))) @@ -724,23 +724,24 @@ just the host name." ;; separate foreign select method from group name and collapse. ;; if method contains a server, collapse to non-domain server name, ;; otherwise collapse to select method - (if (string-match ":" group) - (cond ((string-match "+" group) - (let* ((plus (string-match "+" group)) - (colon (string-match ":" group)) - (dot (string-match "\\." group))) - (setq foreign (concat - (substring group (+ 1 plus) - (cond ((null dot) colon) - ((< colon dot) colon) - ((< dot colon) dot))) ":") - group (substring group (+ 1 colon)) - ))) - (t - (let* ((colon (string-match ":" group))) - (setq foreign (concat (substring group 0 (+ 1 colon))) - group (substring group (+ 1 colon))) - )))) + (when (string-match ":" group) + (cond ((string-match "+" group) + (let* ((plus (string-match "+" group)) + (colon (string-match ":" group)) + (dot (string-match "\\." group))) + (setq foreign (concat + (substring group (+ 1 plus) + (cond ((null dot) colon) + ((< colon dot) colon) + ((< dot colon) dot))) + ":") + group (substring group (+ 1 colon)) + ))) + (t + (let* ((colon (string-match ":" group))) + (setq foreign (concat (substring group 0 (+ 1 colon))) + group (substring group (+ 1 colon))) + )))) ;; collapse group name leaving LEVELS uncollapsed elements (while group (if (and (string-match "\\." group) (> levels 0)) @@ -771,7 +772,8 @@ Returns the number of articles marked as read." (when (get-file-buffer file) (save-excursion (set-buffer (get-file-buffer file)) - (and (buffer-modified-p) (save-buffer)) + (when (buffer-modified-p) + (save-buffer)) (kill-buffer (current-buffer)))))) (defcustom gnus-kill-file-name "KILL" @@ -878,8 +880,8 @@ If NEWSGROUP is nil, return the global kill file name instead." (let ((valids gnus-valid-select-methods) outs) (while valids - (if (memq feature (car valids)) - (setq outs (cons (car valids) outs))) + (when (memq feature (car valids)) + (push (car valids) outs)) (setq valids (cdr valids))) outs)) diff --git a/lisp/message.el b/lisp/message.el index 988544a9c..416dd5b88 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -92,7 +92,8 @@ Don't touch this variable unless you really know what you're doing. Checks include subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text redirected-followup signature -approved sender empty empty-headers message-id from subject.") +approved sender empty empty-headers message-id from subject +shorten-followup-to existing-newsgroups.") ;;;###autoload (defvar message-required-news-headers diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index df50dec64..7e701ae76 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -185,7 +185,7 @@ (delete-region (progn (beginning-of-line) (point)) (or (search-forward "\n\n" nil t) (point))))) - (if (numberp article) + (if (numberp article) (cons nnbabyl-current-group article) (nnbabyl-article-group-number))))))) @@ -231,11 +231,11 @@ (deffoo nnbabyl-close-group (group &optional server) t) -(deffoo nnbabyl-request-create-group (group &optional server args) +(deffoo nnbabyl-request-create-group (group &optional server args) (nnmail-activate 'nnbabyl) (unless (assoc group nnbabyl-group-alist) - (setq nnbabyl-group-alist (cons (list group (cons 1 0)) - nnbabyl-group-alist)) + (push (list group (cons 1 0)) + nnbabyl-group-alist) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) t) @@ -262,17 +262,17 @@ (gnus-set-text-properties (point-min) (point-max) nil) (while (and articles is-old) (goto-char (point-min)) - (if (search-forward (nnbabyl-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnbabyl-delete-mail)) - (setq rest (cons (car articles) rest)))) + (when (search-forward (nnbabyl-article-string (car articles)) nil t) + (if (setq is-old + (nnmail-expired-article-p + newsgroup + (buffer-substring + (point) (progn (end-of-line) (point))) force)) + (progn + (nnheader-message 5 "Deleting article %d in %s..." + (car articles) newsgroup) + (nnbabyl-delete-mail)) + (push (car articles) rest))) (setq articles (cdr articles))) (save-buffer) ;; Find the lowest active article in this group. @@ -367,7 +367,8 @@ (while (search-forward ident nil t) (setq found t) (nnbabyl-delete-mail)) - (and found (save-buffer))))) + (when found + (save-buffer))))) ;; Remove the group from all structures. (setq nnbabyl-group-alist (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) @@ -387,7 +388,8 @@ (while (search-forward ident nil t) (replace-match new-ident t t) (setq found t)) - (and found (save-buffer)))) + (when found + (save-buffer)))) (let ((entry (assoc group nnbabyl-group-alist))) (and entry (setcar entry new-name)) (setq nnbabyl-current-group nil) @@ -403,10 +405,10 @@ ;; delimiter line. (defun nnbabyl-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. - (or force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (unless force + (delete-region + (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) ;; Beginning of the article. (save-excursion (save-restriction @@ -418,24 +420,24 @@ (match-beginning 0))) (progn (forward-line 1) - (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) + (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) nil t) (match-beginning 0)) (point-max)))) (goto-char (point-min)) ;; Only delete the article if no other groups owns it as well. - (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) + (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) + (delete-region (point-min) (point-max)))))) (defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) (when (and server (not (nnbabyl-server-opened server))) (nnbabyl-open-server server)) - (if (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (save-excursion (nnbabyl-read-mbox))) - (or nnbabyl-group-alist - (nnmail-activate 'nnbabyl)) + (when (or (not nnbabyl-mbox-buffer) + (not (buffer-name nnbabyl-mbox-buffer))) + (save-excursion (nnbabyl-read-mbox))) + (unless nnbabyl-group-alist + (nnmail-activate 'nnbabyl)) (if newsgroup (if (assoc newsgroup nnbabyl-group-alist) (setq nnbabyl-current-group newsgroup) @@ -451,18 +453,18 @@ (defun nnbabyl-article-group-number () (save-excursion (goto-char (point-min)) - (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) + (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " + nil t) + (cons (buffer-substring (match-beginning 1) (match-end 1)) + (string-to-int + (buffer-substring (match-beginning 2) (match-end 2))))))) (defun nnbabyl-insert-lines () "Insert how many lines and chars there are in the body of the mail." (let (lines chars) (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) + (when (search-forward "\n\n" nil t) ;; There may be an EOOH line here... (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") (search-forward "\n\n" nil t)) @@ -495,19 +497,18 @@ ;; If there is a C-l at the beginning of the narrowed region, this ;; isn't really a "save", but rather a "scan". (goto-char (point-min)) - (or (looking-at "\^L") - (save-excursion - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (goto-char (point-max)) - (insert "\^_\n"))) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art))))) + (unless (looking-at "\^L") + (save-excursion + (insert "\^L\n0, unseen,,\n*** EOOH ***\n") + (goto-char (point-max)) + (insert "\^_\n"))) + (when (search-forward "\n\n" nil t) + (forward-char -1) + (while group-art + (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" + (caar group-art) (cdar group-art) + (current-time-string))) + (setq group-art (cdr group-art)))) t)) (defun nnbabyl-active-number (group) @@ -518,8 +519,8 @@ ;; This group is new, so we create a new entry for it. ;; This might be a bit naughty... creating groups on the drop of ;; a hat, but I don't know... - (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 1))) - nnbabyl-group-alist))) + (push (list group (setq active (cons 1 1))) + nnbabyl-group-alist)) (cdr active))) (defun nnbabyl-read-mbox () @@ -563,7 +564,8 @@ (goto-char (point-max)) (when (and (re-search-backward (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " - (caar alist)) nil t) + (caar alist)) + nil t) (> (setq number (string-to-number (buffer-substring diff --git a/lisp/nndb.el b/lisp/nndb.el index e7fbbcfa2..a7029ab52 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -147,9 +147,9 @@ expiry mechanism." ;; CCC we shouldn't be using the variable nndb-status-string? (if (string-match "^423" (nnheader-get-report 'nndb)) () - (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) - (error "Not a valid response for DATE command: %s" - msg)) + (unless (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) + (error "Not a valid response for DATE command: %s" + msg)) (if (nnmail-expired-article-p group (list (string-to-int @@ -190,8 +190,8 @@ Optional LAST is ignored." (nntp-encode-text) (nntp-send-buffer "^[23].*\n") (setq statmsg (nntp-status-message)) - (or (string-match "^\\([0-9]+\\)" statmsg) - (error "nndb: %s" statmsg)) + (unless (string-match "^\\([0-9]+\\)" statmsg) + (error "nndb: %s" statmsg)) (setq art (substring statmsg (match-beginning 1) (match-end 1))) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 71a3866aa..6873dc5c6 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -97,8 +97,8 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', (article-begin . "^\\\\\\\\\n") (head-begin . "^Paper.*:") (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") - (body-begin . "") - (body-end . "-------------------------------------------------") + (body-begin . "") + (body-end . "-------------------------------------------------") (file-end . "^Title: Recent Seminal") (generate-head-function . nndoc-generate-lanl-gov-head) (article-transform-function . nndoc-transform-lanl-gov-announce) @@ -166,7 +166,8 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', (insert-buffer-substring nndoc-current-buffer (car entry) (nth 1 entry))) (goto-char (point-max)) - (or (= (char-after (1- (point))) ?\n) (insert "\n")) + (unless (= (char-after (1- (point))) ?\n) + (insert "\n")) (insert (format "Lines: %d\n" (nth 4 entry))) (insert ".\n"))) @@ -352,10 +353,10 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) (setq len (string-to-int (match-string 1))) (search-forward "\n\n" beg t) - (or (= (setq len (+ (point) len)) (point-max)) - (and (< len (point-max)) - (goto-char len) - (looking-at message-unix-mail-delimiter))))) + (unless (= (setq len (+ (point) len)) (point-max)) + (and (< len (point-max)) + (goto-char len) + (looking-at message-unix-mail-delimiter))))) (goto-char len)))) (defun nndoc-mmdf-type-p () diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 77d555222..ead10cf87 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -219,8 +219,8 @@ (defun nndraft-execute-nnmh-command (command) (let ((dir (expand-file-name nndraft-directory))) - (and (string-match "/$" dir) - (setq dir (substring dir 0 (match-beginning 0)))) + (when (string-match "/$" dir) + (setq dir (substring dir 0 (match-beginning 0)))) (string-match "/[^/]+$" dir) (let ((group (substring dir (1+ (match-beginning 0)))) (nnmh-directory (substring dir 0 (1+ (match-beginning 0)))) diff --git a/lisp/nneething.el b/lisp/nneething.el index 8b839b980..94b3ceae0 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -116,18 +116,18 @@ If this variable is nil, no files will be excluded.") (deffoo nneething-request-article (id &optional group server buffer) (nneething-possibly-change-directory group) - (let ((file (unless (stringp id) (nneething-file-name id))) + (let ((file (unless (stringp id) + (nneething-file-name id))) (nntp-server-buffer (or buffer nntp-server-buffer))) (and (stringp file) ; We did not request by Message-ID. (file-exists-p file) ; The file exists. (not (file-directory-p file)) ; It's not a dir. (save-excursion (nnmail-find-file file) ; Insert the file in the nntp buf. - (or (nnheader-article-p) ; Either it's a real article... - (progn - (goto-char (point-min)) - (nneething-make-head file (current-buffer)) ; ... or we fake some headers. - (insert "\n"))) + (unless (nnheader-article-p) ; Either it's a real article... + (goto-char (point-min)) + (nneething-make-head file (current-buffer)) ; ... or we fake some headers. + (insert "\n")) t)))) (deffoo nneething-request-group (group &optional dir dont-check) @@ -191,17 +191,18 @@ If this variable is nil, no files will be excluded.") (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) touched map-files) - (if (file-exists-p map-file) - (condition-case nil - (load map-file nil t t) - (error nil))) - (or nneething-active (setq nneething-active (cons 1 0))) + (when (file-exists-p map-file) + (condition-case nil + (load map-file nil t t) + (error nil))) + (unless nneething-active + (setq nneething-active (cons 1 0))) ;; Old nneething had a different map format. (when (and (cdar nneething-map) (atom (cdar nneething-map))) (setq nneething-map (mapcar (lambda (n) - (list (cdr n) (car n) + (list (cdr n) (car n) (nth 5 (file-attributes (nneething-file-name (car n)))))) nneething-map))) @@ -234,11 +235,11 @@ If this variable is nil, no files will be excluded.") (setq map (cdr map)))) ;; Find all new files and enter them into the map. (while files - (unless (member (car files) map-files) + (unless (member (car files) map-files) ;; This file is not in the map, so we enter it. (setq touched t) (setcdr nneething-active (1+ (cdr nneething-active))) - (push (list (cdr nneething-active) (car files) + (push (list (cdr nneething-active) (car files) (nth 5 (file-attributes (nneething-file-name (car files))))) nneething-map)) @@ -268,11 +269,11 @@ If this variable is nil, no files will be excluded.") "@" (system-name) ">\n" (if (equal '(0 0) (nth 5 atts)) "" (concat "Date: " (current-time-string (nth 5 atts)) "\n")) - (or (if buffer - (save-excursion - (set-buffer buffer) - (if (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) - (concat "From: " (match-string 0) "\n")))) + (or (when buffer + (save-excursion + (set-buffer buffer) + (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) + (concat "From: " (match-string 0) "\n")))) (nneething-from-line (nth 2 atts) file)) (if (> (string-to-int (int-to-string (nth 7 atts))) 0) (concat "Chars: " (int-to-string (nth 7 atts)) "\n") @@ -281,7 +282,8 @@ If this variable is nil, no files will be excluded.") (save-excursion (set-buffer buffer) (concat "Lines: " (int-to-string - (count-lines (point-min) (point-max))) "\n")) + (count-lines (point-min) (point-max))) + "\n")) "") ))) @@ -301,13 +303,13 @@ If this variable is nil, no files will be excluded.") (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) (prog1 (substring file - (match-beginning 1) + (match-beginning 1) (match-end 1)) - (if (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) - (setq login (substring file - (match-beginning 2) - (match-end 2)) - name nil))) + (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) + (setq login (substring file + (match-beginning 2) + (match-end 2)) + name nil))) (system-name)))) (concat "From: " login "@" host (if name (concat " (" name ")") "") "\n"))) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index e3b3305aa..9c8470e6d 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -116,22 +116,21 @@ time saver for large mailboxes.") (setq article (car articles)) (setq art-string (nnfolder-article-string article)) (set-buffer nnfolder-current-buffer) - (if (or (search-forward art-string nil t) - ;; Don't search the whole file twice! Also, articles - ;; probably have some locality by number, so searching - ;; backwards will be faster. Especially if we're at the - ;; beginning of the buffer :-). -SLB - (search-backward art-string nil t)) - (progn - (setq start (or (re-search-backward delim-string nil t) - (point))) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-max)) - (insert ".\n"))) + (when (or (search-forward art-string nil t) + ;; Don't search the whole file twice! Also, articles + ;; probably have some locality by number, so searching + ;; backwards will be faster. Especially if we're at the + ;; beginning of the buffer :-). -SLB + (search-backward art-string nil t)) + (setq start (or (re-search-backward delim-string nil t) + (point))) + (search-forward "\n\n" nil t) + (setq stop (1- (point))) + (set-buffer nntp-server-buffer) + (insert (format "221 %d Article retrieved.\n" article)) + (insert-buffer-substring nnfolder-current-buffer start stop) + (goto-char (point-max)) + (insert ".\n")) (setq articles (cdr articles))) (set-buffer nntp-server-buffer) @@ -171,33 +170,33 @@ time saver for large mailboxes.") (save-excursion (set-buffer nnfolder-current-buffer) (goto-char (point-min)) - (if (search-forward (nnfolder-article-string article) nil t) - (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (or (and (re-search-forward - (concat "^" message-unix-mail-delimiter) nil t) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnfolder-current-buffer start stop) + (when (search-forward (nnfolder-article-string article) nil t) + (let (start stop) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (setq start (point)) + (forward-line 1) + (unless (and (re-search-forward + (concat "^" message-unix-mail-delimiter) nil t) + (forward-line -1)) + (goto-char (point-max))) + (setq stop (point)) + (let ((nntp-server-buffer (or buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring nnfolder-current-buffer start stop) + (goto-char (point-min)) + (while (looking-at "From ") + (delete-char 5) + (insert "X-From-Line: ") + (forward-line 1)) + (if (numberp article) + (cons nnfolder-current-group article) (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnfolder-current-group article) - (goto-char (point-min)) - (search-forward (concat "\n" nnfolder-article-marker)) - (cons nnfolder-current-group - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point))))))))))) + (search-forward (concat "\n" nnfolder-article-marker)) + (cons nnfolder-current-group + (string-to-int + (buffer-substring + (point) (progn (end-of-line) (point))))))))))) (deffoo nnfolder-request-group (group &optional server dont-check) (save-excursion @@ -275,7 +274,7 @@ time saver for large mailboxes.") nnfolder-current-buffer nil) t) -(deffoo nnfolder-request-create-group (group &optional server args) +(deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) (when group @@ -310,18 +309,18 @@ time saver for large mailboxes.") (set-buffer nnfolder-current-buffer) (while (and articles is-old) (goto-char (point-min)) - (if (search-forward (nnfolder-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) - force nnfolder-inhibit-expiry)) - (progn - (nnheader-message 5 "Deleting article %d..." - (car articles) newsgroup) - (nnfolder-delete-mail)) - (setq rest (cons (car articles) rest)))) + (when (search-forward (nnfolder-article-string (car articles)) nil t) + (if (setq is-old + (nnmail-expired-article-p + newsgroup + (buffer-substring + (point) (progn (end-of-line) (point))) + force nnfolder-inhibit-expiry)) + (progn + (nnheader-message 5 "Deleting article %d..." + (car articles) newsgroup) + (nnfolder-delete-mail)) + (push (car articles) rest))) (setq articles (cdr articles))) (nnfolder-save-buffer) ;; Find the lowest active article in this group. @@ -364,15 +363,16 @@ time saver for large mailboxes.") (nnfolder-possibly-change-group group server) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) - (if (search-forward (nnfolder-article-string article) nil t) - (nnfolder-delete-mail)) + (when (search-forward (nnfolder-article-string article) nil t) + (nnfolder-delete-mail)) (and last (nnfolder-save-buffer)))) result)) (deffoo nnfolder-request-accept-article (group &optional server last) (nnfolder-possibly-change-group group server) (nnmail-check-syntax) - (and (stringp group) (nnfolder-possibly-change-group group)) + (when (stringp group) + (nnfolder-possibly-change-group group)) (let ((buf (current-buffer)) result) (goto-char (point-min)) @@ -491,8 +491,7 @@ time saver for large mailboxes.") (not (file-exists-p (nnfolder-group-pathname group))) (progn - (setq nnfolder-group-alist - (cons (list group (cons 1 0)) nnfolder-group-alist)) + (push (list group (cons 1 0)) nnfolder-group-alist) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) (let (inf file) (if (and (equal group nnfolder-current-group) @@ -504,24 +503,23 @@ time saver for large mailboxes.") ;; If we have to change groups, see if we don't already have the mbox ;; in memory. If we do, verify the modtime and destroy the mbox if ;; needed so we can rescan it. - (if (setq inf (assoc group nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (nth 1 inf))) + (when (setq inf (assoc group nnfolder-buffer-alist)) + (setq nnfolder-current-buffer (nth 1 inf))) ;; 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. - (if (or (not (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer))) - (not (and (bufferp nnfolder-current-buffer) - (verify-visited-file-modtime - nnfolder-current-buffer)))) - (progn - (if (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer) - (bufferp nnfolder-current-buffer)) - (kill-buffer nnfolder-current-buffer)) - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) - (setq inf nil))) + (when (or (not (and nnfolder-current-buffer + (buffer-name nnfolder-current-buffer))) + (not (and (bufferp nnfolder-current-buffer) + (verify-visited-file-modtime + nnfolder-current-buffer)))) + (when (and nnfolder-current-buffer + (buffer-name nnfolder-current-buffer) + (bufferp nnfolder-current-buffer)) + (kill-buffer nnfolder-current-buffer)) + (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) + (setq inf nil)) (unless inf (save-excursion @@ -534,9 +532,8 @@ time saver for large mailboxes.") (nnfolder-read-folder file scanning)) (when nnfolder-current-buffer (set-buffer nnfolder-current-buffer) - (setq nnfolder-buffer-alist - (cons (list group nnfolder-current-buffer) - nnfolder-buffer-alist)))))))) + (push (list group nnfolder-current-buffer) + nnfolder-buffer-alist))))))) (setq nnfolder-current-group group))) (defun nnfolder-save-mail (group-art-list) @@ -598,17 +595,17 @@ time saver for large mailboxes.") (defun nnfolder-insert-newsgroup-line (group-art) (save-excursion (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string))))))) + (when (search-forward "\n\n" nil t) + (forward-char -1) + (insert (format (concat nnfolder-article-marker "%d %s\n") + (cdr group-art) (current-time-string)))))) (defun nnfolder-possibly-activate-groups (&optional group) (save-excursion ;; If we're looking for the activation of a specific group, find out ;; its real name and switch to it. - (if group (nnfolder-possibly-change-group group)) + (when group + (nnfolder-possibly-change-group group)) ;; If the group alist isn't active, activate it now. (nnmail-activate 'nnfolder))) @@ -623,9 +620,8 @@ time saver for large mailboxes.") ;; This group is new, so we create a new entry for it. ;; This might be a bit naughty... creating groups on the drop of ;; a hat, but I don't know... - (setq nnfolder-group-alist - (cons (list group (setq active (cons 1 1))) - nnfolder-group-alist))) + (push (list group (setq active (cons 1 1))) + nnfolder-group-alist)) (cdr active)) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (nnfolder-possibly-activate-groups group))))) @@ -698,14 +694,13 @@ time saver for large mailboxes.") ;; at the end, go to the end and search backwards for the last ;; marker. Find the start of that message, and begin to search for ;; unmarked messages from there. - (if (not (or nnfolder-distrust-mbox - (< maxid 2))) - (progn - (goto-char (point-max)) - (if (not (re-search-backward marker nil t)) - (goto-char (point-min)) - (if (not (re-search-backward delim nil t)) - (goto-char (point-min)))))) + (when (not (or nnfolder-distrust-mbox + (< maxid 2))) + (goto-char (point-max)) + (if (not (re-search-backward marker nil t)) + (goto-char (point-min)) + (when (not (re-search-backward delim nil t)) + (goto-char (point-min))))) ;; Keep track of the active number on our own, and insert it back ;; into the active list when we're done. Also, prime the pump to @@ -719,19 +714,18 @@ time saver for large mailboxes.") (goto-char end) ;; There may be more than one "From " line, so we skip past ;; them. - (while (looking-at delim) + (while (looking-at delim) (forward-line 1)) (set-marker end (or (and (re-search-forward delim nil t) (match-beginning 0)) (point-max))) (goto-char start) - (if (not (search-forward marker end t)) - (progn - (narrow-to-region start end) - (nnmail-insert-lines) - (nnfolder-insert-newsgroup-line - (cons nil (nnfolder-active-number nnfolder-current-group))) - (widen)))) + (when (not (search-forward marker end t)) + (narrow-to-region start end) + (nnmail-insert-lines) + (nnfolder-insert-newsgroup-line + (cons nil (nnfolder-active-number nnfolder-current-group))) + (widen))) ;; Make absolutely sure that the active list reflects reality! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) @@ -739,7 +733,7 @@ time saver for large mailboxes.") (setq newscantime (visited-file-modtime)) (if scantime (setcdr scantime (list newscantime)) - (push (list nnfolder-current-group newscantime) + (push (list nnfolder-current-group newscantime) nnfolder-scantime-alist)) (current-buffer)))))) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 9a33e66bd..5d9a60e7d 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -281,14 +281,15 @@ on your system, you could say something like: (or (mail-header-subject header) "(none)") "\t" (or (mail-header-from header) "(nobody)") "\t" (or (mail-header-date header) "") "\t" - (or (mail-header-id header) - (nnmail-message-id)) "\t" + (or (mail-header-id header) + (nnmail-message-id)) + "\t" (or (mail-header-references header) "") "\t") (princ (or (mail-header-chars header) 0) (current-buffer)) (insert "\t") (princ (or (mail-header-lines header) 0) (current-buffer)) (insert "\t") - (when (mail-header-xref header) + (when (mail-header-xref header) (insert "Xref: " (mail-header-xref header) "\t")) (insert "\n")) @@ -404,7 +405,7 @@ the line could be found." (nth 1 (nnheader-insert-file-contents-literally file nil beg (incf beg nnheader-head-chop-length)))) - (prog1 (not (search-forward "\n\n" nil t)) + (prog1 (not (search-forward "\n\n" nil t)) (goto-char (point-max))) (or (null nnheader-max-head-length) (< beg nnheader-max-head-length)))))) @@ -421,19 +422,22 @@ the line could be found." (goto-char (match-end 0))) (prog1 (eobp) - (widen)))) + (widen)))) (defun nnheader-insert-references (references message-id) "Insert a References header based on REFERENCES and MESSAGE-ID." - (if (and (not references) (not message-id)) + (if (and (not references) (not message-id)) () ; This is illegal, but not all articles have Message-IDs. (mail-position-on-field "References") (let ((begin (save-excursion (beginning-of-line) (point))) (fill-column 78) (fill-prefix "\t")) - (if references (insert references)) - (if (and references message-id) (insert " ")) - (if message-id (insert message-id)) + (when references + (insert references)) + (when (and references message-id) + (insert " ")) + (when message-id + (insert message-id)) ;; Fold long References lines to conform to RFC1036 (sort of). ;; The region must end with a newline to fill the region ;; without inserting extra newline. @@ -640,8 +644,8 @@ without formatting." (idx 0)) ;; Replace all occurrences of FROM with TO. (while (< idx len) - (if (= (aref string idx) from) - (aset string idx to)) + (when (= (aref string idx) from) + (aset string idx to)) (setq idx (1+ idx))) string)) @@ -731,9 +735,9 @@ If FILE, find the \".../etc/PACKAGE\" file instead." (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp)) (when (string-match efs-path-regexp path) (efs-re-read-dir path)) - (if (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format)) - (when (string-match (car ange-ftp-path-format) path) - (ange-ftp-re-read-dir path))))) + (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format)) + (when (string-match (car ange-ftp-path-format) path) + (ange-ftp-re-read-dir path))))) (defun nnheader-insert-file-contents-literally (filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but only reads in the file. diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index bb8c1ebdb..d6921417d 100644 --- a/lisp/nnheaderxm.el +++ b/lisp/nnheaderxm.el @@ -54,21 +54,20 @@ The buffer is not selected, just returned to the caller." (truename (abbreviate-file-name (file-truename filename))) (number (nthcdr 10 (file-attributes truename))) ;; Find any buffer for a file which has same truename. - (other (and (not buf) + (other (and (not buf) (get-file-buffer filename))) error) ;; Let user know if there is a buffer with the same truename. - (if other - (progn - (or nowarn - (string-equal filename (buffer-file-name other)) - (message "%s and %s are the same file" - filename (buffer-file-name other))) - ;; Optionally also find that buffer. - (if (or (and (boundp 'find-file-existing-other-name) - find-file-existing-other-name) - find-file-visit-truename) - (setq buf other)))) + (when other + (or nowarn + (string-equal filename (buffer-file-name other)) + (message "%s and %s are the same file" + filename (buffer-file-name other))) + ;; Optionally also find that buffer. + (when (or (and (boundp 'find-file-existing-other-name) + find-file-existing-other-name) + find-file-visit-truename) + (setq buf other))) (if buf (or nowarn (verify-visited-file-modtime buf) @@ -123,23 +122,22 @@ The buffer is not selected, just returned to the caller." ;; the file was found in. (and (eq system-type 'vax-vms) (let (logical) - (if (string-match ":" (file-name-directory filename)) - (setq logical (substring (file-name-directory filename) - 0 (match-beginning 0)))) + (when (string-match ":" (file-name-directory filename)) + (setq logical (substring (file-name-directory filename) + 0 (match-beginning 0)))) (not (member logical find-file-not-true-dirname-list))) (setq buffer-file-name buffer-file-truename)) - (if find-file-visit-truename - (setq buffer-file-name - (setq filename - (expand-file-name buffer-file-truename)))) + (when find-file-visit-truename + (setq buffer-file-name + (setq filename + (expand-file-name buffer-file-truename)))) ;; Set buffer's default directory to that of the file. (setq default-directory (file-name-directory filename)) ;; Turn off backup files for certain file names. Since ;; this is a permanent local, the major mode won't eliminate it. - (and (not (funcall backup-enable-predicate buffer-file-name)) - (progn - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) + (when (not (funcall backup-enable-predicate buffer-file-name)) + (make-local-variable 'backup-inhibited) + (setq backup-inhibited t)) (if rawfile nil (after-find-file error (not nowarn))))) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index fdb7c2f13..58e361215 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -203,7 +203,7 @@ Finds out what articles are to be part of the nnkiboze groups." (concat (nnkiboze-prefixed-name nnkiboze-current-group) "." gnus-score-file-suffix)))))) -(defun nnkiboze-generate-group (group) +(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")) @@ -216,9 +216,11 @@ Finds out what articles are to be part of the nnkiboze groups." gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active ginfo lowest glevel) - (or info (error "No such group: %s" group)) + (unless info + (error "No such group: %s" group)) ;; Load the kiboze newsrc file for this group. - (and (file-exists-p newsrc-file) (load newsrc-file)) + (when (file-exists-p newsrc-file) + (load newsrc-file)) ;; We also load the nov file for this group. (save-excursion (set-buffer (setq nov-buffer (find-file-noselect nov-file))) @@ -263,28 +265,31 @@ Finds out what articles are to be part of the nnkiboze groups." (setcar (nthcdr 3 ginfo) nil)) ;; We set the list of read articles to be what we expect for ;; this kiboze group -- either nil or `(1 . LOWEST)'. - (and ginfo (setcar (nthcdr 2 ginfo) - (and (not (= lowest 1)) (cons 1 lowest)))) + (when ginfo + (setcar (nthcdr 2 ginfo) + (and (not (= lowest 1)) (cons 1 lowest)))) (if (not (and (or (not ginfo) (> (length (gnus-list-of-unread-articles - (car ginfo))) 0)) + (car ginfo))) + 0)) (progn (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode)))) () ; No unread articles, or we couldn't enter this group. ;; We are now in the group where we want to be. (setq method (gnus-find-method-for-group gnus-newsgroup-name)) - (and (eq method gnus-select-method) (setq method nil)) + (when (eq method gnus-select-method) + (setq method nil)) ;; We go through the list of scored articles. (while gnus-newsgroup-scored - (if (> (caar gnus-newsgroup-scored) lowest) - ;; If it has a good score, then we enter this article - ;; into the kiboze group. - (nnkiboze-enter-nov - nov-buffer - (gnus-summary-article-header - (caar gnus-newsgroup-scored)) - gnus-newsgroup-name)) + (when (> (caar gnus-newsgroup-scored) lowest) + ;; If it has a good score, then we enter this article + ;; into the kiboze group. + (nnkiboze-enter-nov + nov-buffer + (gnus-summary-article-header + (caar gnus-newsgroup-scored)) + gnus-newsgroup-name)) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) ;; That's it. We exit this group. (gnus-summary-exit-no-update))) @@ -324,7 +329,7 @@ Finds out what articles are to be part of the nnkiboze groups." ;; really came for - this is the article nnkiboze ;; will request when it is asked for the article. (insert group ":" - (int-to-string (mail-header-number header)) " ") + (int-to-string (mail-header-number header)) " ") (while (re-search-forward " [^ ]+:[0-9]+" nil t) (goto-char (1+ (match-beginning 0))) (insert prefix))))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index ec8b82ad6..a4f5b958a 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -158,7 +158,7 @@ running (\"xwatch\", etc.) Eg. \(add-hook 'nnmail-read-incoming-hook - (lambda () + (lambda () (start-process \"mailsend\" nil \"/local/bin/mailsend\" \"read\" \"mbox\"))) @@ -171,8 +171,8 @@ If you use `display-time', you could use something like this: (lambda () ;; Update the displayed time, since that will clear out ;; the flag that says you have mail. - (if (eq (process-status \"display-time\") 'run) - (display-time-filter display-time-process \"\"))))") + (when (eq (process-status \"display-time\") 'run) + (display-time-filter display-time-process \"\"))))") (when (eq system-type 'windows-nt) (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr)) @@ -367,7 +367,7 @@ parameter. It should return nil, `warn' or `delete'.") "Convert DAYS into time." (let* ((seconds (* 1.0 days 60 60 24)) (rest (expt 2 16)) - (ms (condition-case nil (round (/ seconds rest)) + (ms (condition-case nil (round (/ seconds rest)) (range-error (expt 2 16))))) (list ms (condition-case nil (round (- seconds (* ms rest))) (range-error (expt 2 16)))))) @@ -378,7 +378,8 @@ parameter. It should return nil, `warn' or `delete'.") ;; Convert date strings to internal time. (setq time (nnmail-date-to-time time))) (let* ((current (current-time)) - (rest (if (< (nth 1 current) (nth 1 time)) (expt 2 16)))) + (rest (when (< (nth 1 current) (nth 1 time)) + (expt 2 16)))) (list (- (+ (car current) (if rest -1 0)) (car time)) (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) @@ -522,7 +523,7 @@ nn*-request-list should have been called before calling this function." (erase-buffer) (let (group) (while (setq group (pop alist)) - (insert (format "%s %d %d y\n" (car group) (cdadr group) + (insert (format "%s %d %d y\n" (car group) (cdadr group) (caadr group)))))) (defun nnmail-get-split-group (file group) @@ -801,7 +802,8 @@ FUNC will be called with the buffer narrowed to each mail." (nnmail-process-mmdf-mail-format func artnum-func)) (t (nnmail-process-unix-mail-format func artnum-func)))) - (if exit-func (funcall exit-func)) + (when exit-func + (funcall exit-func)) (kill-buffer (current-buffer))))) ;; Mail crossposts suggested by Brian Edmonds . @@ -854,7 +856,7 @@ FUNC will be called with the group name to determine the article number." (if (or methods (not (equal "" (nth 1 method)))) (when (and - (condition-case () + (condition-case () (if (stringp (nth 1 method)) (re-search-backward (cadr method) nil t) ;; Function to say whether this is a match. @@ -863,13 +865,13 @@ FUNC will be called with the group name to determine the article number." ;; Don't enter the article into the same ;; group twice. (not (assoc (car method) group-art))) - (push (cons (car method) (funcall func (car method))) + (push (cons (car method) (funcall func (car method))) group-art)) ;; This is the final group, which is used as a ;; catch-all. (unless group-art (setq group-art - (list (cons (car method) + (list (cons (car method) (funcall func (car method))))))))) ;; See whether the split methods returned `junk'. (if (equal group-art '(junk)) @@ -882,7 +884,7 @@ Return the number of characters in the body." (let (lines chars) (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) + (when (search-forward "\n\n" nil t) (setq chars (- (point-max) (point))) (setq lines (count-lines (point) (point-max))) (forward-char -1) @@ -897,10 +899,10 @@ Return the number of characters in the body." "Insert an Xref line based on the (group . article) alist." (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) + (when (search-forward "\n\n" nil t) (forward-char -1) (when (re-search-backward "^Xref: " nil t) - (delete-region (match-beginning 0) + (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist @@ -977,8 +979,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ((assq split nnmail-split-cache) ;; A compiled match expression. (goto-char (point-max)) - (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) - (nnmail-split-it (nth 2 split)))) + (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) + (nnmail-split-it (nth 2 split)))) (t ;; An uncompiled match. (let* ((field (nth 0 split)) @@ -992,11 +994,10 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (cdr (assq value nnmail-split-abbrev-alist)) value) "\\)\\>"))) - (setq nnmail-split-cache - (cons (cons split regexp) nnmail-split-cache)) + (push (cons split regexp) nnmail-split-cache) (goto-char (point-max)) - (if (re-search-backward regexp nil t) - (nnmail-split-it (nth 2 split))))))) + (when (re-search-backward regexp nil t) + (nnmail-split-it (nth 2 split))))))) ;; Get a list of spool files to read. (defun nnmail-get-spool-files (&optional group) @@ -1016,7 +1017,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (p procmails) (crash (when (and (file-exists-p nnmail-crash-box) (> (nnheader-file-size - (file-truename nnmail-crash-box)) 0)) + (file-truename nnmail-crash-box)) + 0)) (list nnmail-crash-box)))) ;; Remove any directories that inadvertently match the procmail ;; suffix, which might happen if the suffix is "". @@ -1049,32 +1051,32 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; already activated. (defun nnmail-activate (backend &optional force) (let (file timestamp file-time) - (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) - force - (and (setq file (condition-case () - (symbol-value (intern (format "%s-active-file" - backend))) - (error nil))) - (setq file-time (nth 5 (file-attributes file))) - (or (not - (setq timestamp - (condition-case () - (symbol-value (intern - (format "%s-active-timestamp" - backend))) - (error 'none)))) - (not (consp timestamp)) - (equal timestamp '(0 0)) - (> (nth 0 file-time) (nth 0 timestamp)) - (and (= (nth 0 file-time) (nth 0 timestamp)) - (> (nth 1 file-time) (nth 1 timestamp)))))) - (save-excursion - (or (eq timestamp 'none) - (set (intern (format "%s-active-timestamp" backend)) - (current-time))) - (funcall (intern (format "%s-request-list" backend))) - (set (intern (format "%s-group-alist" backend)) - (nnmail-get-active)))) + (when (or (not (symbol-value (intern (format "%s-group-alist" backend)))) + force + (and (setq file (condition-case () + (symbol-value (intern (format "%s-active-file" + backend))) + (error nil))) + (setq file-time (nth 5 (file-attributes file))) + (or (not + (setq timestamp + (condition-case () + (symbol-value (intern + (format "%s-active-timestamp" + backend))) + (error 'none)))) + (not (consp timestamp)) + (equal timestamp '(0 0)) + (> (nth 0 file-time) (nth 0 timestamp)) + (and (= (nth 0 file-time) (nth 0 timestamp)) + (> (nth 1 file-time) (nth 1 timestamp)))))) + (save-excursion + (or (eq timestamp 'none) + (set (intern (format "%s-active-timestamp" backend)) + (current-time))) + (funcall (intern (format "%s-request-list" backend))) + (set (intern (format "%s-group-alist" backend)) + (nnmail-get-active)))) t)) (defun nnmail-message-id () @@ -1096,8 +1098,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) (buffer-disable-undo (current-buffer)) - (and (file-exists-p nnmail-message-id-cache-file) - (insert-file-contents nnmail-message-id-cache-file)) + (when (file-exists-p nnmail-message-id-cache-file) + (insert-file-contents nnmail-message-id-cache-file)) (set-buffer-modified-p nil) (current-buffer)))) @@ -1110,10 +1112,10 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (set-buffer nnmail-cache-buffer) ;; Weed out the excess number of Message-IDs. (goto-char (point-max)) - (and (search-backward "\n" nil t nnmail-message-id-cache-length) - (progn - (beginning-of-line) - (delete-region (point-min) (point)))) + (when (search-backward "\n" nil t nnmail-message-id-cache-length) + (progn + (beginning-of-line) + (delete-region (point-min) (point)))) ;; Save the buffer. (or (file-exists-p (file-name-directory nnmail-message-id-cache-file)) (make-directory (file-name-directory nnmail-message-id-cache-file) @@ -1225,7 +1227,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq group (nnmail-get-split-group spool group-in)) ;; We split the mail (nnmail-split-incoming - nnmail-crash-box (intern (format "%s-save-mail" method)) + nnmail-crash-box (intern (format "%s-save-mail" method)) spool-func group (intern (format "%s-active-number" method))) ;; Check whether the inbox is to be moved to the special tmp dir. (setq incoming @@ -1380,6 +1382,16 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ", ") "\n")) (goto-char (point-min)))) + +(defun nnmail-new-mail-p (group) + "Say whether GROUP has new mail." + (let ((his nnmail-split-history) + found) + (while his + (when (member group (pop his)) + (setq found t + his nil))) + found)) (run-hooks 'nnmail-load-hook) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 65016bcda..bb28d0e81 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -82,22 +82,21 @@ (setq article (car sequence)) (setq art-string (nnmbox-article-string article)) (set-buffer nnmbox-mbox-buffer) - (if (or (search-forward art-string nil t) - (progn (goto-char (point-min)) - (search-forward art-string nil t))) - (progn - (setq start - (save-excursion - (re-search-backward - (concat "^" message-unix-mail-delimiter) nil t) - (point))) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n"))) + (when (or (search-forward art-string nil t) + (progn (goto-char (point-min)) + (search-forward art-string nil t))) + (setq start + (save-excursion + (re-search-backward + (concat "^" message-unix-mail-delimiter) nil t) + (point))) + (search-forward "\n\n" nil t) + (setq stop (1- (point))) + (set-buffer nntp-server-buffer) + (insert (format "221 %d Article retrieved.\n" article)) + (insert-buffer-substring nnmbox-mbox-buffer start stop) + (goto-char (point-max)) + (insert ".\n")) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nnmail-large-newsgroup) @@ -147,28 +146,28 @@ (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) - (if (search-forward (nnmbox-article-string article) nil t) - (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (or (and (re-search-forward - (concat "^" message-unix-mail-delimiter) nil t) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnmbox-current-group article) - (nnmbox-article-group-number))))))) + (when (search-forward (nnmbox-article-string article) nil t) + (let (start stop) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (setq start (point)) + (forward-line 1) + (or (and (re-search-forward + (concat "^" message-unix-mail-delimiter) nil t) + (forward-line -1)) + (goto-char (point-max))) + (setq stop (point)) + (let ((nntp-server-buffer (or buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring nnmbox-mbox-buffer start stop) + (goto-char (point-min)) + (while (looking-at "From ") + (delete-char 5) + (insert "X-From-Line: ") + (forward-line 1)) + (if (numberp article) + (cons nnmbox-current-group article) + (nnmbox-article-group-number))))))) (deffoo nnmbox-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnmbox-group-alist)))) @@ -228,17 +227,17 @@ (set-buffer nnmbox-mbox-buffer) (while (and articles is-old) (goto-char (point-min)) - (if (search-forward (nnmbox-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnmbox-delete-mail)) - (setq rest (cons (car articles) rest)))) + (when (search-forward (nnmbox-article-string (car articles)) nil t) + (if (setq is-old + (nnmail-expired-article-p + newsgroup + (buffer-substring + (point) (progn (end-of-line) (point))) force)) + (progn + (nnheader-message 5 "Deleting article %d in %s..." + (car articles) newsgroup) + (nnmbox-delete-mail)) + (push (car articles) rest))) (setq articles (cdr articles))) (save-buffer) ;; Find the lowest active article in this group. @@ -276,8 +275,8 @@ (nnmbox-possibly-change-newsgroup group server) (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) - (if (search-forward (nnmbox-article-string article) nil t) - (nnmbox-delete-mail)) + (when (search-forward (nnmbox-article-string article) nil t) + (nnmbox-delete-mail)) (and last (save-buffer)))) result)) @@ -341,7 +340,8 @@ (while (search-forward ident nil t) (setq found t) (nnmbox-delete-mail)) - (and found (save-buffer))))) + (when found + (save-buffer))))) ;; Remove the group from all structures. (setq nnmbox-group-alist (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) @@ -361,9 +361,11 @@ (while (search-forward ident nil t) (replace-match new-ident t t) (setq found t)) - (and found (save-buffer)))) + (when found + (save-buffer)))) (let ((entry (assoc group nnmbox-group-alist))) - (and entry (setcar entry new-name)) + (when entry + (setcar entry new-name)) (setq nnmbox-current-group nil) ;; Save the new group alist. (nnmail-save-active nnmbox-group-alist nnmbox-active-file) @@ -391,7 +393,7 @@ (match-beginning 0))) (progn (forward-line 1) - (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) + (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) (if (and (not (bobp)) leave-delim) (progn (forward-line -2) (point)) @@ -399,25 +401,25 @@ (point-max)))) (goto-char (point-min)) ;; Only delete the article if no other groups owns it as well. - (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) + (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) + (delete-region (point-min) (point-max)))))) (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) (when (and server (not (nnmbox-server-opened server))) (nnmbox-open-server server)) - (if (or (not nnmbox-mbox-buffer) - (not (buffer-name nnmbox-mbox-buffer))) - (save-excursion - (set-buffer (setq nnmbox-mbox-buffer - (nnheader-find-file-noselect - nnmbox-mbox-file nil 'raw))) - (buffer-disable-undo (current-buffer)))) - (if (not nnmbox-group-alist) - (nnmail-activate 'nnmbox)) + (when (or (not nnmbox-mbox-buffer) + (not (buffer-name nnmbox-mbox-buffer))) + (save-excursion + (set-buffer (setq nnmbox-mbox-buffer + (nnheader-find-file-noselect + nnmbox-mbox-file nil 'raw))) + (buffer-disable-undo (current-buffer)))) + (when (not nnmbox-group-alist) + (nnmail-activate 'nnmbox)) (if newsgroup - (if (assoc newsgroup nnmbox-group-alist) - (setq nnmbox-current-group newsgroup)) + (when (assoc newsgroup nnmbox-group-alist) + (setq nnmbox-current-group newsgroup)) t)) (defun nnmbox-article-string (article) @@ -429,11 +431,11 @@ (defun nnmbox-article-group-number () (save-excursion (goto-char (point-min)) - (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) + (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " + nil t) + (cons (buffer-substring (match-beginning 1) (match-end 1)) + (string-to-int + (buffer-substring (match-beginning 2) (match-end 2))))))) (defun nnmbox-save-mail (group-art) "Called narrowed to an article." @@ -458,14 +460,13 @@ (defun nnmbox-insert-newsgroup-line (group-art) (save-excursion (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art))))) + (when (search-forward "\n\n" nil t) + (forward-char -1) + (while group-art + (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" + (caar group-art) (cdar group-art) + (current-time-string))) + (setq group-art (cdr group-art)))) t)) (defun nnmbox-active-number (group) @@ -476,14 +477,14 @@ ;; This group is new, so we create a new entry for it. ;; This might be a bit naughty... creating groups on the drop of ;; a hat, but I don't know... - (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1))) - nnmbox-group-alist))) + (push (list group (setq active (cons 1 1))) + nnmbox-group-alist)) (cdr active))) (defun nnmbox-read-mbox () (nnmail-activate 'nnmbox) - (if (not (file-exists-p nnmbox-mbox-file)) - (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)) + (when (not (file-exists-p nnmbox-mbox-file)) + (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)) (if (and nnmbox-mbox-buffer (buffer-name nnmbox-mbox-buffer) (save-excursion @@ -517,20 +518,20 @@ (goto-char (point-min)) (while (re-search-forward delim nil t) (setq start (match-beginning 0)) - (if (not (search-forward "\nX-Gnus-Newsgroup: " - (save-excursion - (setq end - (or - (and - (re-search-forward delim nil t) - (match-beginning 0)) - (point-max)))) - t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (nnmbox-save-mail - (nnmail-article-group 'nnmbox-active-number))))) + (when (not (search-forward "\nX-Gnus-Newsgroup: " + (save-excursion + (setq end + (or + (and + (re-search-forward delim nil t) + (match-beginning 0)) + (point-max)))) + t)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (nnmbox-save-mail + (nnmail-article-group 'nnmbox-active-number))))) (goto-char end)))))) (provide 'nnmbox) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 2832ccf97..fe50233d9 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -105,7 +105,8 @@ (message "nnmh: Receiving headers... %d%%" (/ (* count 100) number)))) - (and large (message "nnmh: Receiving headers...done")) + (when large + (message "nnmh: Receiving headers...done")) (nnheader-fold-continuation-lines) 'headers)))) @@ -176,7 +177,7 @@ (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) (deffoo nnmh-request-scan (&optional group server) - (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) + (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) (deffoo nnmh-request-list (&optional server dir) (nnheader-insert "") @@ -216,10 +217,11 @@ (string-match (regexp-quote (file-truename (file-name-as-directory - (expand-file-name nnmh-toplev)))) dir) + (expand-file-name nnmh-toplev)))) + dir) (nnheader-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.)) - (apply 'max files) + (apply 'max files) (apply 'min files))))))) t) @@ -241,20 +243,20 @@ (while (and articles is-old) (setq article (concat nnmh-current-directory (int-to-string (car articles)))) - (if (setq mod-time (nth 5 (file-attributes article))) - (if (and (nnmh-deletable-article-p newsgroup (car articles)) - (setq is-old - (nnmail-expired-article-p newsgroup mod-time force))) - (progn - (nnheader-message 5 "Deleting article %s in %s..." - article newsgroup) - (condition-case () - (funcall nnmail-delete-file-function article) - (file-error - (nnheader-message 1 "Couldn't delete article %s in %s" - article newsgroup) - (setq rest (cons (car articles) rest))))) - (setq rest (cons (car articles) rest)))) + (when (setq mod-time (nth 5 (file-attributes article))) + (if (and (nnmh-deletable-article-p newsgroup (car articles)) + (setq is-old + (nnmail-expired-article-p newsgroup mod-time force))) + (progn + (nnheader-message 5 "Deleting article %s in %s..." + article newsgroup) + (condition-case () + (funcall nnmail-delete-file-function article) + (file-error + (nnheader-message 1 "Couldn't delete article %s in %s" + article newsgroup) + (push (car articles) rest)))) + (push (car articles) rest))) (setq articles (cdr articles))) (message "") (nconc rest articles))) @@ -311,7 +313,7 @@ t) (error nil)))) -(deffoo nnmh-request-create-group (group &optional server args) +(deffoo nnmh-request-create-group (group &optional server args) (nnmail-activate 'nnmh) (unless (assoc group nnmh-group-alist) (let (active) @@ -336,11 +338,10 @@ () ; Don't delete the articles. (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) (while articles - (and (file-writable-p (car articles)) - (progn - (nnheader-message 5 "Deleting article %s in %s..." - (car articles) group) - (funcall nnmail-delete-file-function (car articles)))) + (when (file-writable-p (car articles)) + (nnheader-message 5 "Deleting article %s in %s..." + (car articles) group) + (funcall nnmail-delete-file-function (car articles))) (setq articles (cdr articles)))) ;; Try to delete the directory itself. (condition-case () @@ -376,7 +377,8 @@ (error nil))) ;; That went ok, so we change the internal structures. (let ((entry (assoc group nnmh-group-alist))) - (and entry (setcar entry new-name)) + (when entry + (setcar entry new-name)) (setq nnmh-current-directory nil) t)))) @@ -387,21 +389,21 @@ (when (and server (not (nnmh-server-opened server))) (nnmh-open-server server)) - (if newsgroup - (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) - (if (file-directory-p pathname) - (setq nnmh-current-directory pathname) - (error "No such newsgroup: %s" newsgroup))))) + (when newsgroup + (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) + (if (file-directory-p pathname) + (setq nnmh-current-directory pathname) + (error "No such newsgroup: %s" newsgroup))))) (defun nnmh-possibly-create-directory (group) (let (dir dirs) (setq dir (nnmail-group-pathname group nnmh-directory)) (while (not (file-directory-p dir)) - (setq dirs (cons dir dirs)) + (push dir dirs) (setq dir (file-name-directory (directory-file-name dir)))) (while dirs - (if (make-directory (directory-file-name (car dirs))) - (error "Could not create directory %s" (car dirs))) + (when (make-directory (directory-file-name (car dirs))) + (error "Could not create directory %s" (car dirs))) (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) @@ -422,7 +424,7 @@ (while ga (nnmh-possibly-create-directory (caar ga)) (let ((file (concat (nnmail-group-pathname - (caar ga) nnmh-directory) + (caar ga) nnmh-directory) (int-to-string (cdar ga))))) (if first ;; It was already saved, so we just make a hard link. @@ -466,7 +468,8 @@ (let* ((dir nnmh-current-directory) (files (sort (mapcar (function (lambda (name) (string-to-int name))) (directory-files nnmh-current-directory - nil "^[0-9]+$" t)) '<)) + nil "^[0-9]+$" t)) + '<)) (nnmh-file (concat dir ".nnmh-articles")) new articles) ;; Load the .nnmh-articles file. @@ -479,7 +482,7 @@ (let ((art files)) (while art (unless (assq (car art) articles) - (setq new (cons (car art) new))) + (push (car art) new)) (setq art (cdr art)))) ;; Remove all deleted articles. (let ((art articles)) @@ -514,7 +517,7 @@ (gnus-group-prefixed-name group (list 'nnmh "")) (setq new (sort new '<)))) ;; Sort the article list with highest numbers first. - (setq articles (sort articles (lambda (art1 art2) + (setq articles (sort articles (lambda (art1 art2) (> (car art1) (car art2))))) ;; Finally write this list back to the .nnmh-articles file. (nnheader-temp-write nnmh-file @@ -526,10 +529,10 @@ (defun nnmh-deletable-article-p (group article) "Say whether ARTICLE in GROUP can be deleted." (let ((path (concat nnmh-current-directory (int-to-string article)))) - (and (file-writable-p path) - (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) - article)))))) + (when (file-writable-p path) + (or (not nnmail-keep-last-article) + (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) + article)))))) (provide 'nnmh) diff --git a/lisp/nnml.el b/lisp/nnml.el index c42ad58c1..d4d87a904 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -112,19 +112,18 @@ all. This may very well take some time.") (concat nnml-current-directory (or (cdr (assq article nnml-article-file-alist)) ""))) - (if (and (file-exists-p file) - (not (file-directory-p file))) - (progn - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (nnheader-insert-head file) - (goto-char beg) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max)) - (insert "\n\n")) - (insert ".\n") - (delete-region (point) (point-max)))) + (when (and (file-exists-p file) + (not (file-directory-p file))) + (insert (format "221 %d Article retrieved.\n" article)) + (setq beg (point)) + (nnheader-insert-head file) + (goto-char beg) + (if (search-forward "\n\n" nil t) + (forward-char -1) + (goto-char (point-max)) + (insert "\n\n")) + (insert ".\n") + (delete-region (point) (point-max))) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nnmail-large-newsgroup) @@ -165,11 +164,11 @@ all. This may very well take some time.") (if (stringp id) (when (and (setq group-num (nnml-find-group-number id)) (cdr - (assq (cdr group-num) + (assq (cdr group-num) (nnheader-article-to-file-alist (setq gpath (nnmail-group-pathname - (car group-num) + (car group-num) nnml-directory)))))) (setq path (concat gpath (int-to-string (cdr group-num))))) (setq path (nnml-article-to-file id))) @@ -217,7 +216,7 @@ all. This may very well take some time.") (setq nnml-article-file-alist nil) t) -(deffoo nnml-request-create-group (group &optional server args) +(deffoo nnml-request-create-group (group &optional server args) (nnmail-activate 'nnml) (unless (assoc group nnml-group-alist) (let (active) @@ -431,7 +430,8 @@ all. This may very well take some time.") (error nil))) ;; That went ok, so we change the internal structures. (let ((entry (assoc group nnml-group-alist))) - (and entry (setcar entry new-name)) + (when entry + (setcar entry new-name)) (setq nnml-current-directory nil nnml-current-group nil) ;; Save the new group alist. @@ -466,10 +466,10 @@ all. This may very well take some time.") (let (file path) (when (setq file (cdr (assq article nnml-article-file-alist))) (setq path (concat nnml-current-directory file)) - (and (file-writable-p path) - (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) - article))))))) + (when (file-writable-p path) + (or (not nnmail-keep-last-article) + (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) + article))))))) ;; Find an article number in the current group given the Message-ID. (defun nnml-find-group-number (id) @@ -500,19 +500,18 @@ all. This may very well take some time.") number found) (when (file-exists-p nov) (insert-file-contents nov) - (while (and (not found) + (while (and (not found) (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. - (if (search-backward - "\t" (save-excursion (beginning-of-line) (point)) t 4) - (progn - (beginning-of-line) - (setq found t) - ;; We return the article number. - (setq number - (condition-case () - (read (current-buffer)) - (error nil)))))) + (when (search-backward + "\t" (save-excursion (beginning-of-line) (point)) t 4) + (beginning-of-line) + (setq found t) + ;; We return the article number. + (setq number + (condition-case () + (read (current-buffer)) + (error nil))))) number))) (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) @@ -530,17 +529,19 @@ all. This may very well take some time.") (if (and fetch-old (not (numberp fetch-old))) t ; Don't remove anything. - (if fetch-old - (setq first (max 1 (- first fetch-old)))) + (when fetch-old + (setq first (max 1 (- first fetch-old)))) (goto-char (point-min)) (while (and (not (eobp)) (> first (read (current-buffer)))) (forward-line 1)) (beginning-of-line) - (if (not (eobp)) (delete-region 1 (point))) + (when (not (eobp)) + (delete-region 1 (point))) (while (and (not (eobp)) (>= last (read (current-buffer)))) (forward-line 1)) (beginning-of-line) - (if (not (eobp)) (delete-region (point) (point-max))) + (when (not (eobp)) + (delete-region (point) (point-max))) t)))))) (defun nnml-possibly-change-directory (group &optional server) @@ -559,7 +560,7 @@ all. This may very well take some time.") (let (dir dirs) (setq dir (nnmail-group-pathname group nnml-directory)) (while (not (file-directory-p dir)) - (setq dirs (cons dir dirs)) + (push dir dirs) (setq dir (file-name-directory (directory-file-name dir)))) (while dirs (make-directory (directory-file-name (car dirs))) @@ -624,7 +625,7 @@ all. This may very well take some time.") (cons (caar nnml-article-file-alist) (caar (last nnml-article-file-alist))) (cons 1 0))) - (setq nnml-group-alist (cons (list group active) nnml-group-alist))) + (push (list group active) nnml-group-alist)) (setcdr active (1+ (cdr active))) (while (file-exists-p (concat (nnmail-group-pathname group nnml-directory) @@ -670,8 +671,7 @@ all. This may very well take some time.") (save-excursion (set-buffer buffer) (buffer-disable-undo (current-buffer))) - (setq nnml-nov-buffer-alist - (cons (cons group buffer) nnml-nov-buffer-alist)) + (push (cons group buffer) nnml-nov-buffer-alist) buffer))) (defun nnml-save-nov () @@ -778,8 +778,8 @@ all. This may very well take some time.") (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-min)) - (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t) - (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) + (when (re-search-forward (concat "^" (int-to-string article) "\t") nil t) + (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) t)) (provide 'nnml) diff --git a/lisp/nnoo.el b/lisp/nnoo.el index 032e7f5b8..a82e22b0c 100644 --- a/lisp/nnoo.el +++ b/lisp/nnoo.el @@ -52,7 +52,7 @@ (put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body)) (defun nnoo-register-function (func) - (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) + (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) nnoo-definition-alist)))) (unless funcs (error "%s belongs to a backend that hasn't been declared" func)) @@ -127,7 +127,7 @@ (incf i)) (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) (&rest args) - (nnoo-parent-function ',backend ',(car m) + (nnoo-parent-function ',backend ',(car m) ,(cons 'list (nreverse margs)))))))) (defun nnoo-backend (symbol) @@ -147,7 +147,7 @@ (parents (nth 1 def))) (unless def (error "%s belongs to a backend that hasn't been declared." var)) - (setcar (nthcdr 2 def) + (setcar (nthcdr 2 def) (delq (assq var (nth 2 def)) (nth 2 def))) (setcar (nthcdr 2 def) (cons (cons var (symbol-value var)) @@ -240,7 +240,7 @@ (defun nnoo-define-basics-1 (backend) (let ((functions '(close-server server-opened status-message))) (while functions - (eval `(deffoo ,(nnoo-symbol backend (car functions)) + (eval `(deffoo ,(nnoo-symbol backend (car functions)) (&optional server) (,(nnoo-symbol 'nnoo (pop functions)) ',backend server))))) (eval `(deffoo ,(nnoo-symbol backend 'open-server) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index fcf2c6235..f9c935ebc 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -231,7 +231,7 @@ The SOUP packet file name will be inserted at the %s.") (nnheader-report 'nnsoup "No such group: %s" group) (nnheader-insert "211 %d %d %d %s\n" - (max (1+ (- (cdr active) (car active))) 0) + (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group))))) (deffoo nnsoup-request-type (group &optional article) @@ -470,7 +470,7 @@ The SOUP packet file name will be inserted at the %s.") nnsoup-packet-directory t nnsoup-packet-regexp)) packet) (while (setq packet (pop packets)) - (message (format "nnsoup: unpacking %s..." packet)) + (message "nnsoup: unpacking %s..." packet) (if (not (gnus-soup-unpack-packet nnsoup-tmp-directory nnsoup-unpacker packet)) (message "Couldn't unpack %s" packet) @@ -509,8 +509,8 @@ The SOUP packet file name will be inserted at the %s.") (let ((format (gnus-soup-encoding-format (gnus-soup-area-encoding (nth 1 area))))) (goto-char end) - (if (or (= format ?n) (= format ?m)) - (setq end (progn (forward-line -1) (point)))))) + (when (or (= format ?n) (= format ?m)) + (setq end (progn (forward-line -1) (point)))))) (set-buffer msg-buf)) (widen) (narrow-to-region beg (or end (point-max)))) @@ -657,15 +657,14 @@ The SOUP packet file name will be inserted at the %s.") (setq replies (cdr replies))) (if replies (gnus-soup-reply-prefix (car replies)) - (setq nnsoup-replies-list - (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory) - kind - (format "%c%c%c" - nnsoup-replies-format-type - nnsoup-replies-index-type - (if (string= kind "news") - ?n ?m))) - nnsoup-replies-list)) + (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory) + kind + (format "%c%c%c" + nnsoup-replies-format-type + nnsoup-replies-index-type + (if (string= kind "news") + ?n ?m))) + nnsoup-replies-list) (gnus-soup-reply-prefix (car nnsoup-replies-list))))) (defun nnsoup-make-active () @@ -696,7 +695,7 @@ The SOUP packet file name will be inserted at the %s.") (match-end 1)))) (if (not (setq elem (assoc group active))) (push (list group (cons 1 lines) - (list (cons 1 lines) + (list (cons 1 lines) (vector ident group "ncm" "" lines))) active) (nconc elem diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 0c2e08d97..21f10f83b 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -143,8 +143,8 @@ there.") (message "nnspool: Receiving headers... %d%%" (/ (* count 100) number)))) - (and do-message - (message "nnspool: Receiving headers...done")) + (when do-message + (message "nnspool: Receiving headers...done")) ;; Fold continuation lines. (nnheader-fold-continuation-lines) @@ -290,9 +290,9 @@ there.") (goto-char (match-end 1)) (read (current-buffer))) seconds)) - (setq groups (cons (buffer-substring + (push (buffer-substring (match-beginning 1) (match-end 1)) - groups)) + groups) (zerop (forward-line -1)))) (erase-buffer) (while groups @@ -426,8 +426,8 @@ there.") (error nil)) (goto-char (point-min)) (prog1 - (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") - (cons (match-string 1) (string-to-int (match-string 2)))) + (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") + (cons (match-string 1) (string-to-int (match-string 2)))) (kill-buffer (current-buffer))))) (defun nnspool-find-file (file) @@ -458,7 +458,7 @@ there.") (timezone-parse-time (aref (timezone-parse-date date) 3)))) (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime) - (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) + (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) (nth 4 tdate)))) (+ (* (car unix) 65536.0) (cadr unix)))) diff --git a/lisp/nntp.el b/lisp/nntp.el index 95499b838..999798302 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -47,7 +47,7 @@ The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this hook might be `nntp-send-authinfo', which will prompt for a password to allow posting from the server. Note that this is only necessary to -do on servers that use strict access control.") +do on servers that use strict access control.") (defvoo nntp-authinfo-function 'nntp-send-authinfo "Function used to send AUTHINFO to the server.") @@ -178,7 +178,7 @@ server there that you can connect to. See also `nntp-open-connection-function'" (save-excursion (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) (erase-buffer) - (if (and (not gnus-nov-is-evil) + (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) (nntp-retrieve-headers-with-xover articles fetch-old)) ;; We successfully retrieved the headers via XOVER. @@ -195,7 +195,7 @@ server there that you can connect to. See also `nntp-open-connection-function'" (while articles (nntp-send-command nil - "HEAD" (if (numberp (car articles)) + "HEAD" (if (numberp (car articles)) (int-to-string (car articles)) ;; `articles' is either a list of article numbers ;; or a list of article IDs. @@ -302,7 +302,7 @@ server there that you can connect to. See also `nntp-open-connection-function'" ;; superfluous gunk. (goto-char (point-min)) (while (re-search-forward "^[.2-5]" nil t) - (delete-region (match-beginning 0) + (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) (copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'active)))) @@ -413,7 +413,7 @@ server there that you can connect to. See also `nntp-open-connection-function'" (let* ((date (timezone-parse-date date)) (time-string (format "%s%02d%02d %s%s%s" - (substring (aref date 0) 2) (string-to-int (aref date 1)) + (substring (aref date 0) 2) (string-to-int (aref date 1)) (string-to-int (aref date 2)) (substring (aref date 3) 0 2) (substring (aref date 3) 3 5) (substring (aref date 3) 6 8)))) @@ -484,14 +484,14 @@ It will prompt for a password." (set-buffer nntp-server-buffer) (erase-buffer))) (nntp-retrieve-data - (mapconcat 'identity strings " ") + (mapconcat 'identity strings " ") nntp-address nntp-port-number nntp-server-buffer wait-for nnheader-callback-function)) (defun nntp-send-command-nodelete (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." (nntp-retrieve-data - (mapconcat 'identity strings " ") + (mapconcat 'identity strings " ") nntp-address nntp-port-number nntp-server-buffer wait-for nnheader-callback-function)) @@ -502,7 +502,7 @@ It will prompt for a password." (set-buffer nntp-server-buffer) (erase-buffer))) (nntp-retrieve-data - (mapconcat 'identity strings " ") + (mapconcat 'identity strings " ") nntp-address nntp-port-number nntp-server-buffer wait-for nnheader-callback-function t)) @@ -577,7 +577,7 @@ It will prompt for a password." (nntp-wait-for process "^.*\n" buffer) (if (memq (process-status process) '(open run)) (prog1 - (caar (push (list process buffer nil) + (caar (push (list process buffer nil) nntp-connection-alist)) (push process nntp-connection-list) (save-excursion @@ -784,8 +784,8 @@ It will prompt for a password." fetch-old) (nntp-send-xover-command (if fetch-old - (if (numberp fetch-old) - (max 1 (- (car articles) fetch-old)) + (if (numberp fetch-old) + (max 1 (- (car articles) fetch-old)) 1) (car articles)) (car (last articles)) 'wait) @@ -819,7 +819,7 @@ It will prompt for a password." (setq first (car articles)) ;; Search forward until we find a gap, or until we run out of ;; articles. - (while (and (cdr articles) + (while (and (cdr articles) (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) (setq articles (cdr articles))) @@ -836,7 +836,7 @@ It will prompt for a password." ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reproduce, because it only ;; seems to happen once in a blue moon. - (set-buffer buf) + (set-buffer buf) (while (progn (goto-char last-point) ;; Count replies. @@ -1010,7 +1010,7 @@ It will prompt for a password." (string-match (format "\\([^ :]+\\):%d" number) xref)) (substring xref (match-beginning 1) (match-end 1))) (t ""))) - (when (string-match "\r" group) + (when (string-match "\r" group) (setq group (substring group 0 (match-beginning 0)))) (cons group number))))) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 7a97ce75f..b8c9a2d10 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -131,13 +131,13 @@ virtual group.") (insert "Xref: " system-name " " cgroup ":") (princ (caddr article) (current-buffer)) (insert " ") - (if (not (string= "" prefix)) - (while (re-search-forward - "[^ ]+:[0-9]+" - (save-excursion (end-of-line) (point)) t) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix)))) + (when (not (string= "" prefix)) + (while (re-search-forward + "[^ ]+:[0-9]+" + (save-excursion (end-of-line) (point)) t) + (save-excursion + (goto-char (match-beginning 0)) + (insert prefix)))) (end-of-line) (or (= (char-after (1- (point))) ?\t) (insert ?\t))) @@ -250,7 +250,7 @@ virtual group.") (nnvirtual-update-marked)) t) -(deffoo nnvirtual-request-list (&optional server) +(deffoo nnvirtual-request-list (&optional server) (nnheader-report 'nnvirtual "LIST is not implemented.")) (deffoo nnvirtual-request-newgroups (date &optional server) @@ -394,10 +394,10 @@ virtual group.") (when gnus-use-cache (push (cons 'cache (gnus-cache-articles-in-group g)) marks)) - (setq div (/ (float (car active)) + (setq div (/ (float (car active)) (if (zerop (cdr active)) 1 (cdr active)))) - (mapcar (lambda (n) + (mapcar (lambda (n) (list (* div (- n (car active))) g n (and (memq n unreads) t) (inline (nnvirtual-marks n marks)))) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 40707a3ad..c51d4503d 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -315,7 +315,8 @@ (function (lambda (data) (concat (w3-form-encode-xwfu (car data)) "=" - (w3-form-encode-xwfu (cdr data))))) pairs "&")) + (w3-form-encode-xwfu (cdr data))))) + pairs "&")) (defun nnweb-fetch-form (url pairs) (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs)) @@ -368,7 +369,7 @@ (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) (narrow-to-region - (point) + (point) (cond ((re-search-forward "^ +[0-9]+\\." nil t) (match-beginning 0)) ((search-forward "\n\n" nil t) @@ -471,7 +472,7 @@ (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) (narrow-to-region - (point) + (point) (if (re-search-forward "^$" nil t) (match-beginning 0) (point-max))) @@ -656,7 +657,7 @@ (nnweb-encode-www-form-urlencoded `(("pg" . "aq") ("what" . "news") - ,@(if part `(("stq" . ,(int-to-string (* part 30))))) + ,@(when part `(("stq" . ,(int-to-string (* part 30))))) ("fmt" . "d") ("q" . ,search) ("r" . "") diff --git a/lisp/widget-edit.el b/lisp/widget-edit.el index 2541a6a43..5a07f3f47 100644 --- a/lisp/widget-edit.el +++ b/lisp/widget-edit.el @@ -940,12 +940,12 @@ With optional ARG, move across that many fields." (defun widget-choice-convert-widget (widget) ;; Expand type args into widget objects. -; (widget-put widget :args (mapcar (lambda (child) -; (if (widget-get child ':converted) -; child -; (widget-put child ':converted t) -; (widget-convert child))) -; (widget-get widget :args))) + ; (widget-put widget :args (mapcar (lambda (child) + ; (if (widget-get child ':converted) + ; child + ; (widget-put child ':converted t) + ; (widget-convert child))) + ; (widget-get widget :args))) (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args))) widget) @@ -1460,7 +1460,7 @@ With optional ARG, move across that many fields." (t (widget-default-format-handler widget escape)))) -;(defun widget-editable-list-format-handler (widget escape) + ;(defun widget-editable-list-format-handler (widget escape) ; ;; We recognize the insert button. ; (cond ((eq escape ?i) ; (insert " ") diff --git a/texi/ChangeLog b/texi/ChangeLog index 6a4bb4e40..59e0e5c2d 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +Tue Oct 1 01:34:45 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Expiring Mail): Addition. + (Group Line Specification): Addition. + Sat Sep 28 21:36:40 1996 Lars Magne Ingebrigtsen * gnus.texi (Foreign Groups): Addition. diff --git a/texi/gnus.texi b/texi/gnus.texi index 78edd549d..8ef8d1b9b 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Red Gnus 0.45 Manual +@settitle Red Gnus 0.46 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -287,7 +287,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Red Gnus 0.45 Manual +@title Red Gnus 0.46 Manual @author by Lars Magne Ingebrigtsen @page @@ -1119,6 +1119,12 @@ variable says how many levels to leave at the end of the group name. The default is 1---this will mean that group names like @samp{gnu.emacs.gnus} will be shortened to @samp{g.emacs.gnus}. +@item m +@vindex gnus-new-mail-mark +@cindex % +@samp{%} (@code{gnus-new-mail-mark}) if there has arrived new mail to +the group lately. + @item u User defined specifier. The next character in the format string should be a letter. @sc{gnus} will call the function @@ -8732,6 +8738,12 @@ have all articles that you read marked as expirable automatically. All articles that are marked as expirable have an @samp{E} in the first column in the summary buffer. +Note that making a group auto-expirable don't mean that all read +articles are expired---only the articles that are marked as expirable +will be expired. Also note the using the @kbd{d} command won't make +groups expirable---only semi-automatic marking of articles as read will +mark the articles as expirable in auto-expirable groups. + Let's say you subscribe to a couple of mailing lists, and you want the articles you have read to disappear after a while: @@ -8798,6 +8810,8 @@ wrong group and all your important mail has disappeared. Be a @emph{man}! Or a @emph{woman}! Whatever you feel more comfortable with! So there! +Most people make most of their mail groups total-expirable, though. + @node Washing Mail @subsection Washing Mail diff --git a/texi/message.texi b/texi/message.texi index 684a61182..294692fa0 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -809,8 +809,11 @@ Check whether any of the headers are empty. Check whether the newsgroups mentioned in the Newsgroups and Followup-To headers exist. @item valid-newsgroups -Check whether the @code{Newsgroups} and @code{Followup-To} headers +Check whether the @code{Newsgroups} and @code{Followup-to} headers are valid syntactically. +@item shorten-followup-to +Check whether to add a @code{Followup-to} header to shorten the number +of groups to post to. @end table All these conditions are checked by default. -- 2.25.1