+2007-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist)
+ (gnus-agent-expire-unagentized-dirs): Replace mapcar called for effect
+ with while loop.
+
+ * gnus-art.el: Use mapc instead of mapcar to make gnus-article-*
+ functions from article-* functions.
+ (gnus-multi-decode-header): Replace mapcar called for effect with
+ dolist.
+
+ * gnus-bookmark.el (gnus-bookmark-bmenu-list)
+ (gnus-bookmark-show-details): Replace mapcar called for effect with
+ while loop.
+
+ * gnus-diary.el (gnus-diary-update-group-parameters): Replace mapcar
+ called for effect with while loop.
+
+ * gnus-group.el (gnus-group-suspend): Replace mapcar called for effect
+ with dolist.
+
+ * gnus-registry.el (gnus-registry-split-fancy-with-parent): Replace
+ mapcar called for effect with dolist.
+
+ * gnus-spec.el (gnus-correct-length): Make it simple and fast.
+
+ * gnus-sum.el (gnus-multi-decode-encoded-word-string)
+ (gnus-build-sparse-threads, gnus-summary-limit-include-expunged):
+ Replace mapcar called for effect with dolist.
+ (gnus-simplify-buffer-fuzzy): Replace mapcar called for effect with
+ mapc.
+
+ * gnus-topic.el (gnus-topic-find-groups, gnus-topic-move-group):
+ Replace mapcar called for effect with dolist.
+ (gnus-topic-list): Replace mapcar called for effect with mapc.
+
+ * gnus.el: Use mapc instead of mapcar to add autoloads.
+
2007-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus.el (gnus-server-to-method): Return method found first in
((= version 1)
(setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
((= version 2)
- (let (uncomp)
- (mapcar
- (lambda (comp-list)
- (let ((state (car comp-list))
- (sequence (inline
- (gnus-uncompress-range
- (cdr comp-list)))))
- (mapcar (lambda (article-id)
- (setq uncomp (cons (cons article-id state) uncomp)))
- sequence)))
- alist)
+ (let (state sequence uncomp)
+ (while alist
+ (setq state (caar alist)
+ sequence (inline (gnus-uncompress-range (cdar alist)))
+ alist (cdr alist))
+ (while sequence
+ (push (cons (pop sequence) state) uncomp)))
(setq alist (sort uncomp 'car-less-than-car)))
(setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
(when changed-version
(cond ((eq gnus-agent-article-alist-save-format 1)
(princ gnus-agent-article-alist (current-buffer)))
((eq gnus-agent-article-alist-save-format 2)
- (let ((compressed nil))
- (mapcar (lambda (pair)
- (let* ((article-id (car pair))
- (day-of-download (cdr pair))
- (comp-list (assq day-of-download compressed)))
- (if comp-list
- (setcdr comp-list
- (cons article-id (cdr comp-list)))
- (setq compressed
- (cons (list day-of-download article-id)
- compressed)))
- nil)) gnus-agent-article-alist)
- (mapcar (lambda (comp-list)
- (setcdr comp-list
- (gnus-compress-sequence
- (nreverse (cdr comp-list)))))
- compressed)
+ (let ((alist gnus-agent-article-alist)
+ article-id day-of-download comp-list compressed)
+ (while alist
+ (setq article-id (caar alist)
+ day-of-download (cdar alist)
+ comp-list (assq day-of-download compressed)
+ alist (cdr alist))
+ (if comp-list
+ (setcdr comp-list (cons article-id (cdr comp-list)))
+ (push (list day-of-download article-id) compressed)))
+ (setq alist compressed)
+ (while alist
+ (setq comp-list (pop alist))
+ (setcdr comp-list
+ (gnus-compress-sequence (nreverse (cdr comp-list)))))
(princ compressed (current-buffer)))))
(insert "\n")
(princ gnus-agent-article-alist-save-format (current-buffer))
(let ((dir (pop to-remove)))
(if (gnus-y-or-n-p (format "Delete %s? " dir))
(let* (delete-recursive
+ files f
(delete-recursive
(function
(lambda (f-or-d)
(condition-case nil
(delete-directory f-or-d)
(file-error
- (mapcar (lambda (f)
- (or (member f '("." ".."))
- (funcall delete-recursive
- (nnheader-concat
- f-or-d f))))
- (directory-files f-or-d))
+ (setq files (directory-files f-or-d))
+ (while files
+ (setq f (pop files))
+ (or (member f '("." ".."))
+ (funcall delete-recursive
+ (nnheader-concat
+ f-or-d f))))
(delete-directory f-or-d)))
(delete-file f-or-d)))))))
(funcall delete-recursive dir))))))))))
(canlock-verify gnus-original-article-buffer)))
(eval-and-compile
- (mapcar
+ (mapc
(lambda (func)
(let (afunc gfunc)
(if (consp func)
article-emphasize
article-treat-dumbquotes
article-normalize-headers
-;; (article-show-all . gnus-article-show-all-headers)
+ ;;(article-show-all . gnus-article-show-all-headers)
)))
\f
;;;
(eq gnus-newsgroup-name
(car gnus-decode-header-methods-cache)))
(setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
- (mapcar (lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-header-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-header-methods-cache
- (list (cdr x))))))
- gnus-decode-header-methods))
+ (dolist (x gnus-decode-header-methods)
+ (if (symbolp x)
+ (nconc gnus-decode-header-methods-cache (list x))
+ (if (and gnus-newsgroup-name
+ (string-match (car x) gnus-newsgroup-name))
+ (nconc gnus-decode-header-methods-cache
+ (list (cdr x)))))))
(let ((xlist gnus-decode-header-methods-cache))
(pop xlist)
(save-restriction
(if (interactive-p)
(switch-to-buffer (get-buffer-create "*Gnus Bookmark List*"))
(set-buffer (get-buffer-create "*Gnus Bookmark List*")))
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ alist name start end)
(erase-buffer)
(insert "% Gnus Bookmark\n- --------\n")
(add-text-properties (point-min) (point)
;; sort before displaying
(gnus-bookmark-maybe-sort-alist)
;; Display gnus bookmarks
- (mapcar
- (lambda (full-record)
- ;; if a Gnus bookmark has an annotation, prepend a "*"
- ;; in the list of bookmarks.
- (let ((annotation (gnus-bookmark-get-annotation
- (gnus-bookmark-name-from-full-record full-record))))
- (if (and annotation (not (string-equal annotation "")))
- (insert " *")
- (insert " "))
- (let ((start (point)))
- (insert (gnus-bookmark-name-from-full-record full-record))
- (if (gnus-bookmark-mouse-available-p)
- (add-text-properties
- start
- (save-excursion (re-search-backward
- "[^ \t]")
- (1+ (point)))
- `(mouse-face highlight
- follow-link t
- help-echo ,(format "%s: go to this article"
- (aref gnus-mouse-2 0)))))
- (insert "\n")
- )))
- gnus-bookmark-alist)
+ (setq alist gnus-bookmark-alist)
+ (while alist
+ (setq name (gnus-bookmark-name-from-full-record (pop alist)))
+ ;; if a Gnus bookmark has an annotation, prepend a "*"
+ ;; in the list of bookmarks.
+ (insert (if (member (gnus-bookmark-get-annotation name) (list nil ""))
+ " "
+ " *"))
+ (if (gnus-bookmark-mouse-available-p)
+ (add-text-properties
+ (prog1
+ (point)
+ (insert name))
+ (let ((end (point)))
+ (prog2
+ (re-search-backward "[^ \t]")
+ (1+ (point))
+ (goto-char end)
+ (insert "\n")))
+ `(mouse-face highlight follow-link t
+ help-echo ,(format "%s: go to this article"
+ (aref gnus-mouse-2 0))))
+ (insert name "\n")))
(goto-char (point-min))
(forward-line 2)
(gnus-bookmark-bmenu-mode)
(defun gnus-bookmark-show-details (bookmark)
"Display the annotation for BOOKMARK in a buffer."
- (let ((record (gnus-bookmark-get-bookmark-record bookmark)))
+ (let ((record (gnus-bookmark-get-bookmark-record bookmark))
+ (old-buf (current-buffer))
+ (details gnus-bookmark-bookmark-details)
+ detail)
(save-excursion
- (let ((old-buf (current-buffer)))
- (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
- (delete-region (point-min) (point-max))
- (mapcar
- (lambda (detail)
- (when (not (equal (cdr (assoc detail record)) ""))
- (insert (concat (symbol-name detail) ": "
- (cdr (assoc detail record))
- "\n"))))
- gnus-bookmark-bookmark-details)
- (goto-char (point-min))
- (pop-to-buffer old-buf)))))
+ (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
+ (erase-buffer)
+ (while details
+ (setq detail (pop details))
+ (unless (equal (cdr (assoc detail record)) "")
+ (insert (symbol-name detail) ": " (cdr (assoc detail record)) "\n")))
+ (goto-char (point-min))
+ (pop-to-buffer old-buf))))
(defun gnus-bookmark-bmenu-show-details ()
"Show the annotation for the current bookmark in another window."
;; - a nice summary line format
;; - NNDiary specific sorting by schedule functions
;; In general, try not to mess with what the user might have modified.
- (let ((posting-style (gnus-group-get-parameter group 'posting-style t)))
- ;; Posting style:
- (mapcar (lambda (elt)
- (let ((header (format "X-Diary-%s" (car elt))))
- (unless (assoc header posting-style)
- (setq posting-style (append posting-style
- `((,header "*")))))
- ))
- nndiary-headers)
- (gnus-group-set-parameter group 'posting-style posting-style)
- ;; Summary line format:
- (unless (gnus-group-get-parameter group 'gnus-summary-line-format t)
- (gnus-group-set-parameter group 'gnus-summary-line-format
- `(,gnus-diary-summary-line-format)))
- ;; Sorting by schedule:
- (unless (gnus-group-get-parameter group 'gnus-article-sort-functions)
- (gnus-group-set-parameter group 'gnus-article-sort-functions
- '((append gnus-article-sort-functions
- (list
- 'gnus-article-sort-by-schedule)))))
- (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions)
- (gnus-group-set-parameter group 'gnus-thread-sort-functions
- '((append gnus-thread-sort-functions
- (list
- 'gnus-thread-sort-by-schedule)))))
- ))
+
+ ;; Posting style:
+ (let ((posting-style (gnus-group-get-parameter group 'posting-style t))
+ (headers nndiary-headers)
+ header)
+ (while headers
+ (setq header (format "X-Diary-%s" (caar headers))
+ headers (cdr headers))
+ (unless (assoc header posting-style)
+ (setq posting-style (append posting-style (list (list header "*"))))))
+ (gnus-group-set-parameter group 'posting-style posting-style))
+ ;; Summary line format:
+ (unless (gnus-group-get-parameter group 'gnus-summary-line-format t)
+ (gnus-group-set-parameter group 'gnus-summary-line-format
+ `(,gnus-diary-summary-line-format)))
+ ;; Sorting by schedule:
+ (unless (gnus-group-get-parameter group 'gnus-article-sort-functions)
+ (gnus-group-set-parameter group 'gnus-article-sort-functions
+ '((append gnus-article-sort-functions
+ (list
+ 'gnus-article-sort-by-schedule)))))
+ (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions)
+ (gnus-group-set-parameter group 'gnus-thread-sort-functions
+ '((append gnus-thread-sort-functions
+ (list
+ 'gnus-thread-sort-by-schedule))))))
;; Called when a group is subscribed. This is needed because groups created
;; because of mail splitting are *not* created with the back end function.
(gnus-offer-save-summaries)
;; Kill Gnus buffers except for group mode buffer.
(let ((group-buf (get-buffer gnus-group-buffer)))
- (mapcar (lambda (buf)
- (unless (or (member buf (list group-buf gnus-dribble-buffer))
- (with-current-buffer buf
- (eq major-mode 'message-mode)))
- (gnus-kill-buffer buf)))
- (gnus-buffers))
+ (dolist (buf (gnus-buffers))
+ (unless (or (eq buf group-buf)
+ (eq buf gnus-dribble-buffer)
+ (with-current-buffer buf
+ (eq major-mode 'message-mode)))
+ (gnus-kill-buffer buf)))
(setq gnus-backlog-articles nil)
(gnus-kill-gnus-frames)
(when group-buf
(if (listp nnmail-split-fancy-with-parent-ignore-groups)
nnmail-split-fancy-with-parent-ignore-groups
(list nnmail-split-fancy-with-parent-ignore-groups)))
- references res)
+ res)
;; the references string must be valid and parse to valid references
(if (and refstr (gnus-extract-references refstr))
- (progn
- (setq references (nreverse (gnus-extract-references refstr)))
- (mapcar (lambda (x)
- (setq res (or (gnus-registry-fetch-group x) res))
- (when (or (gnus-registry-grep-in-list
- res
- gnus-registry-unfollowed-groups)
- (gnus-registry-grep-in-list
- res
- nnmail-split-fancy-with-parent-ignore-groups))
- (setq res nil)))
- references))
+ (dolist (reference (nreverse (gnus-extract-references refstr)))
+ (setq res (or (gnus-registry-fetch-group reference) res))
+ (when (or (gnus-registry-grep-in-list
+ res
+ gnus-registry-unfollowed-groups)
+ (gnus-registry-grep-in-list
+ res
+ nnmail-split-fancy-with-parent-ignore-groups))
+ (setq res nil)))
;; else: there were no references, now try the extra tracking
(let ((sender (gnus-string-remove-all-properties(message-fetch-field "from")))
(defun gnus-correct-length (string)
"Return the correct width of STRING."
- (let ((length 0))
- (mapcar (lambda (char) (incf length (char-width char))) string)
- length))
+ (apply #'+ (mapcar #'char-width string)))
(defun gnus-correct-substring (string start &optional end)
(let ((wstart 0)
(eq gnus-newsgroup-name
(car gnus-decode-encoded-word-methods-cache)))
(setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
- (mapcar (lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-encoded-word-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-encoded-word-methods-cache
- (list (cdr x))))))
- gnus-decode-encoded-word-methods))
- (let ((xlist gnus-decode-encoded-word-methods-cache))
- (pop xlist)
- (while xlist
- (setq string (funcall (pop xlist) string))))
- string)
+ (dolist (method gnus-decode-encoded-word-methods)
+ (if (symbolp method)
+ (nconc gnus-decode-encoded-word-methods-cache (list method))
+ (if (and gnus-newsgroup-name
+ (string-match (car method) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr method)))))))
+ (dolist (method (cdr gnus-decode-encoded-word-methods-cache) string)
+ (setq string (funcall method string))))
;; Subject simplification.
(setq modified-tick (buffer-modified-tick))
(cond
((listp gnus-simplify-subject-fuzzy-regexp)
- (mapcar 'gnus-simplify-buffer-fuzzy-step
- gnus-simplify-subject-fuzzy-regexp))
+ (mapc 'gnus-simplify-buffer-fuzzy-step
+ gnus-simplify-subject-fuzzy-regexp))
(gnus-simplify-subject-fuzzy-regexp
(gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
(gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
- (mapcar
- (lambda (relation)
- (when (gnus-dependencies-add-header
- (make-full-mail-header
- gnus-reffed-article-number
- (nth 3 relation) "" (or (nth 4 relation) "")
- (nth 1 relation)
- (or (nth 2 relation) "") 0 0 "")
- gnus-newsgroup-dependencies nil)
- (push gnus-reffed-article-number gnus-newsgroup-limit)
- (push gnus-reffed-article-number gnus-newsgroup-sparse)
- (push (cons gnus-reffed-article-number gnus-sparse-mark)
- gnus-newsgroup-reads)
- (decf gnus-reffed-article-number)))
- (sort relations 'car-less-than-car))
+ (dolist (relation (sort relations 'car-less-than-car))
+ (when (gnus-dependencies-add-header
+ (make-full-mail-header
+ gnus-reffed-article-number
+ (nth 3 relation) "" (or (nth 4 relation) "")
+ (nth 1 relation)
+ (or (nth 2 relation) "") 0 0 "")
+ gnus-newsgroup-dependencies nil)
+ (push gnus-reffed-article-number gnus-newsgroup-limit)
+ (push gnus-reffed-article-number gnus-newsgroup-sparse)
+ (push (cons gnus-reffed-article-number gnus-sparse-mark)
+ gnus-newsgroup-reads)
+ (decf gnus-reffed-article-number)))
(gnus-message 7 "Making sparse threads...done")))
(defun gnus-build-old-threads ()
(goto-char (point-min))
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
- (mapcar (lambda (x) (push (mail-header-number x)
- gnus-newsgroup-limit))
- headers)
+ (dolist (x headers)
+ (push (mail-header-number x) gnus-newsgroup-limit))
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
(gnus-summary-position-point)
(when recursive
(if (eq recursive t)
(setq recursive (cdr (gnus-topic-find-topology topic))))
- (mapcar (lambda (topic-topology)
- (setq visible-groups
- (nconc visible-groups
- (gnus-topic-find-groups
- (caar topic-topology)
- level all lowest topic-topology))))
- (cdr recursive)))
+ (dolist (topic-topology (cdr recursive))
+ (setq visible-groups
+ (nconc visible-groups
+ (gnus-topic-find-groups
+ (caar topic-topology)
+ level all lowest topic-topology)))))
visible-groups))
(defun gnus-topic-goto-previous-topic (n)
(setq topology gnus-topic-topology
gnus-tmp-topics nil))
(push (caar topology) gnus-tmp-topics)
- (mapcar 'gnus-topic-list (cdr topology))
+ (mapc 'gnus-topic-list (cdr topology))
gnus-tmp-topics)
;;; Topic parameter jazz
entry)
(if (and (not groups) (not copyp) start-topic)
(gnus-topic-move start-topic topic)
- (mapcar
- (lambda (g)
- (gnus-group-remove-mark g use-marked)
- (when (and
- (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
- (not copyp))
- (setcdr entry (gnus-delete-first g (cdr entry))))
- (nconc topicl (list g)))
- groups)
+ (dolist (g groups)
+ (gnus-group-remove-mark g use-marked)
+ (when (and
+ (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
+ (not copyp))
+ (setcdr entry (gnus-delete-first g (cdr entry))))
+ (nconc topicl (list g)))
(gnus-topic-enter-dribble)
(if start-group
(gnus-group-goto-group start-group)
;; This little mapcar goes through the list below and marks the
;; symbols in question as autoloaded functions.
- (mapcar
+ (mapc
(lambda (package)
(let ((interactive (nth 1 (memq ':interactive package))))
(mapcar
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
-;; gnus-article-show-all-headers
+ ;;gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done gnus-article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer
projects / gnus / commitdiff