+Tue Oct 1 03:41:17 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-picon.el (gnus-picons-glyph-hashtb): Made into hashtb.
+
+Tue Oct 1 01:50:10 1996 Lars Magne Ingebrigtsen <larsi@hrym.ifi.uio.no>
+
+ * 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 <harinath@cs.umn.edu>
+
+ * 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 <lars@eyesore.no>
+
+ * 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 <lars@eyesore.no>
+
+ * gnus-util.el (gnus-write-buffer): New function.
+
+Sun Sep 29 23:05:33 1996 Kurt Swanson <Kurt.Swanson@dna.lth.se>
+
+ * gnus-sum.el (gnus-handle-ephemeral-exit): New function.
+
+Sun Sep 29 22:41:01 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * 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 <larsi@ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.45 is released.
+
Sun Sep 29 00:57:13 1996 Dave Disser <disser@sdd.hp.com>
* gnus-sum.el (gnus-summary-display-article): Don't show tree
"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
"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
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 '("^-- $" "^-- *$")
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)
(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)
(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."
(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)
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
(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)))
(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)
(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.
;; 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
- ;; <sisolak@trans4.neep.wisc.edu>.
- (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
+ ;; <sisolak@trans4.neep.wisc.edu>.
+ (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.
(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))
(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)
(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)
(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."
(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)))
()
(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.
(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.
(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.
(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)
(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)))
(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
(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))))
(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)
(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
;; 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))
(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.
(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))))
(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
(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.
(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)
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)))
;; 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)
(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)
"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))
'<))))
(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)))
(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)))
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))
(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."
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))
()
;; 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
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)
(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)))
;; 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)
;; 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
(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)
(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?).
()
(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.
(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)
(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)
(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")
(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."
(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 ()
(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."
((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...
(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)))
((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))))
(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))
(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
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))
"*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
"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
(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.
(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
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)
(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))
(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" ("<mid1>" score1 nil s) ("<mid2> 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" ("<mid1>" score1 nil s) ("<mid2> 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))))
(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)
(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
(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
(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)
(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)
(t
(gnus-message 3 "Invalid prediction display type")
- (aset rate-string 0 ?|)
+ (aset rate-string 0 ?|)
(aset rate-string 11 ?|)
rate-string)))))
(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)))
)
;;;; 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))
(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)
(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)
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)))
(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))
(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)
(- 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 ()
;; 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"
'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.")
(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)
%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
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
(?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)))
(?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
(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)
(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)
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
"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.
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
(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))
(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)))))
(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)))
"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
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))))
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)
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)
(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
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)
(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))
(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)
(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)
(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")
(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))
(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)))
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))
(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
(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<))
(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)
'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)
(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 <amanda@iesd.auc.dk>.
(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)
(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
(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)
(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)))
(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 <amanda@iesd.auc.dk>.
(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))))
;; 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)))
(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."
(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)
(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)))
"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)))
(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)))))
(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))
(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))
(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)))
;; 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))))
;; 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)
(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.
(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)))
(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))
(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))
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)
function article header)
(cond
;; Search body.
- ((or (null field)
+ ((or (null field)
(string-equal field ""))
(setq function nil))
;; Get access function of header field.
(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"))
("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)
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
("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)
(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)
;; 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
(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
(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)
(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)))
(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)
(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)."
(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))
(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
(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.
(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.
(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)
(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))))
name
(gnus-group-prefixed-name
name gnus-message-archive-method)))
- (if groups (insert " ")))
+ (when groups
+ (insert " ")))
(insert "\n")))))))
(defun gnus-summary-send-draft ()
(setq articles
(gnus-uncompress-range
(cons
- (if active (1+ (cdr active))
+ (if active (1+ (cdr active))
(car gactive))
(cdr gactive))))
group))
(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.
(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 ()
(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 ()
(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."
(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
;; 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
(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)
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)
(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)
(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))
(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)))
(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)
(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)
(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)))
(>= 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))))
(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)
(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.
;; (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."
(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))
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)
"***")
(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)))
;; 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 ? )))))
;; 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.
(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
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 ()
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
("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)
(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.
(?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
(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))
""))
(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 ))
;; 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
(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) "")))
(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.
(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)))
(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) "\\'"))
(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)
(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)))))
\f
;;;
"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)
(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 ()
"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)
(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)
(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)
(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
(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))
(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
(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)
(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
(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))
(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))))
(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.
(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
;; 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*"))
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).
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
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) '>))
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))
(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)
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
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))
(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
(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
((= 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)
(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))
(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)))))
(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))))))
(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-"
(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)))
(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)
(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))
(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))
(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
(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)
;; 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
(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))
(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))
(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 ()
;; 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)))
(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)))
(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)
;;; UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-(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 <jin@atype.com>
;;; Patrick LoPresti <patl@lcs.mit.edu>
-(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 <jwz@lucid.com>
-(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"))
\f
;;;### (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
(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)
(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)
(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)))
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
(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 ()
(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
(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))
(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))
(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) "")
(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)
(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)
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))))
(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")))
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)
(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
(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
(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
(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))
(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)))
"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)
"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)
"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)
(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)
(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."
(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))
(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)))))
(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 ()
(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.
(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)))
(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)))
((= 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)))
((= 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)))))))
(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))))
(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)
(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
(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."
(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)))))
(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
(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 ()
((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
(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))
;; 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
(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,
;; 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
(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))
(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))
(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)))
(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)
(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 ""))
(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)))
(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)
(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 <Luc.VanEycken@esat.kuleuven.ac.be>.
(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)
(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))))))
(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))))))
;; 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))))
(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
;; 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)))
(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
(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)
;; 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))
(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
(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))
(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)))))
(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
;; 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))))
(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.
(princ (car range))
(insert "-")
(princ (cdr range)))
- (if ranges (insert ",")))))
+ (when ranges
+ (insert ",")))))
(insert "\n")))
(make-local-variable 'version-control)
(setq version-control 'never)
(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
(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"))))
(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)
(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))))
'(= 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
'(= 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
(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)
["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]
(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"))
(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)
(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)
(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)
(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)
(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))
(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
(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))
(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)))))
(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))
(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,
(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.
(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)))
(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)))
;; 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)
(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))
(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.
(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))))
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
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
(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))
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))
(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...
(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)
(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
(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))
(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}"
(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))
(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
(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))
(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)))))
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))
;; 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
(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))
(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."
(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))
;; 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?
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.
(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))
(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.
(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)))
(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))
(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.
(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.
(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)))))
(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.
(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."
(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 <pi92ae@pt.hk-r.se>.
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 <amanda@iesd.auc.dk>.
(defun gnus-summary-describe-group (&optional force)
(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)
(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))
(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."
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)
((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))
(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)
"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)
(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))))
(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)))
"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)))
(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))
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)
(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)
(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)))
(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."
(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.
(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."
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)
(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)
(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))
"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"))
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")))))
()
(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)
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 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"))))
(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))
(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))))
"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)
(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)
(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.
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
(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))
(= 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."
(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)))
;; 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))
(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)))))
(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)
(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
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))
(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)
(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)
(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.
(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)
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
(minibuffer-confirm-incomplete nil) ; XEmacs
group-map
(dum (mapatoms
- (lambda (g)
+ (lambda (g)
(and (boundp g)
(symbol-name g)
(memq 'respool
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))
(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.
(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)
(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
(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.
;; 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 ")
(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)
(let* ((beg (progn (beginning-of-line) (point)))
(end (progn (end-of-line) (point)))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
- (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)
;; 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))
(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)
;; 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))
(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))
(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))
;; 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)
(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)))
(or (save-excursion
(forward-line -1)
(gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level)) 0)) ? ))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
;;; Initialization
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
(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))))
(* 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
(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))
(* 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))
(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."
;; 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 <address>" format is used.
(and address
;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
(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))
;; 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)
"??-???"
(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)))
(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 ()
(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))))
(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)
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"))
(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
(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)))
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))))
(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))
((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))
(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))
(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)))
(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)))))
(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)
()
(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)))
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))
(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)
(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]+")
(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)))
(= 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)
(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)
(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.
;; 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
;; 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))
(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.
;; 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))
;; 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))
(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))
(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)
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)))
(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))
(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))
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))
(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))
(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))
(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)
(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.
(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.
(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.
;; 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
(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
(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.
(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))
(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))
(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))
(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
(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) ?-)))
(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
(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)
(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)
(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)))
(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))))
;; 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)
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")
(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
(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
;; 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)))
(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))
;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
(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
(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))
(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)))
(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)
(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)
(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
"
""))
;; 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)
(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*")))
(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
"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)
(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))
;; 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.
(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)
(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)))))
;; 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))
(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"
(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))
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
(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)))))))
(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)
(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.
(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)
(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)
;; 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
(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)
(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))
;; 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)
;; 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 ()
(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
;; 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
(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)))
(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)
(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")))
"^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 ()
(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))))
(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)
(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)))
(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))
"@" (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")
(save-excursion
(set-buffer buffer)
(concat "Lines: " (int-to-string
- (count-lines (point-min) (point-max))) "\n"))
+ (count-lines (point-min) (point-max)))
+ "\n"))
"")
)))
(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")))
(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)
(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
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
(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.
(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))
(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)
;; 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
(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)
(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)))
;; 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)))))
;; 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
(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)
(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))))))
(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"))
(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))))))
(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.
(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))
(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.
(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)
;; 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)))))
(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"))
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)))
(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)))
;; 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)))))
Eg.
\(add-hook 'nnmail-read-incoming-hook
- (lambda ()
+ (lambda ()
(start-process \"mailsend\" nil
\"/local/bin/mailsend\" \"read\" \"mbox\")))
(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))
"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))))))
;; 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)))))
(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)
(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 <edmonds@cs.ubc.ca>.
(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.
;; 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))
(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)
"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
((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))
(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)
(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 "".
;; 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 ()
(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))))
(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)
(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
", ")
"\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)
(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)
(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))))
(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.
(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))
(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)
(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)
(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))
(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)
(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."
(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)
;; 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
(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)
(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))))
(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 "")
(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)
(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)))
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)
() ; 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 ()
(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))))
(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)))))
(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.
(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.
(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))
(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
(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)
(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)
(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)))
(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)
(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.
(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)
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)
(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)
(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)))
(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)
(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 ()
(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)
(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))
(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)
(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))
(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)
(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)
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)
(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))))
(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 ()
(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
(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)
(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
(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)
(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))))
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.")
(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.
(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.
;; 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))))
(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))))
(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))
(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))
(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
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)
(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)))
;; 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.
(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)))))
(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)))
(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)
(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))))
(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))
(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)
(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)))
(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" . "")
(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)
(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 " ")
+Tue Oct 1 01:34:45 1996 Lars Magne Ingebrigtsen <larsi@hrym.ifi.uio.no>
+
+ * gnus.texi (Expiring Mail): Addition.
+ (Group Line Specification): Addition.
+
Sat Sep 28 21:36:40 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
* gnus.texi (Foreign Groups): Addition.
\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
@tex
@titlepage
-@title Red Gnus 0.45 Manual
+@title Red Gnus 0.46 Manual
@author by Lars Magne Ingebrigtsen
@page
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
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:
@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
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.
projects / gnus / commitdiff