*** A new backend for reading searches from Web search engines
(DejaNews, Alta Vista, InReference) has been added.
- Use the `G n' command in the group buffer to create such
+ Use the `G w' command in the group buffer to create such
a group.
+*** Groups inside topics can now be sorted using the standard
+sorting functions, and each topic can be sorted independently.
+
+ See the commands under the `T S' submap.
+
+*** Subsets of the groups can be sorted independently.
+
+ See the commands under the `G P' submap.
+
+*** Cached articles can be pulled into the groups.
+
+ Use the `Y c' command.
+
+*** Score files are now applied in a more reliable order.
+
+*** Reports on where mail messages end up can be generated.
+
+ `M-x nnmail-split-history'
+
+*** More hooks and functions have been added to remove junk
+from incoming mail before saving the mail.
+
+ See `nnmail-prepare-incoming-header-hook'.
+
+Sat Sep 7 14:33:17 1996 Lars Magne Ingebrigtsen <larsi@hymir.ifi.uio.no>
+
+ * nntp.el (nntp-after-change-function-callback): Renamed.
+
+ * nnweb.el (nnweb-reference-search): Nix out file name.
+
+Sat Sep 7 14:07:13 1996 Lars Magne Ingebrigtsen <larsi@hler.ifi.uio.no>
+
+ * nnweb.el (nnweb-altavista-search): Nix out buffer file name.
+
+ * gnus-async.el (gnus-asynch-with-semaphore): New macro.
+ (gnus-make-async-article-function): Nix out prefetch list when the
+ summary buffer dies.
+
+ * nnweb.el (nnweb-altavista-create-mapping): Would search forever
+ when not getting any matches.
+
+Sat Sep 7 12:43:24 1996 Lars Magne Ingebrigtsen <larsi@hymir.ifi.uio.no>
+
+ * gnus-msg.el (gnus-inews-yank-articles): Goto body before
+ yanking.
+
+ * nnheader.el (nnheader-insert-file-contents-literally): New
+ definition.
+ (nnheader-insert-head): Use new definition.
+
+Sat Sep 7 12:35:37 1996 Kurt Swanson <kurt@dna.lth.se>
+
+ * gnus-salt.el (gnus-pick-elegant-flow): New variable.
+
+Sat Sep 7 12:03:00 1996 Lars Magne Ingebrigtsen <larsi@hymir.ifi.uio.no>
+
+ * nnheader.el (nnheader-insert-head): Don't use
+ `insert-file-contents-literally'.
+ (nnheader-head-chop-length): New variable.
+
+ * gnus-sum.el (gnus-summary-read-document): Prepend "nnvirtual:"
+ to group name.
+
+Sat Sep 7 11:12:26 1996 Lars Magne Ingebrigtsen <larsi@gymir.ifi.uio.no>
+
+ * gnus-score.el (gnus-score-save): Don't check result from
+ gnus-make-directory.
+
+ * gnus-util.el (gnus-make-directory): Return t.
+
+Fri Sep 6 17:55:48 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-range.el (gnus-copy-sequence): Didn't work for all
+ sequences.
+
+Fri Sep 6 14:38:54 1996 Wes Hardaker <Wesley.Hardaker@sphys.unil.ch>
+
+ * gnus-picons.el (gnus-picons-display-as-address): New variable.
+ (gnus-picons-map): New keymap for picons.
+ (gnus-picons-toggle-extent): New function.
+ (gnus-article-display-picons): use them.
+ (gnus-picons-insert-face-if-exists): ditto.
+ (gnus-picons-try-to-find-face): ditto.
+ (gnus-group-display-picons): let display catch up.
+ (gnus-article-display-picons): ditto.
+
+Fri Sep 6 08:11:02 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nnkiboze.el (nnkiboze-close-group): Rewrite.
+ (nnkiboze-request-list, nnkiboze-request-newgroups,
+ nnkiboze-request-list-newsgroups): Removed.
+ (nnkiboze-request-scan): New function.
+ (nnkiboze-directory): New default.
+
+ * gnus-sum.el (gnus-article-read-p): New function.
+
+ * nnkiboze.el (nnkiboze-retrieve-headers): Rewrite.
+ (nnkiboze-open-server): Removed.
+ (nnkiboze-server-opened): Ditto.
+
+ * nnheader.el (nnheader-find-nov-line): Renamed.
+ (nnheader-nov-delete-outside-range): New function.
+
+ * gnus-uu.el (gnus-uu-invert-processable): New command and
+ keystroke.
+
+ * gnus-load.el (gnus-predefined-server-alist): New variable.
+
+ * gnus.el (gnus-server-to-method): Use it.
+ (gnus-read-method): Ditto.
+
+ * gnus-sum.el (t): "M V" commands weren't defined.
+
+ * gnus-cache.el (gnus-summary-insert-cached-articles): New command
+ and keystroke.
+
+ * gnus-score.el (gnus-sort-score-files): New function.
+ (gnus-score-file-rank): New function.
+ (gnus-score-find-bnews): Use it.
+
+ * gnus-topic.el (gnus-topic-mode-map): New sort submap.
+ (gnus-topic-sort-groups, gnus-topic-sort-groups-by-alphabet,
+ gnus-topic-sort-groups-by-unread, gnus-topic-sort-groups-by-level,
+ gnus-topic-sort-groups-by-score, gnus-topic-sort-groups-by-rank,
+ gnus-topic-sort-groups-by-method): New commands and keystrokes.
+
+ * gnus-group.el (gnus-group-sort-selected): New command.
+ (gnus-group-sort-selected-flat): New function.
+ (gnus-group-sort-selected-groups-by-alphabet,
+ gnus-group-sort-selected-groups-by-unread,
+ gnus-group-sort-selected-groups-by-level,
+ gnus-group-sort-selected-groups-by-score,
+ gnus-group-sort-selected-groups-by-rank,
+ gnus-group-sort-selected-groups-by-method): New commands and
+ keystrokes.
+ (gnus-group-make-menu-bar): Updated.
+
+ * gnus-util.el (gnus-make-sort-function): Create a complete
+ function.
+ (gnus-make-sort-function-1): Renamed.
+
+ * gnus-topic.el (gnus-group-sort-topic): New function.
+
+ * gnus-group.el (gnus-group-sort-flat): Made into own function.
+ (gnus-group-sort-alist-function): New variable.
+
+ * nnmail.el (nnmail-split-history): New variable.
+ (nnmail-split-history): New command.
+
+ * gnus-score.el (gnus-score-adaptive): Don't do any work on
+ pseudos.
+
+ * gnus-msg.el (gnus-post-method): Allow easier posting from mail
+ groups.
+
+Thu Sep 5 19:56:41 1996 Lars Magne Ingebrigtsen <larsi@hler.ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.27 is released.
+
Thu Sep 5 19:50:19 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus-xmas.el (gnus-xmas-modeline-glyph): Set string properly.
* gnus-msg.el (gnus-post-method): Do the right thing in
`to-group' groups.
+Fri Sep 6 08:05:53 1996 ISO-2022-JP <morioka@jaist.ac.jp>
+
+ * nnheader.el (nnheader-insert-head): Use
+ nnheader-insert-file-contents-literally.
+
Thu Sep 5 08:29:08 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus-win.el (gnus-always-force-window-configuration): New
"Release SEMAPHORE."
(setcdr (symbol-value semaphore) nil))
+(defmacro gnus-async-with-semaphore (&rest forms)
+ `(unwind-protect
+ (progn
+ (gnus-async-get-semaphore 'gnus-async-article-semaphore)
+ ,@forms)
+ (gnus-async-release-semaphore 'gnus-async-article-semaphore)))
+
+(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
+(put 'gnus-asynch-with-semaphore 'lisp-indent-hook 0)
+(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
+
;;;
;;; Article prefetch
;;;
(defun gnus-async-prefetch-article (group article summary &optional next)
"Possibly prefetch several articles starting with ARTICLE."
(if (not (gnus-buffer-live-p summary))
- (progn
- (gnus-async-get-semaphore 'gnus-async-article-semaphore)
- (setq gnus-async-fetch-list nil)
- (gnus-async-release-semaphore 'gnus-async-article-semaphore))
+ (gnus-async-with-semaphore
+ (setq gnus-async-fetch-list nil))
(when (and gnus-asynchronous
(gnus-alive-p))
(when next
- (gnus-async-get-semaphore 'gnus-async-article-semaphore)
- (pop gnus-async-fetch-list)
- (gnus-async-release-semaphore 'gnus-async-article-semaphore))
+ (gnus-async-with-semaphore
+ (pop gnus-async-fetch-list)))
(let ((do-fetch next))
(when (and (gnus-group-asynchronous-p group)
(gnus-buffer-live-p summary)
(or (not next)
gnus-async-fetch-list))
- (unwind-protect
- (progn
- (gnus-async-get-semaphore 'gnus-async-article-semaphore)
- (unless next
- (setq do-fetch (not gnus-async-fetch-list))
- ;; Nix out any outstanding requests.
- (setq gnus-async-fetch-list nil)
- ;; Fill in the new list.
- (let ((n gnus-use-article-prefetch)
- (data (gnus-data-find-list article))
- d)
- (while (and (setq d (pop data))
- (if (numberp n)
- (natnump (decf n))
- n))
- (unless (or (gnus-async-prefetched-article-entry
- group (setq article (gnus-data-number d)))
- (not (natnump article)))
- ;; Not already fetched -- so we add it to the list.
- (push article gnus-async-fetch-list)))
- (setq gnus-async-fetch-list
- (nreverse gnus-async-fetch-list))))
-
- (when do-fetch
- (setq article (car gnus-async-fetch-list))))
-
- (gnus-async-release-semaphore 'gnus-async-article-semaphore))
+ (gnus-async-with-semaphore
+ (unless next
+ (setq do-fetch (not gnus-async-fetch-list))
+ ;; Nix out any outstanding requests.
+ (setq gnus-async-fetch-list nil)
+ ;; Fill in the new list.
+ (let ((n gnus-use-article-prefetch)
+ (data (gnus-data-find-list article))
+ d)
+ (while (and (setq d (pop data))
+ (if (numberp n)
+ (natnump (decf n))
+ n))
+ (unless (or (gnus-async-prefetched-article-entry
+ group (setq article (gnus-data-number d)))
+ (not (natnump article)))
+ ;; Not already fetched -- so we add it to the list.
+ (push article gnus-async-fetch-list)))
+ (setq gnus-async-fetch-list
+ (nreverse gnus-async-fetch-list))))
+
+ (when do-fetch
+ (setq article (car gnus-async-fetch-list))))
(when (and do-fetch article)
;; We want to fetch some more articles.
(let ((nnheader-callback-function
(gnus-make-async-article-function
group article mark summary next))
- (nntp-server-buffer (get-buffer
- gnus-async-prefetch-article-buffer)))
+ (nntp-server-buffer
+ (get-buffer gnus-async-prefetch-article-buffer)))
(gnus-message 7 "Prefetching article %d in group %s"
article group)
(gnus-request-article article group))))))))))
`(lambda (arg)
(save-excursion
(gnus-async-set-buffer)
- (gnus-async-get-semaphore 'gnus-async-article-semaphore)
- (push (list ',(intern (format "%s-%d" group article))
- ,mark (set-marker (make-marker)
- (point-max))
- ,group ,article)
- gnus-async-article-alist)
- (gnus-async-release-semaphore
- 'gnus-async-article-semaphore)
- (when (gnus-buffer-live-p ,summary)
- (gnus-async-prefetch-article
- ,group ,next ,summary t)))))
+ (gnus-async-with-semaphore
+ (push (list ',(intern (format "%s-%d" group article))
+ ,mark (set-marker (make-marker)
+ (point-max))
+ ,group ,article)
+ gnus-async-article-alist))
+ (if (not (gnus-buffer-live-p ,summary))
+ (gnus-async-with-semaphore
+ (setq gnus-async-fetch-list nil))
+ (gnus-async-prefetch-article ,group ,next ,summary t)))))
(defun gnus-async-request-fetched-article (group article buffer)
"See whether we have ARTICLE from GROUP and put it in BUFFER."
(delete-region (cadr entry) (caddr entry))
(set-marker (cadr entry) nil)
(set-marker (caddr entry) nil)
- (gnus-async-get-semaphore 'gnus-async-article-semaphore)
- (setq gnus-async-article-alist
- (delq entry gnus-async-article-alist))
- (gnus-async-release-semaphore 'gnus-async-article-semaphore))
+ (gnus-async-with-semaphore
+ (setq gnus-async-article-alist
+ (delq entry gnus-async-article-alist))))
(defun gnus-async-prefetch-remove-group (group)
"Remove all articles belonging to GROUP from the prefetch buffer."
"Say whether ARTICLE is cached in the current group."
(memq article gnus-newsgroup-cached))
+(defun gnus-summary-insert-cached-articles ()
+ "Insert all the articles cached for this group into the current buffer."
+ (interactive)
+ (let ((cached gnus-newsgroup-cached))
+ (unless cached
+ (error "No cached articles for this group"))
+ (while cached
+ (gnus-summary-goto-subject (pop cached) t))))
+
;;; Internal functions.
(defun gnus-cache-change-buffer (group)
;;; Internal variables
+(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
+ "Function for sorting the group buffer.")
+
+(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
+ "Function for sorting the selected groups in the group buffer.")
+
(defvar gnus-group-indentation-function nil)
(defvar gnus-goto-missing-group-function nil)
(defvar gnus-group-update-group-function nil)
"r" gnus-group-sort-groups-by-rank
"m" gnus-group-sort-groups-by-method)
+ (gnus-define-keys (gnus-group-sort-map "P" gnus-group-group-map)
+ "s" gnus-group-sort-selected-groups
+ "a" gnus-group-sort-selected-groups-by-alphabet
+ "u" gnus-group-sort-selected-groups-by-unread
+ "l" gnus-group-sort-selected-groups-by-level
+ "v" gnus-group-sort-selected-groups-by-score
+ "r" gnus-group-sort-selected-groups-by-rank
+ "m" gnus-group-sort-selected-groups-by-method)
+
(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
"k" gnus-group-list-killed
"z" gnus-group-list-zombies
["List all groups matching..." gnus-group-list-all-matching t]
["List active file" gnus-group-list-active t])
("Sort"
- ["Default sort" gnus-group-sort-groups
+ ["Default sort" gnus-group-sort-groups t]
+ ["Sort by method" gnus-group-sort-groups-by-method t]
+ ["Sort by rank" gnus-group-sort-groups-by-rank t]
+ ["Sort by score" gnus-group-sort-groups-by-score t]
+ ["Sort by level" gnus-group-sort-groups-by-level t]
+ ["Sort by unread" gnus-group-sort-groups-by-unread t]
+ ["Sort by name" gnus-group-sort-groups-by-alphabet t])
+ ("Sort process/prefixed"
+ ["Default sort" gnus-group-sort-selected-groups
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by method" gnus-group-sort-groups-by-method
+ ["Sort by method" gnus-group-sort-selected-groups-by-method
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by rank" gnus-group-sort-groups-by-rank
+ ["Sort by rank" gnus-group-sort-selected-groups-by-rank
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by score" gnus-group-sort-groups-by-score
+ ["Sort by score" gnus-group-sort-selected-groups-by-score
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by level" gnus-group-sort-groups-by-level
+ ["Sort by level" gnus-group-sort-selected-groups-by-level
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by unread" gnus-group-sort-groups-by-unread
+ ["Sort by unread" gnus-group-sort-selected-groups-by-unread
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by name" gnus-group-sort-groups-by-alphabet
+ ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
("Mark"
["Mark group" gnus-group-mark-group
(defun gnus-group-sort-groups (func &optional reverse)
"Sort the group buffer according to FUNC.
If REVERSE, reverse the sorting order."
- (interactive (list gnus-group-sort-function
- current-prefix-arg))
- (let ((func (cond
- ((not (listp func)) func)
- ((null func) func)
- ((= 1 (length func)) (car func))
- (t `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse func)))))))
- ;; We peel off the dummy group from the alist.
- (when func
- (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
- (pop gnus-newsrc-alist))
- ;; Do the sorting.
- (setq gnus-newsrc-alist
- (sort gnus-newsrc-alist func))
- (when reverse
- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
- ;; Regenerate the hash table.
- (gnus-make-hashtable-from-newsrc-alist)
- (gnus-group-list-groups))))
+ (interactive (list gnus-group-sort-function current-prefix-arg))
+ (funcall gnus-group-sort-alist-function
+ (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups))
+
+(defun gnus-group-sort-flat (func reverse)
+ ;; We peel off the dummy group from the alist.
+ (when func
+ (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
+ (pop gnus-newsrc-alist))
+ ;; Do the sorting.
+ (setq gnus-newsrc-alist
+ (sort gnus-newsrc-alist func))
+ (when reverse
+ (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
+ ;; Regenerate the hash table.
+ (gnus-make-hashtable-from-newsrc-alist)))
(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
"Sort the group buffer alphabetically by group name.
(interactive "P")
(gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
+;;; Selected group sorting.
+
+(defun gnus-group-sort-selected-groups (n func &optional reverse)
+ "Sort the process/prefixed groups."
+ (interactive (list current-prefix-arg gnus-group-sort-function))
+ (let ((groups (gnus-group-process-prefix n)))
+ (funcall gnus-group-sort-selected-function
+ groups (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups)))
+
+(defun gnus-group-sort-selected-flat (groups func reverse)
+ (let (entries infos)
+ ;; First find all the group entries for these groups.
+ (while groups
+ (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb))
+ entries))
+ ;; Then sort the infos.
+ (setq infos
+ (sort
+ (mapcar
+ (lambda (entry) (car entry))
+ (setq entries (nreverse entries)))
+ func))
+ (when reverse
+ (setq infos (nreverse infos)))
+ ;; Go through all the infos and replace the old entries
+ ;; with the new infos.
+ (while infos
+ (setcar entries (pop infos))
+ (pop entries))
+ ;; Update the hashtable.
+ (gnus-make-hashtable-from-newsrc-alist)))
+
+(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse)
+ "Sort the group buffer alphabetically by group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-group-sort-selected-groups-by-unread (&optional reverse)
+ "Sort the group buffer by number of unread articles.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-group-sort-selected-groups-by-level (&optional reverse)
+ "Sort the group buffer by group level.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-group-sort-selected-groups-by-score (&optional reverse)
+ "Sort the group buffer by group score.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-group-sort-selected-groups-by-rank (&optional reverse)
+ "Sort the group buffer by group rank.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-group-sort-selected-groups-by-method (&optional reverse)
+ "Sort the group buffer alphabetically by backend name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse))
+
+;;; Sorting predicates.
+
(defun gnus-group-sort-by-alphabet (info1 info2)
"Sort alphabetically."
(string< (gnus-info-group info1) (gnus-info-group info2)))
(defvar gnus-server-alist nil
"List of available servers.")
+(defvar gnus-predefined-server-alist
+ `(("cache"
+ (nnspool "cache"
+ (nnspool-spool-directory "~/News/cache/")
+ (nnspool-nov-directory "~/News/cache/")
+ (nnspool-active-file "~/News/cache/active"))))
+ "List of predefined (convenience) servers.")
+
(defvar gnus-topic-indentation "") ;; Obsolete variable.
(defconst gnus-article-mark-lists
gnus-cache-enter-remove-article gnus-cached-article-p
gnus-cache-open gnus-cache-close gnus-cache-update-article)
("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
- gnus-cache-remove-article)
+ gnus-cache-remove-article gnus-summary-insert-cached-articles)
("gnus-score" :interactive t
gnus-summary-increase-score gnus-summary-lower-score
gnus-score-flush-cache gnus-score-close
(gnus-summary-select-article nil nil nil article)
(gnus-summary-remove-process-mark article))
(gnus-copy-article-buffer)
+ (message-goto-body)
(let ((message-reply-buffer gnus-article-copy)
(message-reply-headers gnus-current-headers))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles (insert "\n")))
-
(push-mark)
(goto-char beg)))
(cons (or gnus-last-posting-server "") 0))))
method-alist))))
;; Override normal method.
- ((and gnus-post-method
- (or (gnus-method-option-p group-method 'post)
- (gnus-method-option-p group-method 'post-mail)
- (gnus-group-find-parameter group 'to-group)))
+ (gnus-post-method
gnus-post-method)
- ;; Perhaps this is a mail group?
- ((and (not (gnus-member-of-valid 'post group))
- (not (gnus-method-option-p group-method 'post-mail))
- (not (gnus-group-find-parameter group 'to-group)))
- group-method)
;; Use the normal select method.
(t gnus-select-method))))
"Command to convert the x-face header into a xbm file."
)
+(defvar gnus-picons-display-as-address t
+ "*If t display textual email addresses along with pictures.")
+
(defvar gnus-picons-file-suffixes
(when (featurep 'x)
(let ((types (list "xbm")))
"*Whether to move point to first empty line when displaying picons.
This has only an effect if `gnus-picons-display-where' hs value article.")
+(defvar gnus-picons-map (make-sparse-keymap "gnus-picons-keys")
+ "keymap to hide/show picon glpyhs")
+
+(define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent)
+
;;; Internal variables.
(defvar gnus-group-annotations nil)
(defun gnus-article-display-picons ()
"Display faces for an author and his/her domain in gnus-picons-display-where."
(interactive)
+ ;; let drawing catch up
+ (sit-for 0)
(let (from at-idx databases)
(when (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x))
(gnus-picons-remove gnus-article-annotations)
(setq gnus-article-annotations nil)
- (setq databases (append gnus-picons-user-directories
- gnus-picons-domain-directories))
+ ;; look for domain paths.
+ (setq databases gnus-picons-domain-directories)
(while databases
(setq gnus-article-annotations
(nconc (gnus-picons-insert-face-if-exists
(car databases)
addrs
- "unknown")
- (gnus-picons-insert-face-if-exists
- (car databases)
- addrs
- (downcase username) t)
+ "unknown" t)
gnus-article-annotations))
(setq databases (cdr databases)))
+
+ ;; add an '@' if displaying as address
+ (when gnus-picons-display-as-address
+ (setq gnus-article-annotations
+ (nconc gnus-article-annotations
+ (list
+ (make-annotation "@" (point) 'text nil nil nil t)))))
+
+ ;; then do user directories,
+ (let (found)
+ (setq databases gnus-picons-user-directories)
+ (setq username (downcase username))
+ (while databases
+ (setq found
+ (nconc (gnus-picons-insert-face-if-exists
+ (car databases)
+ addrs
+ username)
+ found))
+ (setq databases (cdr databases)))
+ ;; add their name if no face exists
+ (when (and gnus-picons-display-as-address (not found))
+ (setq found
+ (list
+ (make-annotation username (point) 'text nil nil nil t))))
+ (setq gnus-article-annotations
+ (nconc found gnus-article-annotations)))
+
(add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
(defun gnus-group-display-picons ()
"Display icons for the group in the gnus-picons-display-where buffer."
(interactive)
+ ;; let display catch up so far
+ (sit-for 0)
(when (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x)))
(save-excursion
;; 1. MISC/Name
;; The special treatment of MISC doesn't conform with the conventions for
;; picon databases, but otherwise we would always see the MISC/unknown face.
- (let ((bar (and (not nobar-p)
+ (let ((bar (and (not gnus-picons-display-as-address)
+ (not nobar-p)
(annotations-in-region
(point) (min (point-max) (1+ (point)))
(current-buffer))))
(path (concat (file-name-as-directory gnus-picons-database)
database "/"))
- picons found bar-ann)
+ (domainp (and gnus-picons-display-as-address nobar-p))
+ picons found bar-ann cur first)
(if (string-match "/MISC" database)
(setq addrs '("")))
(while (and addrs
(file-accessible-directory-p path))
- (setq path (concat path (pop addrs) "/"))
- (when (setq found
- (gnus-picons-try-suffixes
- (concat path filename "/face.")))
- (when bar
- (setq bar-ann (gnus-picons-try-to-find-face
- (concat gnus-xmas-glyph-directory "bar.xbm")))
- (when bar-ann
- (setq picons (nconc picons bar-ann))
- (setq bar nil)))
- (setq picons (nconc (gnus-picons-try-to-find-face found)
- picons))))
- (nreverse picons)))
+ (setq cur (pop addrs)
+ path (concat path cur "/"))
+ (if (setq found
+ (gnus-picons-try-suffixes (concat path filename "/face.")))
+ (progn
+ (when bar
+ (setq bar-ann (gnus-picons-try-to-find-face
+ (concat gnus-xmas-glyph-directory "bar.xbm")))
+ (when bar-ann
+ (setq picons (nconc picons bar-ann))
+ (setq bar nil)))
+ (setq picons (nconc (when (and domainp first)
+ (list (make-annotation "." (point) 'text
+ 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))
+ picons))))
+ (setq first t))
+ (when (and addrs domainp)
+ (let ((it (mapconcat 'downcase addrs ".")))
+ (make-annotation
+ (if first (concat it ".") it) (point) 'text nil nil nil t)))
+ picons))
(defvar gnus-picons-glyph-alist nil)
-(defun gnus-picons-try-to-find-face (path &optional xface-p)
+(defun gnus-picons-try-to-find-face (path &optional xface-p part)
"If PATH exists, display it as a bitmap. Returns t if succedded."
(let ((glyph (and (not xface-p)
(cdr (assoc path gnus-picons-glyph-alist)))))
(unless xface-p
(push (cons path glyph) gnus-picons-glyph-alist))
(set-glyph-face glyph 'default))
- (nconc
- (list (make-annotation glyph (point) 'text))
- (when (eq major-mode 'gnus-article-mode)
- (list (make-annotation " " (point) 'text)))))))
+ (let ((new (make-annotation glyph (point) 'text nil nil nil t)))
+ (nconc
+ (list new)
+ (when (and (eq major-mode 'gnus-article-mode)
+ (not gnus-picons-display-as-address)
+ (not part))
+ (list (make-annotation " " (point) 'text nil nil nil t)))
+ (when (and part gnus-picons-display-as-address)
+ (let ((txt (make-annotation part (point) 'text nil nil nil t)))
+ (hide-annotation txt)
+ (set-extent-property txt 'its-partner new)
+ (set-extent-property txt 'keymap gnus-picons-map)
+ (set-extent-property txt 'mouse-face gnus-article-mouse-face)
+ (set-extent-property new 'its-partner txt)
+ (set-extent-property new 'keymap gnus-picons-map))))))))
(defun gnus-picons-reverse-domain-path (str)
"a/b/c/d -> d/c/b/a"
(mapconcat 'downcase (nreverse (message-tokenize-header str "/")) "/"))
+(defun gnus-picons-toggle-extent (event)
+ "Toggle picon glyph at given point"
+ (interactive "e")
+ (let* ((ant1 (event-glyph-extent event))
+ (ant2 (extent-property ant1 'its-partner)))
+ (when (and (annotationp ant1) (annotationp ant2))
+ (reveal-annotation ant2)
+ (hide-annotation ant1))))
+
(gnus-add-shutdown 'gnus-picons-close 'gnus)
(defun gnus-picons-close ()
(defun gnus-copy-sequence (list)
"Do a complete, total copy of a list."
- (if (and (consp list) (not (consp (cdr list))))
- (cons (car list) (cdr list))
- (mapcar (lambda (elem) (if (consp elem)
- (if (consp (cdr elem))
- (gnus-copy-sequence elem)
- (cons (car elem) (cdr elem)))
- elem))
- list)))
+ (let (out)
+ (while (consp list)
+ (if (consp (car list))
+ (push (gnus-copy-sequence (pop list)) out)
+ (push (pop list) out)))
+ (if list
+ (nconc (nreverse out) list)
+ (nreverse out))))
(defun gnus-set-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2."
(defvar gnus-mark-unpicked-articles-as-read nil
"*If non-nil, mark all unpicked articles as read.")
+(defvar gnus-pick-elegant-flow t
+ "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked.")
+
(defvar gnus-summary-pick-line-format
"%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
"*The format specification of the lines in pick buffers.
"Start reading the picked articles.
If given a prefix, mark all unpicked articles as read."
(interactive "P")
- (unless gnus-newsgroup-processable
- (error "No articles have been picked"))
- (gnus-summary-limit-to-articles nil)
- (when (or catch-up gnus-mark-unpicked-articles-as-read)
- (gnus-summary-limit-mark-excluded-as-read))
- (gnus-summary-first-unread-article)
- (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
+ (if gnus-newsgroup-processable
+ (progn
+ (gnus-summary-limit-to-articles nil)
+ (when (or catch-up gnus-mark-unpicked-articles-as-read)
+ (gnus-summary-limit-mark-excluded-as-read))
+ (gnus-summary-first-unread-article)
+ (gnus-configure-windows
+ (if gnus-pick-display-summary 'article 'pick) t))
+ (if gnus-pick-elegant-flow
+ (gnus-summary-next-group)
+ (error "No articles have been picked"))))
(defun gnus-pick-article (&optional arg)
"Pick the article on the current line.
(defun gnus-pick-next-page ()
"Go to the next page. If at the end of the buffer, start reading articles."
(interactive)
- (condition-case ()
+ (condition-case nil
(scroll-up)
- (gnus-pick-start-reading)))
+ (end-of-buffer (gnus-pick-start-reading))))
;;;
;;; gnus-binary-mode
entry score file)
(save-excursion
(setq gnus-score-alist nil)
- (nnheader-set-temp-buffer "*Score*")
+ (nnheader-set-temp-buffer " *Gnus Scores*")
(while cache
(current-buffer)
(setq entry (pop cache)
;; This is a normal score file, so we print it very
;; prettily.
(pp score (current-buffer))))
- (if (not (gnus-make-directory (file-name-directory file)))
- (gnus-error 1 "Can't create directory %s"
- (file-name-directory file))
- ;; If the score file is empty, we delete it.
- (if (zerop (buffer-size))
- (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)
- (when gnus-score-after-write-file-function
- (funcall gnus-score-after-write-file-function file)))))
- (and gnus-score-uncacheable-files
- (string-match gnus-score-uncacheable-files file)
- (gnus-score-remove-from-cache file))))
+ (gnus-make-directory (file-name-directory file))
+ ;; If the score file is empty, we delete it.
+ (if (zerop (buffer-size))
+ (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)
+ (when gnus-score-after-write-file-function
+ (funcall gnus-score-after-write-file-function file)))))
+ (and gnus-score-uncacheable-files
+ (string-match gnus-score-uncacheable-files file)
+ (gnus-score-remove-from-cache file)))
(kill-buffer (current-buffer)))))
(defun gnus-score-load-files (score-files)
(set-syntax-table syntab)
;; Go through all articles.
(while (setq d (pop data))
- (when (setq score
- (cdr (assq
- (gnus-data-mark d)
- gnus-default-adaptive-word-score-alist)))
+ (when (and
+ (not (gnus-data-pseudo-p d))
+ (setq score
+ (cdr (assq
+ (gnus-data-mark d)
+ gnus-default-adaptive-word-score-alist))))
;; This article has a mark that should lead to
;; adaptive word rules, so we insert the subject
;; and find all words in that string.
;; file, and not end up in some global score file.
(let ((localscore (gnus-score-file-name group)))
(setq ofiles (cons localscore (delete localscore ofiles))))
- (nreverse ofiles))))
+ (gnus-sort-score-files (nreverse ofiles)))))
(defun gnus-score-find-single (group)
"Return list containing the score file for GROUP."
(setq all (nreverse all)))
(mapcar 'gnus-score-file-name all))))
+(defun gnus-score-file-rank (file)
+ "Return a number that says how specific score FILE is.
+Destroys the current buffer."
+ (when (string-match
+ (concat "^" (regexp-quote
+ (expand-file-name
+ (file-name-as-directory gnus-kill-files-directory))))
+ file)
+ (setq file (substring file (match-end 0))))
+ (insert file)
+ (goto-char (point-min))
+ (let ((beg (point))
+ elems)
+ (while (re-search-forward "[./]" nil t)
+ (push (buffer-substring beg (1- (point)))
+ elems))
+ (erase-buffer)
+ (setq elems (delete "all" elems))
+ (length elems)))
+
+(defun gnus-sort-score-files (files)
+ "Sort FILES so that the most general files come first."
+ (nnheader-temp-write nil
+ (let ((alist
+ (mapcar
+ (lambda (file)
+ (cons (inline (gnus-score-file-rank file)) file))
+ files)))
+ (mapcar
+ (lambda (f) (cdr f))
+ (sort alist (lambda (f1 f2) (< (car f1) (car f2))))))))
+
(defun gnus-score-find-alist (group)
"Return list of score files for GROUP.
The list is determined from the variable gnus-score-file-alist."
"|" gnus-summary-pipe-output
"\M-k" gnus-summary-edit-local-kill
"\M-K" gnus-summary-edit-global-kill
- "V" gnus-version
+ ;; "V" gnus-version
"\C-c\C-d" gnus-summary-describe-group
"q" gnus-summary-exit
"Q" gnus-summary-exit-no-update
"\M-*" gnus-cache-remove-article
"\M-&" gnus-summary-universal-argument
"\C-l" gnus-recenter
- "\M-\C-g" gnus-summary-prepare
"I" gnus-summary-increase-score
"L" gnus-summary-lower-score
"K" gnus-summary-kill-same-subject
"P" gnus-uu-mark-map)
- (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
+ (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
"c" gnus-summary-clear-above
"u" gnus-summary-tick-above
"m" gnus-summary-mark-above
"#" gnus-uu-mark-thread
"\M-#" gnus-uu-unmark-thread)
+ (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
+ "g" gnus-summary-prepare
+ "c" gnus-summary-insert-cached-articles)
+
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
"c" gnus-summary-catchup-and-exit
"C" gnus-summary-catchup-all-and-exit
"Say whether this article is intangible or not."
'(get-text-property (point) 'gnus-intangible))
+(defun gnus-article-read-p (article)
+ "Say whether ARTICLE is read or not."
+ (not (or (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-unreads)
+ (memq article gnus-newsgroup-unselected)
+ (memq article gnus-newsgroup-dormant))))
+
;; Some summary mode macros.
(defmacro gnus-summary-article-number ()
"Sort THREADS."
(if (not gnus-thread-sort-functions)
threads
- (let ((func (if (= 1 (length gnus-thread-sort-functions))
- (car gnus-thread-sort-functions)
- `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse gnus-thread-sort-functions))))))
- (gnus-message 7 "Sorting threads...")
- (prog1
- (sort threads func)
- (gnus-message 7 "Sorting threads...done")))))
+ (gnus-message 7 "Sorting threads...")
+ (prog1
+ (sort threads (gnus-make-sort-function gnus-thread-sort-functions))
+ (gnus-message 7 "Sorting threads...done"))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
(when gnus-article-sort-functions
- (let ((func (if (= 1 (length gnus-article-sort-functions))
- (car gnus-article-sort-functions)
- `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse gnus-article-sort-functions))))))
- (gnus-message 7 "Sorting articles...")
- (prog1
- (setq gnus-newsgroup-headers (sort articles func))
- (gnus-message 7 "Sorting articles...done")))))
+ (gnus-message 7 "Sorting articles...")
+ (prog1
+ (setq gnus-newsgroup-headers
+ (sort articles (gnus-make-sort-function
+ gnus-article-sort-functions)))
+ (gnus-message 7 "Sorting articles...done"))))
;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(defmacro gnus-thread-header (thread)
(error "None of the articles could be interpreted as documents"))
((gnus-group-read-ephemeral-group
(setq vgroup (format
- "%s-%s" gnus-newsgroup-name
+ "nnvirtual:%s-%s" gnus-newsgroup-name
(format-time-string "%Y%m%dT%H%M%S" (current-time))))
`(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
t
(setq gnus-topic-mode-map (make-sparse-keymap))
;; Override certain group mode keys.
- (gnus-define-keys
- gnus-topic-mode-map
- "=" gnus-topic-select-group
- "\r" gnus-topic-select-group
- " " gnus-topic-read-group
- "\C-k" gnus-topic-kill-group
- "\C-y" gnus-topic-yank-group
- "\M-g" gnus-topic-get-new-news-this-topic
- "AT" gnus-topic-list-active
- "Gp" gnus-topic-edit-parameters
- gnus-mouse-2 gnus-mouse-pick-topic)
+ (gnus-define-keys gnus-topic-mode-map
+ "=" gnus-topic-select-group
+ "\r" gnus-topic-select-group
+ " " gnus-topic-read-group
+ "\C-k" gnus-topic-kill-group
+ "\C-y" gnus-topic-yank-group
+ "\M-g" gnus-topic-get-new-news-this-topic
+ "AT" gnus-topic-list-active
+ "Gp" gnus-topic-edit-parameters
+ gnus-mouse-2 gnus-mouse-pick-topic)
;; Define a new submap.
- (gnus-define-keys
- (gnus-group-topic-map "T" gnus-group-mode-map)
- "#" gnus-topic-mark-topic
- "\M-#" gnus-topic-unmark-topic
- "n" gnus-topic-create-topic
- "m" gnus-topic-move-group
- "D" gnus-topic-remove-group
- "c" gnus-topic-copy-group
- "h" gnus-topic-hide-topic
- "s" gnus-topic-show-topic
- "M" gnus-topic-move-matching
- "C" gnus-topic-copy-matching
- "\C-i" gnus-topic-indent
- [tab] gnus-topic-indent
- "r" gnus-topic-rename
- "\177" gnus-topic-delete))
+ (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map)
+ "#" gnus-topic-mark-topic
+ "\M-#" gnus-topic-unmark-topic
+ "n" gnus-topic-create-topic
+ "m" gnus-topic-move-group
+ "D" gnus-topic-remove-group
+ "c" gnus-topic-copy-group
+ "h" gnus-topic-hide-topic
+ "s" gnus-topic-show-topic
+ "M" gnus-topic-move-matching
+ "C" gnus-topic-copy-matching
+ "\C-i" gnus-topic-indent
+ [tab] gnus-topic-indent
+ "r" gnus-topic-rename
+ "\177" gnus-topic-delete)
+
+ (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map)
+ "s" gnus-topic-sort-groups
+ "a" gnus-topic-sort-groups-by-alphabet
+ "u" gnus-topic-sort-groups-by-unread
+ "l" gnus-topic-sort-groups-by-level
+ "v" gnus-topic-sort-groups-by-score
+ "r" gnus-topic-sort-groups-by-rank
+ "m" gnus-topic-sort-groups-by-method))
(defun gnus-topic-make-menu-bar ()
(unless (boundp 'gnus-topic-menu)
'gnus-topic-group-indentation)
(set (make-local-variable 'gnus-group-update-group-function)
'gnus-topic-update-topics-containing-group)
+ (set (make-local-variable 'gnus-group-sort-alist-function)
+ 'gnus-group-sort-topic)
(setq gnus-group-change-level-function 'gnus-topic-change-level)
(setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
(gnus-make-local-hook 'gnus-check-bogus-groups-hook)
gnus-killed-list gnus-zombie-list)
(gnus-group-list-groups 9 nil 1)))
+;;; Topic sorting functions
+
(defun gnus-topic-edit-parameters (group)
"Edit the group parameters of GROUP.
If performed on a topic, edit the topic parameters instead."
`(lambda (form)
(gnus-topic-set-parameters ,topic form)))))))
+(defun gnus-group-sort-topic (func reverse)
+ "Sort groups in the topics according to FUNC and REVERSE."
+ (let ((alist gnus-topic-alist))
+ (while alist
+ (gnus-topic-sort-topic (pop alist) func reverse))))
+
+(defun gnus-topic-sort-topic (topic func reverse)
+ ;; Each topic only lists the name of the group, while
+ ;; the sort predicates expect group infos as inputs.
+ ;; So we first transform the group names into infos,
+ ;; then sort, and then transform back into group names.
+ (setcdr
+ topic
+ (mapcar
+ (lambda (info) (gnus-info-group info))
+ (sort
+ (mapcar
+ (lambda (group) (gnus-get-info group))
+ (cdr topic))
+ func)))
+ ;; Do the reversal, if necessary.
+ (when reverse
+ (setcdr topic (nreverse (cdr topic)))))
+
+(defun gnus-topic-sort-groups (func &optional reverse)
+ "Sort the current topic according to FUNC.
+If REVERSE, reverse the sorting order."
+ (interactive (list gnus-group-sort-function current-prefix-arg))
+ (let ((topic (assoc (gnus-current-topic) gnus-topic-alist)))
+ (gnus-topic-sort-topic
+ topic (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups)))
+
+(defun gnus-topic-sort-groups-by-alphabet (&optional reverse)
+ "Sort the current topic alphabetically by group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-topic-sort-groups-by-unread (&optional reverse)
+ "Sort the current topic by number of unread articles.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-topic-sort-groups-by-level (&optional reverse)
+ "Sort the current topic by group level.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-topic-sort-groups-by-score (&optional reverse)
+ "Sort the current topic by group score.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-topic-sort-groups-by-rank (&optional reverse)
+ "Sort the current topic by group rank.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-topic-sort-groups-by-method (&optional reverse)
+ "Sort the current topic alphabetically by backend name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
+
(provide 'gnus-topic)
;;; gnus-topic.el ends here
gname)))
(defun gnus-make-sort-function (funs)
+ "Return a composite sort condition based on the functions in FUNC."
+ (cond
+ ((not (listp funs)) funs)
+ ((null funs) funs)
+ ((cdr funs)
+ `(lambda (t1 t2)
+ ,(gnus-make-sort-function-1 (nreverse funs))))
+ (t
+ (car funs))))
+
+(defun gnus-make-sort-function-1 (funs)
"Return a composite sort condition based on the functions in FUNC."
(if (cdr funs)
`(or (,(car funs) t1 t2)
(and (not (,(car funs) t2 t1))
- ,(gnus-make-sort-function (cdr funs))))
+ ,(gnus-make-sort-function-1 (cdr funs))))
`(,(car funs) t1 t2)))
(defun gnus-turn-off-edit-menu (type)
(defun gnus-make-directory (directory)
"Make DIRECTORY (and all its parents) if it doesn't exist."
(when (not (file-exists-p directory))
- (make-directory directory t)
- t))
+ (make-directory directory t))
+ t)
(provide 'gnus-util)
;; Keymaps
-(gnus-define-keys
- (gnus-uu-mark-map "P" gnus-summary-mark-map)
- "p" gnus-summary-mark-as-processable
- "u" gnus-summary-unmark-as-processable
- "U" gnus-summary-unmark-all-processable
- "v" gnus-uu-mark-over
- "s" gnus-uu-mark-series
- "r" gnus-uu-mark-region
- "R" gnus-uu-mark-by-regexp
- "t" gnus-uu-mark-thread
- "T" gnus-uu-unmark-thread
- "a" gnus-uu-mark-all
- "b" gnus-uu-mark-buffer
- "S" gnus-uu-mark-sparse
- "k" gnus-summary-kill-process-mark
- "y" gnus-summary-yank-process-mark
- "w" gnus-summary-save-process-mark)
-
-(gnus-define-keys
- (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- ;;"m" gnus-uu-extract-mime
- "u" gnus-uu-decode-uu
- "U" gnus-uu-decode-uu-and-save
- "s" gnus-uu-decode-unshar
- "S" gnus-uu-decode-unshar-and-save
- "o" gnus-uu-decode-save
- "O" gnus-uu-decode-save
- "b" gnus-uu-decode-binhex
- "B" gnus-uu-decode-binhex
- "p" gnus-uu-decode-postscript
- "P" gnus-uu-decode-postscript-and-save)
+(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
+ "p" gnus-summary-mark-as-processable
+ "u" gnus-summary-unmark-as-processable
+ "U" gnus-summary-unmark-all-processable
+ "v" gnus-uu-mark-over
+ "s" gnus-uu-mark-series
+ "r" gnus-uu-mark-region
+ "R" gnus-uu-mark-by-regexp
+ "t" gnus-uu-mark-thread
+ "T" gnus-uu-unmark-thread
+ "a" gnus-uu-mark-all
+ "b" gnus-uu-mark-buffer
+ "S" gnus-uu-mark-sparse
+ "k" gnus-summary-kill-process-mark
+ "y" gnus-summary-yank-process-mark
+ "w" gnus-summary-save-process-mark
+ "i" gnus-uu-invert-processable)
+
+(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
+ ;;"x" gnus-uu-extract-any
+ ;;"m" gnus-uu-extract-mime
+ "u" gnus-uu-decode-uu
+ "U" gnus-uu-decode-uu-and-save
+ "s" gnus-uu-decode-unshar
+ "S" gnus-uu-decode-unshar-and-save
+ "o" gnus-uu-decode-save
+ "O" gnus-uu-decode-save
+ "b" gnus-uu-decode-binhex
+ "B" gnus-uu-decode-binhex
+ "p" gnus-uu-decode-postscript
+ "P" gnus-uu-decode-postscript-and-save)
(gnus-define-keys
(gnus-uu-extract-view-map "v" gnus-uu-extract-map)
(> (gnus-summary-thread-level) level))))
(gnus-summary-position-point))
+(defun gnus-uu-invert-processable ()
+ "Invert the list of process-marked articles."
+ (let ((data gnus-newsgroup-data)
+ d number)
+ (save-excursion
+ (while data
+ (if (memq (setq number (gnus-data-number (pop data)))
+ gnus-newsgroup-processable)
+ (gnus-summary-remove-process-mark number)
+ (gnus-summary-set-process-mark number)))))
+ (gnus-summary-position-point))
+
(defun gnus-uu-mark-over (&optional score)
"Mark all articles with a score over SCORE (the prefix.)"
(interactive "P")
(eval '(run-hooks 'gnus-load-hook))
-(defconst gnus-version-number "0.27"
+(defconst gnus-version-number "0.28"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
(and (equal server "native") gnus-select-method)
;; It should be in the server alist.
(cdr (assoc server gnus-server-alist))
+ ;; It could be in the predefined server alist.
+ (cdr (assoc server gnus-predefined-server-alist))
;; If not, we look through all the opened server
;; to see whether we can find it there.
(let ((opened gnus-opened-servers))
Allow completion over sensible values."
(let ((method
(completing-read
- prompt (append gnus-valid-select-methods gnus-server-alist)
+ prompt (append gnus-valid-select-methods gnus-predefined-server-alist
+ gnus-server-alist)
nil t nil 'gnus-method-history)))
(cond
((equal method "")
;;;###autoload
(defvar message-courtesy-message
- "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
+ "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
"*This is inserted at the start of a mailed copy of a posted message.
+If the string contains the format spec \"%s\", the Newsgroups
+the article has been posted to will be inserted there.
If this variable is nil, no such courtesy message will be added.")
;;;###autoload
(defun message-insert-courtesy-copy ()
"Insert a courtesy message in mail copies of combined messages."
+ (let (newsgroups)
(save-excursion
(save-restriction
(message-narrow-to-headers)
- (let ((newsgroups (message-fetch-field "newsgroups")))
- (when newsgroups
- (goto-char (point-max))
- (insert "Posted-To: " newsgroups "\n"))))
+ (when (setq newsgroups (message-fetch-field "newsgroups"))
+ (goto-char (point-max))
+ (insert "Posted-To: " newsgroups "\n")))
(forward-line 1)
(when message-courtesy-message
- (insert message-courtesy-message))))
+ (cond
+ ((string-match "%s" message-courtesy-message)
+ (insert (format message-courtesy-message newsgroups)))
+ (t
+ (insert message-courtesy-message)))))))
;;;
;;; Setting up a message buffer
(defvar nnheader-max-head-length 4096
"*Max length of the head of articles.")
+(defvar nnheader-head-chop-length 2048
+ "*Length of each read operation when trying to fetch HEAD headers.")
+
(defvar nnheader-file-name-translation-alist nil
"*Alist that says how to translate characters in file names.
For instance, if \":\" is illegal as a file character in file names
(forward-char -1)
(insert "."))
+(defun nnheader-nov-delete-outside-range (beg end)
+ "Delete all NOV lines that lie outside the BEG to END range."
+ ;; First we find the first wanted line.
+ (nnheader-find-nov-line beg)
+ (delete-region (point-min) (point))
+ ;; Then we find the last wanted line.
+ (when (nnheader-find-nov-line end)
+ (forward-line 1))
+ (delete-region (point) (point-max)))
+
+(defun nnheader-find-nov-line (article)
+ "Put point at the NOV line that start with ARTICLE.
+If ARTICLE doesn't exist, put point where that line
+would have been. The function will return non-nil if
+the line could be found."
+ ;; This function basically does a binary search.
+ (let ((max (point-max))
+ (min (goto-char (point-min)))
+ (cur (current-buffer))
+ (prev (point-min))
+ num found)
+ (while (not found)
+ (goto-char (/ (+ max min) 2))
+ (beginning-of-line)
+ (if (or (= (point) prev)
+ (eobp))
+ (setq found t)
+ (setq prev (point))
+ (cond ((> (setq num (read cur)) article)
+ (setq max (point)))
+ ((< num article)
+ (setq min (point)))
+ (t
+ (setq found 'yes)))))
+ ;; Now we may have found the article we're looking for, or we
+ ;; may be somewhere near it.
+ (when (and (not (eq found 'yes))
+ (not (eq num article)))
+ (setq found (point))
+ (while (and (< (point) max)
+ (or (not (numberp num))
+ (< num article)))
+ (forward-line 1)
+ (setq found (point))
+ (or (eobp)
+ (= (setq num (read cur)) article)))
+ (unless (eq num article)
+ (goto-char found)))
+ (beginning-of-line)
+ (eq num article)))
+
;; Various cruft the backends and Gnus need to communicate.
(defvar nntp-server-buffer nil)
(nnheader-insert-file-contents-literally file)
;; Read 1K blocks until we find a separator.
(let ((beg 0)
- format-alist
- (chop 1024))
- (while (and (eq chop (nth 1 (insert-file-contents
- file nil beg (incf beg chop))))
+ format-alist)
+ (while (and (eq nnheader-head-chop-length
+ (nth 1 (nnheader-insert-file-contents-literally
+ file nil beg
+ (incf beg nnheader-head-chop-length))))
(prog1 (not (search-forward "\n\n" nil t))
(goto-char (point-max)))
(or (null nnheader-max-head-length)
(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.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place."
+ (let ((format-alist nil)
+ (after-insert-file-functions nil))
+ (insert-file-contents filename visit beg end replace)))
+
(fset 'nnheader-run-at-time 'run-at-time)
(fset 'nnheader-cancel-timer 'cancel-timer)
(fset 'nnheader-cancel-function-timers 'cancel-function-timers)
(fset 'nnheader-find-file-noselect 'find-file-noselect)
-(fset 'nnheader-insert-file-contents-literally
- 'insert-file-contents-literally)
(when (string-match "XEmacs\\|Lucid" emacs-version)
(require 'nnheaderxm))
(defun nnheader-xmas-cancel-function-timers (function)
)
-;; Written by Erik Naggum <erik@naggum.no>.
-;; Saved by Steve Baur <steve@miranova.com>.
-(defun nnheader-xmas-insert-file-contents-literally (filename &optional visit beg end replace)
- "Like `insert-file-contents', q.v., but only reads in the file.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
- This function ensures that none of these modifications will take place."
- (let ( ; (file-name-handler-alist nil)
- (format-alist nil)
- (after-insert-file-functions nil)
- (find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil)))
- (unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (filename) t))
- (insert-file-contents filename visit beg end replace))
- (if find-buffer-file-type-function
- (fset 'find-buffer-file-type find-buffer-file-type-function)
- (fmakunbound 'find-buffer-file-type)))))
-
(defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
(fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
(fset 'nnheader-cancel-function-timers 'nnheader-xmas-cancel-function-timers)
(fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect)
-(fset 'nnheader-insert-file-contents-literally
- (if (fboundp 'insert-file-contents-literally)
- 'insert-file-contents-literally
- 'nnheader-xmas-insert-file-contents-literally))
(provide 'nnheaderxm)
;;; Commentary:
;; The other access methods (nntp, nnspool, etc) are general news
-;; access methods. This module relies on Gnus and can not be used
+;; access methods. This module relies on Gnus and can't be used
;; separately.
;;; Code:
(eval-when-compile (require 'cl))
(nnoo-declare nnkiboze)
-(defvoo nnkiboze-directory gnus-directory
+(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/")
"nnkiboze will put its files in this directory.")
(defvoo nnkiboze-level 9
- "*The maximum level to be searched for articles.")
+ "The maximum level to be searched for articles.")
(defvoo nnkiboze-remove-read-articles t
- "*If non-nil, nnkiboze will remove read articles from the kiboze group.")
+ "If non-nil, nnkiboze will remove read articles from the kiboze group.")
+
+(defvoo nnkiboze-ephemeral nil
+ "If non-nil, don't store any data anywhere.")
+
+(defvoo nnkiboze-scores nil
+ "Score rules for generating the nnkiboze group.")
+
+(defvoo nnkiboze-regexp nil
+ "Regexp for matching component groups.")
\f
-(defconst nnkiboze-version "nnkiboze 1.0"
- "Version numbers of this version of nnkiboze.")
+(defconst nnkiboze-version "nnkiboze 1.0")
(defvoo nnkiboze-current-group nil)
-(defvoo nnkiboze-current-score-group "")
(defvoo nnkiboze-status-string "")
+(defvoo nnkiboze-headers nil)
+
\f
;;; Interface functions.
(nnoo-define-basics nnkiboze)
+
(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
- (nnkiboze-possibly-change-newsgroups group)
- (if gnus-nov-is-evil
- nil
+ (nnkiboze-possibly-change-group group)
+ (unless gnus-nov-is-evil
(if (stringp (car articles))
'headers
- (let ((first (car articles))
- (last (progn (while (cdr articles) (setq articles (cdr articles)))
- (car articles)))
- (nov (nnkiboze-nov-file-name)))
- (if (file-exists-p nov)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-file-contents nov)
- (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)))
- (while (and (not (eobp)) (>= last (read (current-buffer))))
- (forward-line 1))
- (beginning-of-line)
- (if (not (eobp)) (delete-region (point) (point-max)))
- 'nov))))))
-
-(deffoo nnkiboze-open-server (newsgroups &optional something)
- (gnus-make-directory nnkiboze-directory)
- (nnheader-init-server-buffer))
-
-(deffoo nnkiboze-server-opened (&optional server)
- (and nntp-server-buffer
- (get-buffer nntp-server-buffer)))
+ (let ((nov (nnkiboze-nov-file-name)))
+ (when (file-exists-p nov)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-file-contents nov)
+ (nnheader-nov-delete-outside-range
+ (car articles) (car (last articles)))
+ 'nov))))))
(deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
- (nnkiboze-possibly-change-newsgroups newsgroup)
+ (nnkiboze-possibly-change-group newsgroup)
(if (not (numberp article))
;; This is a real kludge. It might not work at times, but it
;; does no harm I think. The only alternative is to offer no
;; article fetching by message-id at all.
(nntp-request-article article newsgroup gnus-nntp-server buffer)
(let* ((header (gnus-summary-article-header article))
- (xref (mail-header-xref header))
- igroup iarticle)
- (or xref (error "nnkiboze: No xref"))
- (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
- (error "nnkiboze: Malformed xref"))
- (setq igroup (substring xref (match-beginning 1) (match-end 1)))
- (setq iarticle (string-to-int
- (substring xref (match-beginning 2) (match-end 2))))
- (and (gnus-request-group igroup t)
- (gnus-request-article iarticle igroup buffer)))))
+ (xref (mail-header-xref header)))
+ (unless xref
+ (error "nnkiboze: No xref"))
+ (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
+ (error "nnkiboze: Malformed xref"))
+ (gnus-request-article (string-to-int (match-string 2 xref))
+ (match-string 1 xref)
+ buffer))))
+
+(deffoo nnkiboze-request-scan (&optional group server)
+ (nnkiboze-generate-group (concat "nnkiboze:" group)))
(deffoo nnkiboze-request-group (group &optional server dont-check)
"Make GROUP the current newsgroup."
- (nnkiboze-possibly-change-newsgroups group)
+ (nnkiboze-possibly-change-group group)
(if dont-check
- ()
+ t
(let ((nov-file (nnkiboze-nov-file-name))
beg end total)
(save-excursion
(set-buffer nntp-server-buffer)
- (erase-buffer)
(if (not (file-exists-p nov-file))
- (insert (format "211 0 0 0 %s\n" group))
+ (nnheader-report 'nnkiboze "Can't select group %s" group)
(insert-file-contents nov-file)
(if (zerop (buffer-size))
- (insert (format "211 0 0 0 %s\n" group))
+ (nnheader-insert "211 0 0 0 %s\n" group)
(goto-char (point-min))
- (and (looking-at "[0-9]+") (setq beg (read (current-buffer))))
+ (when (looking-at "[0-9]+")
+ (setq beg (read (current-buffer))))
(goto-char (point-max))
- (and (re-search-backward "^[0-9]" nil t)
- (setq end (read (current-buffer))))
+ (when (re-search-backward "^[0-9]" nil t)
+ (setq end (read (current-buffer))))
(setq total (count-lines (point-min) (point-max)))
- (erase-buffer)
- (insert (format "211 %d %d %d %s\n" total beg end group)))))))
- t)
+ (nnheader-insert "211 %d %d %d %s\n" total beg end group)))))))
(deffoo nnkiboze-close-group (group &optional server)
- (nnkiboze-possibly-change-newsgroups group)
+ (nnkiboze-possibly-change-group group)
;; Remove NOV lines of articles that are marked as read.
(when (and (file-exists-p (nnkiboze-nov-file-name))
- nnkiboze-remove-read-articles
- (eq major-mode 'gnus-summary-mode))
- (save-excursion
- (let ((unreads gnus-newsgroup-unreads)
- (unselected gnus-newsgroup-unselected)
- (version-control 'never))
- (set-buffer (get-buffer-create "*nnkiboze work*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (let ((cur (current-buffer))
- article)
- (insert-file-contents (nnkiboze-nov-file-name))
- (goto-char (point-min))
- (while (looking-at "[0-9]+")
- (if (or (memq (setq article (read cur)) unreads)
- (memq article unselected))
- (forward-line 1)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))))
- (write-file (nnkiboze-nov-file-name))
- (kill-buffer (current-buffer)))))
- (setq nnkiboze-current-group nil)))
-
-(deffoo nnkiboze-request-list (&optional server)
- (nnheader-report 'nnkiboze "LIST is not implemented."))
-
-(deffoo nnkiboze-request-newgroups (date &optional server)
- "List new groups."
- (nnheader-report 'nnkiboze "NEWGROUPS is not supported."))
-
-(deffoo nnkiboze-request-list-newsgroups (&optional server)
- (nnheader-report 'nnkiboze "LIST NEWSGROUPS is not implemented."))
+ nnkiboze-remove-read-articles)
+ (nnheader-temp-write (nnkiboze-nov-file-name)
+ (let ((cur (current-buffer)))
+ (insert-file-contents (nnkiboze-nov-file-name))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (not (gnus-article-read-p (read cur)))
+ (forward-line 1)
+ (gnus-delete-line))))))
+ (setq nnkiboze-current-group nil))
+
+(deffoo nnkiboze-open-server (server &optional defs)
+ (unless (assq 'nnkiboze-regexp defs)
+ (push `(nnkiboze-regexp ,server)
+ defs))
+ (nnoo-change-server 'nnkiboze server defs))
(deffoo nnkiboze-request-delete-group (group &optional force server)
- (nnkiboze-possibly-change-newsgroups group)
+ (nnkiboze-possibly-change-group group)
(when force
(let ((files (list (nnkiboze-nov-file-name)
(concat nnkiboze-directory group ".newsrc")
(setq files (cdr files)))))
(setq nnkiboze-current-group nil))
+(nnoo-define-skeleton nnkiboze)
+
\f
;;; Internal functions.
-(defun nnkiboze-possibly-change-newsgroups (group)
+(defun nnkiboze-possibly-change-group (group)
(setq nnkiboze-current-group group))
(defun nnkiboze-prefixed-name (group)
(gnus-expert-user t))
(gnus))
(let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
- (newsrc gnus-newsrc-alist)
- gnus-newsrc-hashtb)
+ (newsrc (cdr gnus-newsrc-alist))
+ gnus-newsrc-hashtb info)
(gnus-make-hashtable-from-newsrc-alist)
;; We have copied all the newsrc alist info over to local copies
;; so that we can mess all we want with these lists.
- (while newsrc
- (if (string-match "nnkiboze" (caar newsrc))
- ;; For each kiboze group, we call this function to generate
- ;; it.
- (nnkiboze-generate-group (caar newsrc)))
- (setq newsrc (cdr newsrc)))))
+ (while (setq info (pop newsrc))
+ (when (string-match "nnkiboze" (gnus-info-group info))
+ ;; For each kiboze group, we call this function to generate
+ ;; it.
+ (nnkiboze-generate-group (gnus-info-group info))))))
(defun nnkiboze-score-file (group)
(list (expand-file-name
(concat (file-name-as-directory gnus-kill-files-directory)
(nnheader-translate-file-chars
- (concat nnkiboze-current-score-group
+ (concat (nnkiboze-prefixed-name nnkiboze-current-group)
"." gnus-score-file-suffix))))))
(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"))
- (regexp (nth 1 (nth 4 info)))
(gnus-expert-user t)
(gnus-large-newsgroup nil)
(version-control 'never)
gnus-visual
method nnkiboze-newsrc nov-buffer gname newsrc active
ginfo lowest glevel)
- (setq nnkiboze-current-score-group group)
(or info (error "No such group: %s" group))
;; Load the kiboze newsrc file for this group.
(and (file-exists-p newsrc-file) (load newsrc-file))
;; kiboze regexp.
(mapatoms
(lambda (group)
- (and (string-match regexp (setq gname (symbol-name group))) ; Match
+ (and (string-match nnkiboze-regexp
+ (setq gname (symbol-name group))) ; Match
(not (assoc gname nnkiboze-newsrc)) ; It isn't registered
(numberp (car (symbol-value group))) ; It is active
(or (> nnkiboze-level 7)
gname gnus-newsrc-hashtb))))
(>= nnkiboze-level glevel)))
(not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
- (setq nnkiboze-newsrc
- (cons (cons gname (1- (car (symbol-value group))))
- nnkiboze-newsrc))))
+ (push (cons gname (1- (car (symbol-value group))))
+ nnkiboze-newsrc)))
gnus-active-hashtb)
;; `newsrc' is set to the list of groups that possibly are
;; component groups to this kiboze group. This list has elements
nov-buffer
(gnus-summary-article-header
(caar gnus-newsgroup-scored))
- (if method
- (gnus-group-prefixed-name gnus-newsgroup-name method)
- gnus-newsgroup-name)))
+ gnus-newsgroup-name))
(setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
;; That's it. We exit this group.
(gnus-summary-exit-no-update)))
(goto-char (point-max))
(let ((xref (mail-header-xref header))
(prefix (gnus-group-real-prefix group))
+ (oheader (copy-sequence header))
(first t)
article)
(if (zerop (forward-line -1))
(setq article (1+ (read (current-buffer))))
(forward-line 1))
(setq article 1))
- (insert (int-to-string article) "\t"
- (or (mail-header-subject header) "") "\t"
- (or (mail-header-from header) "") "\t"
- (or (mail-header-date header) "") "\t"
- (or (mail-header-id header) "") "\t"
- (or (mail-header-references header) "") "\t"
- (int-to-string (or (mail-header-chars header) 0)) "\t"
- (int-to-string (or (mail-header-lines header) 0)) "\t")
- (if (or (not xref) (equal "" xref))
- (insert "Xref: " (system-name) " " group ":"
- (int-to-string (mail-header-number header))
- "\t\n")
- (insert (mail-header-xref header) "\t\n")
- (search-backward "\t" nil t)
- (search-backward "\t" nil t)
- (while (re-search-forward
- "[^ ]+:[0-9]+"
- (save-excursion (end-of-line) (point)) t)
- (if first
- ;; The first xref has to be the group this article
- ;; really came for - this is the article nnkiboze
- ;; will request when it is asked for the article.
- (save-excursion
- (goto-char (match-beginning 0))
- (insert prefix group ":"
- (int-to-string (mail-header-number header)) " ")
- (setq first nil)))
- (save-excursion
- (goto-char (match-beginning 0))
- (insert prefix)))))))
+ (mail-header-set-number oheader article)
+ (nnheader-insert-nov oheader)
+ (search-backward "\t" nil t 2)
+ (forward-char 1)
+ ;; The first Xref has to be the group this article
+ ;; 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)) " ")
+ (while (re-search-forward " [^ ]+:[0-9]+" nil t)
+ (goto-char (1+ (match-beginning 0)))
+ (insert prefix)))))
(defun nnkiboze-nov-file-name ()
(concat (file-name-as-directory nnkiboze-directory)
;;; Internal variables.
+(defvar nnmail-split-history nil
+ "List of group/article elements that say where the previous split put messages.")
+
(defvar nnmail-pop-password nil
"*Password to use when reading mail from a POP server, if required.")
(t
nnmail-treat-duplicates))))
(group-art (nreverse (nnmail-article-group artnum-func))))
+ ;; Let the backend save the article (or not).
(cond
((null group-art)
(delete-region (point-min) (point-max)))
(nnmail-cache-insert message-id)
(funcall func group-art))
((eq action 'delete)
- (delete-region (point-min) (point-max)))
+ (delete-region (point-min) (point-max))
+ (setq group-art nil))
((eq action 'warn)
;; We insert a warning.
(let ((case-fold-search t)
(nnmail-cache-insert newid)
(funcall func group-art)))
(t
- (funcall func group-art)))))
+ (funcall func group-art)))
+ ;; Add the group-art list to the history list.
+ (push group-art nnmail-split-history)))
;;; Get new mail.
(defun nnmail-get-new-mail (method exit-func temp
&optional group spool-func)
"Read new incoming mail."
+ ;; Nix out the previous split history.
+ (setq nnmail-split-history nil)
(let* ((spools (nnmail-get-spool-files group))
(group-in group)
incoming incomings spool)
(cdr elem))))
status " "))
+(defun nnmail-split-history ()
+ "Generate an overview of where the last mail split put articles."
+ (interactive)
+ (unless nnmail-split-history
+ (error "No current split history"))
+ (pop-to-buffer "*nnmail split history*")
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (let ((history nnmail-split-history)
+ elem ga)
+ (while (setq elem (pop history))
+ (insert (mapcar (lambda (ga)
+ (concat (car ga) ":" (int-to-string (cdr ga))))
+ elem
+ ", ")
+ "\n"))
+ (goto-char (point-min))))
+
(run-hooks 'nnmail-load-hook)
(provide 'nnmail)
t ; We want all the headers.
(condition-case ()
(progn
- ;; First we find the first wanted line.
- (nnspool-find-nov-line
+ ;; Delete unwanted NOV lines.
+ (nnheader-nov-delete-outside-range
(if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles)))
- (delete-region (point-min) (point))
- ;; Then we find the last wanted line.
- (if (nnspool-find-nov-line
- (progn (while (cdr articles)
- (setq articles (cdr articles)))
- (car articles)))
- (forward-line 1))
- (delete-region (point) (point-max))
+ (car articles))
+ (car (last articles)))
;; If the buffer is empty, this wasn't very successful.
(unless (zerop (buffer-size))
;; We check what the last article number was.
(nnheader-insert-nov headers)))
(kill-buffer buf))))
-(defun nnspool-find-nov-line (article)
- (let ((max (point-max))
- (min (goto-char (point-min)))
- (cur (current-buffer))
- (prev (point-min))
- num found)
- (while (not found)
- (goto-char (/ (+ max min) 2))
- (beginning-of-line)
- (if (or (= (point) prev)
- (eobp))
- (setq found t)
- (setq prev (point))
- (cond ((> (setq num (read cur)) article)
- (setq max (point)))
- ((< num article)
- (setq min (point)))
- (t
- (setq found 'yes)))))
- ;; Now we may have found the article we're looking for, or we
- ;; may be somewhere near it.
- (when (and (not (eq found 'yes))
- (not (eq num article)))
- (setq found (point))
- (while (and (< (point) max)
- (or (not (numberp num))
- (< num article)))
- (forward-line 1)
- (setq found (point))
- (or (eobp)
- (= (setq num (read cur)) article)))
- (unless (eq num article)
- (goto-char found)))
- (beginning-of-line)
- (eq num article)))
-
(defun nnspool-sift-nov-with-sed (articles file)
(let ((first (car articles))
(last (progn (while (cdr articles) (setq articles (cdr articles)))
(eval (cadr entry))
(funcall (cadr entry)))))))
-(defun nntp-after-change-function (beg end len)
+(defun nntp-after-change-function-callback (beg end len)
(when nntp-process-callback
(save-match-data
(if (and (= beg (point-min))
nntp-process-wait-for wait-for
nntp-process-callback callback
nntp-process-start-point (point-max)
- after-change-functions (list 'nntp-after-change-function)))
+ after-change-functions
+ (list 'nntp-after-change-function-callback)))
t)
(wait-for
(nntp-wait-for process wait-for buffer decode))
(set-marker body nil))))
(defun nnweb-reference-search (search)
- (url-insert-file-contents
- (concat
- (nnweb-definition 'address)
- "?"
- (nnweb-encode-www-form-urlencoded
- `(("search" . "advanced")
- ("querytext" . ,search)
- ("subj" . "")
- ("name" . "")
- ("login" . "")
- ("host" . "")
- ("organization" . "")
- ("groups" . "")
- ("keywords" . "")
- ("choice" . "Search")
- ("startmonth" . "Jul")
- ("startday" . "25")
- ("startyear" . "1996")
- ("endmonth" . "Aug")
- ("endday" . "24")
- ("endyear" . "1996")
- ("mode" . "Quick")
- ("verbosity" . "Verbose")
- ("ranking" . "Relevance")
- ("first" . "1")
- ("last" . "25")
- ("score" . "50"))))))
+ (prog1
+ (url-insert-file-contents
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (nnweb-encode-www-form-urlencoded
+ `(("search" . "advanced")
+ ("querytext" . ,search)
+ ("subj" . "")
+ ("name" . "")
+ ("login" . "")
+ ("host" . "")
+ ("organization" . "")
+ ("groups" . "")
+ ("keywords" . "")
+ ("choice" . "Search")
+ ("startmonth" . "Jul")
+ ("startday" . "25")
+ ("startyear" . "1996")
+ ("endmonth" . "Aug")
+ ("endday" . "24")
+ ("endyear" . "1996")
+ ("mode" . "Quick")
+ ("verbosity" . "Verbose")
+ ("ranking" . "Relevance")
+ ("first" . "1")
+ ("last" . "25")
+ ("score" . "50")))))
+ (setq buffer-file-name nil)))
;;;
;;; Alta Vista
url)
map))
;; See if we want more.
- (when (or (>= i nnweb-max-hits)
+ (when (or (not nnweb-articles)
+ (>= i nnweb-max-hits)
(not (funcall (nnweb-definition 'search)
nnweb-search (incf part))))
(setq more nil)))
(nnweb-remove-markup))))
(defun nnweb-altavista-search (search &optional part)
- (url-insert-file-contents
- (concat
- (nnweb-definition 'address)
- "?"
- (nnweb-encode-www-form-urlencoded
- `(("pg" . "aq")
- ("what" . "news")
- ,@(if part `(("stq" . ,(int-to-string (* part 30)))))
- ("fmt" . "d")
- ("q" . ,search)
- ("r" . "")
- ("d0" . "")
- ("d1" . ""))))))
+ (prog1
+ (url-insert-file-contents
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (nnweb-encode-www-form-urlencoded
+ `(("pg" . "aq")
+ ("what" . "news")
+ ,@(if part `(("stq" . ,(int-to-string (* part 30)))))
+ ("fmt" . "d")
+ ("q" . ,search)
+ ("r" . "")
+ ("d0" . "")
+ ("d1" . "")))))
+ (setq buffer-file-name nil)))
(provide 'nnweb)
+Sat Sep 7 12:14:23 1996 Lars Magne Ingebrigtsen <larsi@hymir.ifi.uio.no>
+
+ * gnus.texi (Various Various): Addition.
+
+Fri Sep 6 07:57:26 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Startup Files): Addition.
+ (Splitting Mail): Addition.
+ (Sorting Groups): Addition.
+ (Topic Sorting): New.
+ (Really Various Summary Commands): Deletia.
+ (Summary Generation Commands): New.
+ (Setting Process Marks): Addition.
+
Thu Sep 5 07:34:27 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Terminology): Addition.
saving the @file{.newsrc.eld} file, and
@code{gnus-save-standard-newsrc-hook} is called just before saving the
@file{.newsrc} file. The latter two are commonly used to turn version
-control on or off. Version control is off by default when saving the
-startup files.
+control on or off. Version control is on by default when saving the
+startup files. If you want to backup creation off, say something like:
+
+@lisp
+(defun turn-off-backup ()
+ (set (make-local-variable 'backup-inhibited) t))
+
+(add-hook 'gnus-save-quick-newsrc-hook 'turn-off-backup)
+(add-hook 'gnus-save-standard-newsrc-hook 'turn-off-backup)
+@end lisp
@vindex gnus-init-file
When Gnus starts, it will read the @code{gnus-site-init-file} (default
When given a prefix, all these commands will sort in reverse order.
+You can also sort a subset of the groups:
+
+@table @kbd
+@item G P a
+@kindex G P a (Group)
+@findex gnus-group-sort-selected-groups-by-alphabet
+Sort the process/prefixed groups in the group buffer alphabetically by
+group name (@code{gnus-group-sort-selected-groups-by-alphabet}).
+
+@item G P u
+@kindex G P u (Group)
+@findex gnus-group-sort-selected-groups-by-unread
+Sort the process/prefixed groups in the group buffer by the number of
+unread articles (@code{gnus-group-sort-selected-groups-by-unread}).
+
+@item G P l
+@kindex G P l (Group)
+@findex gnus-group-sort-selected-groups-by-level
+Sort the process/prefixed groups in the group buffer by group level
+(@code{gnus-group-sort-selected-groups-by-level}).
+
+@item G P v
+@kindex G P v (Group)
+@findex gnus-group-sort-selected-groups-by-score
+Sort the process/prefixed groups in the group buffer by group score
+(@code{gnus-group-sort-selected-groups-by-score}).
+
+@item G P r
+@kindex G P r (Group)
+@findex gnus-group-sort-selected-groups-by-rank
+Sort the process/prefixed groups in the group buffer by group level
+(@code{gnus-group-sort-selected-groups-by-rank}).
+
+@item G P m
+@kindex G P m (Group)
+@findex gnus-group-sort-selected-groups-by-method
+Sort the process/prefixed groups in the group buffer alphabetically by
+backend name (@code{gnus-group-sort-selected-groups-by-method}).
+
+@end table
+
+
@node Group Maintenance
@section Group Maintenance
@menu
* Topic Variables:: How to customize the topics the Lisp Way.
* Topic Commands:: Interactive E-Z commands.
+* Topic Sorting:: Sorting each topic individually.
* Topic Topology:: A map of the world.
* Topic Parameters:: Parameters that apply to all groups in a topic.
@end menu
@end table
+@node Topic Sorting
+@subsection Topic Sorting
+@cindex topic sorting
+
+You can sort the groups in each topic individially with the following
+commands:
+
+
+@table @kbd
+@item T S a
+@kindex T S a (Topic)
+@findex gnus-topic-sort-groups-by-alphabet
+Sort the current topic alphabetically by group name
+(@code{gnus-topic-sort-groups-by-alphabet}).
+
+@item T S u
+@kindex T S u (Topic)
+@findex gnus-topic-sort-groups-by-unread
+Sort the current topic by the number of unread articles
+(@code{gnus-topic-sort-groups-by-unread}).
+
+@item T S l
+@kindex T S l (Topic)
+@findex gnus-topic-sort-groups-by-level
+Sort the current topic by group level
+(@code{gnus-topic-sort-groups-by-level}).
+
+@item T S v
+@kindex T S v (Topic)
+@findex gnus-topic-sort-groups-by-score
+Sort the current topic by group score
+(@code{gnus-topic-sort-groups-by-score}).
+
+@item T S r
+@kindex T S r (Topic)
+@findex gnus-topic-sort-groups-by-rank
+Sort the current topic by group level
+(@code{gnus-topic-sort-groups-by-rank}).
+
+@item T S m
+@kindex T S m (Topic)
+@findex gnus-topic-sort-groups-by-method
+Sort the current topic alphabetically by backend name
+(@code{gnus-topic-sort-groups-by-method}).
+
+@end table
+
+@xref{Sorting Groups} for more information about group sorting.
+
+
@node Topic Topology
@subsection Topic Topology
@cindex topic topology
Remove the process mark from all articles
(@code{gnus-summary-unmark-all-processable}).
+@item M P i
+@kindex M P i (Summary)
+@findex gnus-uu-invert-processable
+Invert the list of process marked articles
+(@code{gnus-uu-invert-processable}).
+
@item M P R
@kindex M P R (Summary)
@findex gnus-uu-mark-by-regexp
@menu
* Summary Group Information:: Information oriented commands.
* Searching for Articles:: Multiple article commands.
+* Summary Generation Commands:: (Re)generating the summary buffer.
* Really Various Summary Commands:: Those pesky non-conformant commands.
@end menu
the process mark (@code{gnus-summary-universal-argument}).
@end table
+@node Summary Generation Commands
+@subsection Summary Generation Commands
+
+@table @kbd
+
+@item Y g
+@kindex Y g (Summary)
+@findex gnus-summary-prepare
+Regenerate the current summary buffer (@code{gnus-summary-prepare}).
+
+@item Y c
+@kindex Y c (Summary)
+@findex gnus-summary-insert-cached-articles
+Pull all cached articles (for the current group) into the summary buffer
+(@code{gnus-summary-insert-cached-articles}).
+
+@end table
+
@node Really Various Summary Commands
@subsection Really Various Summary Commands
Expand the summary buffer window (@code{gnus-summary-expand-window}).
If given a prefix, force an @code{article} window configuration.
-@item M-C-g
-@kindex M-C-g (Summary)
-@findex gnus-summary-prepare
-Regenerate the current summary buffer (@code{gnus-summary-prepare}).
-
@end table
default. Set @code{gnus-show-mime} to @code{t} if you want to use
@sc{mime} all the time. However, if @code{gnus-strict-mime} is
non-@code{nil}, the @sc{mime} method will only be used if there are
-@sc{mime} headers in the article.
+@sc{mime} headers in the article. If you have @code{gnus-show-mime}
+set, then you'll see some unfortunate display glitches in the article
+buffer. These can't be avoided.
It might be best to just use the toggling functions from the summary
buffer to avoid getting nasty surprises. (For instance, you enter the
@code{nnmail-crosspost-link-function} to @code{copy-file}. (This
variable is @code{add-name-to-file} by default.)
+@kindex M-x nnmail-split-history
+@kindex nnmail-split-history
+If you wish to see where the previous mail split put the messages, you
+can use the @kbd{M-x nnmail-split-history} command.
+
Gnus gives you all the opportunity you could possibly want for shooting
yourself in the foot. Let's say you create a group that will contain
all the mail you get from your boss. And then you accidentally
This means that if you have some score entries that you want to apply to
all groups, then you put those entries in the @file{all.SCORE} file.
+The score files are applied in a semi-random order, although Gnus will
+try to apply the more general score files before the more specific score
+files. It does this by looking at the number of elements in the score
+file names---discarding the @samp{all} elements.
+
@item gnus-score-find-hierarchical
@findex gnus-score-find-hierarchical
Apply all score files from all the parent groups. This means that you
but read the entire articles. This makes sense with some versions of
@code{ange-ftp}.
+@item nnheader-head-chop-length
+@vindex nnheader-head-chop-length
+This variable says how big a piece of each article to read when doing
+the operation described above.
+
@item nnheader-file-name-translation-alist
@vindex nnheader-file-name-translation-alist
@cindex file names
@item message-courtesy-message
@vindex message-courtesy-message
When sending combined messages, this string is inserted at the start of
-the mailed copy. If this variable is @code{nil}, no such courtesy
-message will be added.
+the mailed copy. If the string contains the format spec @samp{%s}, the
+newsgroups the article has been posted to will be inserted there. If
+this variable is @code{nil}, no such courtesy message will be added.
+The default value is @samp{"The following message is a courtesy copy of
+an article\nthat has been posted to %s as well.\n\n"}.
@end table
projects / gnus / commitdiff