Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 96a7557d651c525ce9d96e23f6b2b6e12fe8454e 1 parent 5a3eb9c
Lars Ingebrigtsen larsmagne authored
Showing with 8,214 additions and 4,835 deletions.
  1. +603 −0 lisp/ChangeLog
  2. +1 −1  lisp/dgnushack.el
  3. +38 −17 lisp/gnus-cache.el
  4. +73 −10 lisp/gnus-cite.el
  5. +4 −2 lisp/gnus-cus.el
  6. +3 −3 lisp/gnus-demon.el
  7. +1 −1  lisp/gnus-edit.el
  8. +12 −3 lisp/gnus-ems.el
  9. +1 −1  lisp/gnus-kill.el
  10. +1 −1  lisp/gnus-mh.el
  11. +341 −124 lisp/gnus-msg.el
  12. +1 −1  lisp/gnus-nocem.el
  13. +220 −83 lisp/gnus-picon.el
  14. +608 −0 lisp/gnus-salt.el
  15. +157 −95 lisp/gnus-score.el
  16. +5 −4 lisp/gnus-soup.el
  17. +290 −19 lisp/gnus-srvr.el
  18. +201 −71 lisp/gnus-topic.el
  19. +73 −59 lisp/gnus-uu.el
  20. +477 −420 lisp/gnus-vis.el
  21. +1 −1  lisp/gnus-vm.el
  22. +30 −2 lisp/gnus-xmas.el
  23. +3,072 −2,805 lisp/gnus.el
  24. +32 −28 lisp/nnbabyl.el
  25. +1 −1  lisp/nndir.el
  26. +64 −25 lisp/nndoc.el
  27. +7 −3 lisp/nndraft.el
  28. +53 −38 lisp/nneething.el
  29. +39 −12 lisp/nnfolder.el
  30. +199 −194 lisp/nnheader.el
  31. +11 −8 lisp/nnkiboze.el
  32. +105 −66 lisp/nnmail.el
  33. +25 −28 lisp/nnmbox.el
  34. +38 −42 lisp/nnmh.el
  35. +83 −70 lisp/nnml.el
  36. +14 −13 lisp/nnsoup.el
  37. +35 −66 lisp/nnspool.el
  38. +50 −22 lisp/nntp.el
  39. +260 −331 lisp/nnvirtual.el
  40. +83 −0 texi/ChangeLog
  41. +902 −165 texi/gnus.texi
603 lisp/ChangeLog
View
@@ -1,8 +1,611 @@
+Tue Jan 16 21:14:44 1996 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
+
+ * gnus.el (gnus-message-archive-method): Never get new mail.
+
+Tue Jan 16 19:42:21 1996 Ken Raeburn <raeburn@cygnus.com>
+
+ * nnmail.el (nnmail-process-babyl-mail-format): Some movemails do
+ not add an EOOH line.
+
+Tue Jan 16 19:26:31 1996 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
+
+ * nnml.el (nnml-request-article): Would try to retrieve
+ non-qualified path.
+ (nnml-possibly-change-directory): Nix out the file alist.
+
+ * nnheader.el (nnheader-article-to-file-alist): Translated twice.
+
+ * gnus.el (gnus-article-hidden-text-p): New function.
+
+Tue Jan 16 15:20:08 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * nnspool.el (nnspool-retrieve-headers-with-nov): Extra slash in
+ path.
+
+ * gnus-topic.el (gnus-topic-check-topology): Hardcoded "Gnus"
+ topic name.
+
+ * gnus-soup.el (gnus-soup-unique-prefix): Be silent.
+
+ * gnus.el (gnus-summary-insert-pseudos): Put text props instead of
+ adding.
+
+ * gnus-cite.el (gnus-article-hide-citation,
+ gnus-article-hide-citation-maybe): Toggle.
+
+ * gnus.el (gnus-article-show-hidden-text): Also hide.
+ (gnus-article-check-hidden-text): New function.
+ (gnus-article-hide-headers, gnus-article-hide-boring-headers,
+ gnus-article-hide-pgp, gnus-article-hide-signature): Toggle.
+
+Mon Jan 15 14:00:32 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-group-sort-groups): Make composite sort function.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Put the message in its own
+ buffer before archiving.
+
+ * gnus-topic.el (gnus-topic-mode-map): Bugged totally out.
+ (gnus-topic-mode): change-level-function is a function, not a
+ hook.
+ (gnus-topic-yank-group): Yank into the line under point.
+
+ * gnus-score.el (gnus-score-check-syntax): Would always report
+ errors.
+
+Sat Jan 13 00:31:02 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus-salt.el (gnus-possibly-generate-tree): Cut thread before
+ generating.
+
+ * gnus.el (gnus-cut-threads): New function.
+ (gnus-summary-prepare): Use it.
+ (gnus-id-to-header): New function.
+ (gnus-read-header): Use it.
+ (gnus-get-newsgroup-headers): Allow reading new versions of
+ headers.
+ (gnus-get-newsgroup-headers-xover): Ditto.
+
+ * nntp.el (nntp-accept-response): Never hang waiting for process
+ output.
+
+ * gnus.el (gnus-ask-server-for-new-groups): Wouldn't subscribe
+ groups from odd servers.
+
+Fri Jan 12 11:36:07 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * nnfolder.el (nnfolder-possibly-change-group): Create parent
+ dirs.
+
+ * gnus-ems.el: Would remove intangible props under 19.30.
+
+ * nnmail.el (nnmail-expired-article-p): Accept inhibition.
+ (nnmail-save-active): Create the directory if it doesn't exist.
+ (nnmail-procmail-suffix): Changed default.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Report failures.
+
+ * gnus.el (gnus-request-create-group): Accept a method parameter.
+
+ * gnus-msg.el (gnus-tokenize-header): Accept a separator.
+
+ * nnfolder.el (nnfolder-inhibit-expiry): New variable.
+
+ * gnus-msg.el (gnus-message-archive-group): New variable.
+ (gnus-inews-insert-archive-gcc): New function.
+
+ * gnus.el (gnus-message-archive-method): New variable.
+ (gnus-ask-server-for-new-groups): Use it.
+ (gnus-read-active-file): Ditto.
+ (gnus-read-all-descriptions-files): Ditto.
+
+ * nndraft.el (nndraft-request-accept-article): Don't be so
+ chatty.
+
+ * gnus-score.el (gnus-score-default-header): New variable.
+ (gnus-score-default-type): Ditto.
+ (gnus-score-default-duration): Ditto.
+
+ * nnheader.el (nntp-header-number): Removed all `nntp-header-'
+ aliases.
+ (mail-header-number): Rewrote all macros.
+ (nnheader-insert-file-contents-literally): Removed.
+
+ * gnus-score.el (gnus-score-adaptive): Wrap macros.
+
+ * nnheader.el (mail-header-message-id): New alias for
+ `mail-header-id'.
+
+ * gnus.el (gnus-replace-chars-in-string): Removed.
+ (gnus-summary-find-matching): Wrap `mail-header-' macros in
+ lambdas instead of using the Gnus functions.
+ (gnus-header-number): Removed all functional equivalents.
+
+ * nnmail.el: Changed gnus-verbose-backends in all backends.
+
+ * nnspool.el (nnspool-replace-chars-in-string): Removed.
+ (nnspool-number-base-10): Removed.
+
+ * nnheader.el (nnheader-message): New function.
+ (gnus-verbose-backends): Changed default.
+ (nnheader-be-verbose): New function.
+ (nnheader-group-pathname): New function.
+
+ * nnfolder.el (nnfolder-generate-active-file): New command.
+
+ * nnheader.el (nnheader-mail-file-mbox-p): New function.
+ (nnheader-file-to-group): New function.
+
+ * gnus-cache.el (gnus-uncacheable-groups): New default.
+
+Thu Jan 11 22:26:42 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus-salt.el (gnus-pick-display-summary): New variable.
+ (gnus-pick-start-reading): Use it.
+
+Wed Jan 10 19:45:33 1996 Paul Eggert <eggert@twinsun.com>
+
+ * gnus.el (gnus-article-date-ut): Avoid race condition when
+ computing current time and zone.
+ * gnus-msg.el (gnus-inews-date): Likewise.
+
+Thu Jan 11 10:55:34 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus.el (gnus-summary-goto-colon): New function; use horizontal
+ recentering.
+
+ * gnus-salt.el (gnus-generate-tree): Use new recenter function.
+ (gnus-highlight-selected-tree): Ditto.
+
+ * gnus.el (gnus-set-mode-line): Make tree buffer mode line.
+ (gnus-article-goto-next-page): Didn't work all the time.
+ (gnus-article-read-summary-keys): Allow proper paging from the
+ tree buffer.
+ (gnus-horizontal-recenter): New function.
+
+ * gnus-vis.el (gnus-article-add-buttons): New implementation.
+ (gnus-button-alist): New default.
+
+ * gnus.el (gnus-select-article-hook): Changed default.
+ (gnus-summary-display-article): Removed call to
+ `gnus-summary-show-thread'.
+
+ * gnus-vis.el (gnus-article-highlight-headers): New implementation.
+
+ * gnus-soup.el (gnus-soup-write-areas): Be silent.
+ (gnus-soup-write-replies): Ditto.
+
+Wed Jan 10 09:50:39 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus.el (gnus-sort-articles): New function.
+ (gnus-summary-prepare): Use it.
+ (gnus-sort-threads): New implementation.
+ (gnus-sort-articles): Ditto.
+ (gnus-make-sort-function): New function.
+
+ * nnmail.el (nnmail-pre-get-new-mail-hook): New variable.
+ (nnmail-post-get-new-mail-hook): New variable.
+ (nnmail-split-incoming): Do more checking for babyl file format.
+ (nnmail-process-babyl-mail-format): Really remove bogus Message-IDs.
+ (nnmail-process-unix-mail-format): Ditto.
+ (nnmail-process-mmdf-mail-format): Ditto.
+
+ * nndraft.el (nndraft-request-associate-buffer): Clear modtime.
+
+ * gnus-vis.el (gnus-button-marker-list): New variable.
+ (gnus-article-add-buttons): Use it to delete all old markers.
+
+ * nnkiboze.el (nnkiboze-close-group): Don't delete all NOV lines
+ on Gnus startup.
+
+ * gnus.el (gnus-sort-threads): Use `gnus-article-sort-functions'.
+
+ * gnus-score.el (gnus-summary-increase-score): Prompt when
+ matching on References.
+
+ * nnsoup.el (nnsoup-make-active): Clear message.
+
+ * gnus.el (gnus-window-min-width): New variable.
+ (gnus-window-min-height): New variable.
+ (gnus-configure-frame): Use them.
+ (gnus-summary-prepare-exit-hook): Defun instead of defvar.
+ (gnus-summary-exit-hook): Ditto.
+ (gnus-parse-headers-hook): Ditto.
+
+ * gnus-salt.el (gnus-generate-tree-function): New variable.
+ (gnus-tree-edge): New macro.
+
+ * gnus-ems.el: Set a default
+ `nnheader-file-name-translation-alist' based on system-type.
+
+ * gnus-msg.el (gnus-bug): Don't `message' emacs-version.
+
+Tue Jan 09 10:51:22 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * nnvirtual.el (nnvirtual-possibly-change-group): Would choke on
+ exit when using cache.
+
+ * gnus.el (gnus-request-article-this-buffer): Didn't allow reading
+ from virtual groups.
+
+ * gnus-salt.el (gnus-tree-mode): New major mode.
+
+ * gnus.el (gnus-read-init-file): Give better error messages when
+ reading the init file.
+
+ * gnus-srvr.el (gnus-browse-mode): Moved to this file.
+
+ * gnus.el (gnus-summary-display-article): Don't call the visual
+ updating functions twice.
+ (gnus-id-to-article): New function.
+ (gnus-article-displayed-root-p): New function.
+ (gnus-summary-top-thread): New command and keystroke.
+ (gnus-parent-id): Would bug out on empty References.
+ (gnus-add-configuration): Doc fix.
+
+ * gnus-vis.el (gnus-summary-highlight-line-function): New
+ variable.
+ (gnus-summary-highlight-line): Use it.
+
+ * gnus.el (gnus-article-read-summary-keys): Accept parameter to
+ not restore window config.
+
+ * nnspool.el (nnspool-find-id): Condition-case the grep call.
+
+ * gnus.el (gnus-updated-mode-lines): New default.
+
+Mon Jan 08 00:00:32 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus.el (gnus-use-trees): New variable.
+
+ * gnus-salt.el (gnus-binary-mode): New minor mode.
+ (gnus-tree-mode): New major mode.
+
+ * gnus-msg.el (gnus-mail-method): New variable.
+ (gnus-mail-setup): Use it.
+
+ * gnus.el (gnus-build-sparse-threads): New function.
+ (gnus-sparse-mark): New variable.
+ (gnus-build-sparse-threads): New variable.
+ (gnus-summary-read-group): Use the new function.
+ (gnus-cut-thread): New subst.
+ (gnus-cut-thread): Limit fetch-old-headers 'some properly.
+
+ * nnheader.el (make-mail-header): New function.
+
+ * nnml.el (nnml-make-nov-line): Fudge better Message-IDs.
+
+ * nnheader.el (nnheader-narrow-to-headers): Moved the function here.
+
+ * gnus.el (gnus-summary-import-article): Make arpa date.
+
+ * nnheader.el (nnheader-replace-header): New function.
+
+ * gnus.el (gnus-summary-move-article): Move, copy and crosspost in
+ one function.
+ (gnus-summary-copy-article): Just use the move function.
+ (gnus-summary-crosspost-article): New command and keystroke.
+
+Sun Jan 07 06:25:00 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus-score.el (gnus-score-followup): Allow "thread" scoring.
+
+ * nnml.el (nnml-request-article): Allow fetching gzipped articles.
+ (nnml-retrieve-headers): Ditto.
+ (nnmail-article-file-alist): New variable.
+
+ * nnheader.el (nnheader-article-to-file-alist): New function.
+
+ * gnus-demon.el (gnus-demon-time-to-step): Use gnus-encode-date.
+
+ * gnus.el (gnus-encode-date): New function.
+ (gnus-time-minus): New function.
+ (gnus-article-date-ut): Use them.
+ (gnus-seconds-since-epoch): Removed.
+ (gnus-define-keys): New macro.
+ (gnus-define-keys-1): New function.
+
+ * gnus.el: Rewrote all keymaps.
+
+ * gnus-msg.el (gnus-tokenize-header): New function.
+
+ * gnus-cus.el: Hide boring headers by default.
+
+ * gnus-msg.el (gnus-use-followup-to): Changed default.
+ (gnus-check-before-posting): Ditto.
+ (gnus-inews-check-post): Check for totally redirected followups.
+
+ * nnmh.el (nnmh-request-group): Would insert into group buffer.
+
+ * gnus-uu.el (gnus-uu-unmark-by-regexp): New command.
+ (gnus-uu-unmark-region): New command.
+ (gnus-uu-unmark-buffer): New command.
+
+ * gnus-salt.el (gnus-pick-mode): New function.
+ (gnus-pick-start-reading): New command.
+
+ * gnus.el (gnus-summary-mark-excluded-as-read): New command and
+ keystroke.
+
+ * gnus-salt.el: New file.
+
+ * gnus-uu.el (gnus-uu-mark-all): Rewrite.
+
+ * gnus-msg.el (gnus-inews-news): Use new method.
+
+ * nnsoup.el (nnsoup-store-reply): Accept already prepared news.
+
+ * gnus-msg.el (gnus-post-method): Allow a 0 prefix to prompt the
+ user for a post method.
+ (gnus-inews-news): Doc fix.
+
+ * gnus.el (gnus-summary-prepare): Don't try to generate the
+ summary buffer when there are no headers.
+
+Sat Jan 06 15:04:34 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus-vis.el: Inserted all new commands in all menus.
+
+ * gnus-topic.el (gnus-topic-make-menu-bar): New function.
+
+ * gnus-score.el (gnus-score-check-syntax): Do further syntax
+ checking.
+
+ * gnus.el (gnus-configure-frame): Don't bug out on the `nil'
+ buffer.
+
+ * gnus-score.el (gnus-score-update-all-lines): New function.
+ (gnus-summary-rescore): Use it.
+
+ * gnus.el (gnus-simplify-subject-fully): Didn't strip leading Re:
+ if `gnus-summary-gather-subject-limit' was a number.
+ (gnus-short-group-name): Collapse more.
+
+Tue Jan 2 19:22:12 1996 Michael Ernst <mernst@asia.cs.rice.edu>
+
+ * gnus.el (gnus-simplify-subject-ignored-prefixes): new variable.
+ (gnus-simplify-subject): use above to simplify subjects.
+
+Sat Jan 06 14:14:24 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus.el (gnus-strict-mime): Doc fix.
+
+Tue Jan 2 17:27:34 1996 Michael Ernst <mernst@cs.rice.edu>
+
+ * gnus.el (gnus-simplify-subject): Remove more kinds of "Re:"
+ prefixes, and remove multiple prefixes when they exist.
+
+Sat Jan 06 12:55:37 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus.el (gnus-summary-initial-limit): Don't always show groups
+ that have had all articles expunged.
+ (gnus-summary-read-group): Would bug out when deadening buffers.
+ (gnus-summary-exit): Wouldn't update windows when deadening.
+ (gnus-summary-isearch-article): Use proper window config.
+ (gnus-article-remove-trailing-blank-lines): New command and
+ keystroke. Suggested by Michael Ernst <mernst@cs.rice.edu>.
+
+ * gnus-score.el (gnus-score-edit-alist): Make sure the score dir
+ exists.
+ (gnus-score-edit-file): Ditto.
+
+ * nnml.el (nnml-generate-active-info): Could {pre,ap}pend all
+ lines with ".".
+
+Fri Jan 05 02:14:34 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus.el (gnus-summary-insert-pseudos): Add mouse face to
+ pseudos.
+
+ * nnmail.el (nnmail-check-duplication): New function.
+ (nnmail-treat-duplicates): Renamed variable; new values.
+ (nnmail-process-babyl-mail-format): Use it.
+ (nnmail-process-unix-mail-format): Ditto.
+ (nnmail-process-mmdf-mail-format): Ditto.
+
+ * gnus.el (gnus-visible-headers): Changed default.
+
+ * gnus-xmas.el (gnus-xmas-define): Provide a sloppy
+ `encode-time'.
+
+ * nnvirtual.el (nnvirtual-always-rescan): New variable.
+ (nnvirtual-request-group): Use it.
+
+ * nntp.el (nntp-read-server-type): New function.
+ (nntp-server-action-alist): New variable.
+
+ * gnus-cache.el (gnus-cache-possibly-remove-articles): Allow
+ caching in virtual groups.
+
+ * nnvirtual.el (nnvirtual-find-group-art): New function
+ * gnus-cache.el (gnus-cache-possibly-enter-article): Use it.
+
+ * gnus.el (gnus-group-exit): Close the cache instead of open it.
+ (gnus-group-quit): Ditto.
+ (gnus-virtual-group-p): New function.
+ (gnus-mark-xrefs-as-read): Use it.
+ (gnus-select-newsgroup): Allow cache lists to be displayed in
+ virtual groups.
+
+ * gnus-cache.el (gnus-cache-possibly-enter-article): Check for
+ pseudos.
+
+ * nnvirtual.el (nnvirtual-request-update-mark): New function.
+ * gnus.el (gnus-summary-mark-article-as-read): Use it.
+
+ * nntp.el (nntp-request-type): New function.
+
+ * nnspool.el (nnspool-request-type): New function.
+
+ * nnvirtual.el: Complete rewrite. Now much slower.
+
+ * gnus.el (gnus-request-update-info): Changed into a subst.
+ (gnus-get-unread-articles-in-group): Allow updating from the
+ backends here.
+ (gnus-check-group): New function.
+
+ * nnheader.el (nnheader-get-report): New function.
+
+ * gnus.el (gnus-adjust-marked-articles): Would uncompess killed
+ lists.
+
+ * gnus-topic.el (gnus-topic-grok-active-1): New function.
+ (gnus-topic-grok-active): New function.
+ (gnus-group-active-topic-p): New function.
+ (gnus-topic-fold): Use it.
+ (gnus-topic-list-active): New command and keystroke.
+
+ * nneething.el (nneething-exclude-files): Changed default.
+
+ * nnheader.el (nnheader-insert): New function.
+
+Thu Jan 04 01:45:08 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * nndoc.el (nndoc-request-group): Report.
+
+ * nnmbox.el (nnmbox-request-group): Report.
+
+ * nnml.el (nnml-request-group): Report.
+ (nnml-request-article): Report.
+
+ * nnmh.el: Report.
+
+ * nnfolder.el (nnfolder-request-group): Report.
+
+ * nnheader.el (nnheader-report): New function.
+
+ * gnus.el (gnus-sort-gathered-threads): New function.
+ (gnus-summary-prepare): Use it.
+ (gnus-gather-threads-by-subject): Renamed function.
+ (gnus-ids-in-references): New function.
+ (gnus-summary-thread-gathering-function): New variable.
+ (gnus-summary-prepare): Use it.
+ (gnus-summary-gather-threads-by-references): New function.
+
+ * nneething.el (nneething-create-mapping): Add timestamps to
+ mappings.
+
+ * gnus.el (gnus-article-setup-buffer): Also allow several
+ `gnus-original-article-buffer's.
+ (gnus-configure-frame): Allow `frame' in buffer confuguration.
+ (gnus-other-frame): New command.
+ (gnus-build-get-header): Don't mark unread old-fetched headers as
+ read if they are unread.
+ (gnus-article-read-summary-keys): New command.
+ (gnus-article-mode-map): New implementation -- actually works.
+ (gnus-article-goto-next-page): New command.
+ (gnus-article-goto-prev-page): New command.
+ (gnus-summary-rescan-group): New implementation.
+
+ * gnus-msg.el (gnus-mail-send-and-exit): Add `to-list' instead of
+ `to-address'.
+ (gnus-mail-reply): Use `broken-reply-to' group parameter.
+ (gnus-news-followup): Ditto.
+
+ * nnheader.el (nnheader-file-name-translation-alist): New variable.
+ (nnheader-translate-file-chars): New function.
+ * nnkiboze.el (nnkiboze-score-file): Use it.
+ (nnkiboze-nov-file-name): Ditto.
+ * gnus-score.el (gnus-score-file-name): Use it.
+ * gnus.el (gnus-read-save-file-name): Use it.
+
+ * gnus.el (gnus-group-universal-argument): New command and
+ keystroke.
+ (gnus-summary-universal-argument): Rewrite.
+ (gnus-group-unmark-all-groups): New command and keystroke.
+ (gnus-read-save-file-name): If the user types a directory name,
+ append the default file name to the directory.
+ (gnus-summary-insert-subject): Wouldn't allow `P'-ing past an
+ undisplayed canceled article.
+ (gnus-summary-update-article): New function.
+ (gnus-summary-edit-article-done): Use it.
+
+Wed Jan 03 10:42:48 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus.el (gnus-article-hide-header): New function.
+ (gnus-article-hide-boring-headers): New command and keystroke.
+ (gnus-boring-article-headers): New variable.
+
+ * gnus-score.el (gnus-score-expiry-days): Allow nil as a value.
+ (gnus-update-score-entry-dates): New variable.
+ (gnus-score-string): Use it.
+
+ * gnus.el (gnus-summary-limit-to-author): New command and
+ keystroke.
+ (gnus-summary-goto-unread): Allow `never' value.
+ (gnus-summary-next-page): Use it.
+ (gnus-summary-mark-forward): Ditto.
+
+Wed Jan 03 09:58:14 1996 Masaharu Onishi <onishi@nova.co.jp>
+
+ * gnus.el (gnus-parent-id): Didn't return the last Message-ID if
+ the References contained newlines.
+
+Wed Jan 03 03:51:05 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus-msg.el (gnus-inews-modify-mail-mode-map): Typo.
+
+ * nndoc.el (nndoc-guess-type): Look for babyl before forward.
+
+ * nnmail.el (nnmail-crosspost-link-function): New variable.
+ * nnml.el (nnml-save-mail): Use it.
+ * nnmh.el (nnmh-save-mail): Ditto.
+
+ * gnus.el (gnus-group-set-current-level): Would bug out on killed
+ groups.
+
+ * gnus-topic.el (gnus-topic-yank-group): Would yank articles into
+ wrong topics.
+
+ * gnus.el (gnus-summary-exit): Run the exit hook at an earlier
+ point.
+ (gnus-summary-mode-map): "T T" clobbering.
+ (gnus-summary-number-of-articles-in-thread): Wouldn't count
+ adopted threads.
+ (gnus-summary-walk-group-buffer): Respect the gnus-keep-same-level
+ variable.
+
+ * gnus-topic.el (gnus-topic-change-level): New function.
+
+ * gnus.el (gnus-group-change-level-function): New variable.
+
+ * gnus-topic.el (gnus-topic-mode): Toggling the mode off would bug
+ out.
+ (gnus-topic-check-topology): Make sure that the topic-alist does
+ exist.
+
+ * gnus-xmas.el (gnus-xmas-read-event-char): Typo.
+
+ * gnus.el (gnus-summary-mark-article-as-read): Auto-expire ancient
+ articles.
+ (gnus-goto-next-group-when-activating): New variable.
+ (gnus-group-get-new-news-this-group): Use it.
+
+ * nndoc.el (nndoc-transform-clari-briefs): New function.
+ (nndoc-type-alist): Understand ClariNet briefs.
+
+ * gnus.el (gnus-group-read-ephemeral-group): Return whether the
+ group could be entered.
+
+ * gnus-cache.el (gnus-cache-write-active): Would bug out when the
+ cache dir didn't exist.
+
+Tue Jan 02 08:31:45 1996 Lars Magne Ingebrigtsen <larsi@bjob.no>
+
+ * gnus-msg.el (gnus-inews-set-point): New function.
+ (gnus-sendmail-mail-setup): Use it.
+ (gnus-new-news): Ditto.
+
+ * gnus.el (gnus-group-browse-foreign-server): Place point before
+ prompt.
+
Thu Dec 21 02:57:06 1995 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
* gnus.el (gnus-summary-walk-group-buffer): Would skip every other
group.
+ * gnus.el: 0.26 is released.
+
Wed Dec 20 10:18:18 1995 Hideki Ono <ono@tamaru.kuee.kyoto-u.ac.jp>
* gnus.el (gnus-update-marks): Compressed list shouldn't be sort.
2  lisp/dgnushack.el
View
@@ -1,5 +1,5 @@
;;; dgnushack.el --- a hack to set the load path for byte-compiling
-;; Copyright (C) 1994,95 Free Software Foundation, Inc.
+;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Version: 4.19
55 lisp/gnus-cache.el
View
@@ -1,5 +1,5 @@
;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
@@ -41,7 +41,7 @@
(defvar gnus-cache-remove-articles '(read)
"*Classes of articles to remove from the cache.")
-(defvar gnus-uncacheable-groups "^nnvirtual"
+(defvar gnus-uncacheable-groups nil
"*Groups that match this regexp will not be cached.
If you want to avoid caching your nnml groups, you could set this
@@ -56,7 +56,8 @@ variable to \"^nnml\".")
(defvar gnus-cache-active-altered nil)
(eval-and-compile
- (autoload 'nnml-generate-nov-databases-1 "nnml"))
+ (autoload 'nnml-generate-nov-databases-1 "nnml")
+ (autoload 'nnvirtual-find-group-art "nnvirtual"))
@@ -106,11 +107,18 @@ variable to \"^nnml\".")
(defun gnus-cache-possibly-enter-article
(group article headers ticked dormant unread &optional force)
- (when (or force (not (eq gnus-use-cache 'passive)))
+ (when (and (or force (not (eq gnus-use-cache 'passive)))
+ (vectorp headers)) ; This might be a dummy article.
+ ;; If this is a virtual group, we find the real group.
+ (when (gnus-virtual-group-p group)
+ (let ((result (nnvirtual-find-group-art group article)))
+ (setq group (car result)
+ article (cdr result)
+ headers (copy-sequence headers))
+ (aset headers 0 article)))
(let ((number (mail-header-number headers))
file dir)
- (when (and (vectorp headers) ; This might be a dummy article.
- (> number 0) ; Reffed article.
+ (when (and (> number 0) ; Reffed article.
(or (not gnus-uncacheable-groups)
(not (string-match gnus-uncacheable-groups group)))
(or force
@@ -170,11 +178,23 @@ variable to \"^nnml\".")
(defun gnus-cache-enter-remove-article (article)
"Mark ARTICLE for later possible removal."
- (setq gnus-cache-removeable-articles
- (cons article gnus-cache-removeable-articles)))
+ (push article gnus-cache-removeable-articles))
(defun gnus-cache-possibly-remove-articles ()
"Possibly remove some of the removable articles."
+ (if (not (gnus-virtual-group-p gnus-newsgroup-name))
+ (gnus-cache-possibly-remove-articles-1)
+ (let ((arts gnus-cache-removeable-articles)
+ ga)
+ (while arts
+ (setq ga (nnvirtual-find-group-art gnus-newsgroup-name (pop arts)))
+ (let ((gnus-cache-removeable-articles (list (cdr ga)))
+ (gnus-newsgroup-name (car ga)))
+ (gnus-cache-possibly-remove-articles-1))))
+ (setq gnus-cache-removeable-articles nil)))
+
+(defun gnus-cache-possibly-remove-articles-1 ()
+ "Possibly remove some of the removable articles."
(unless (eq gnus-use-cache 'passive)
(let ((articles gnus-cache-removeable-articles)
(cache-articles gnus-newsgroup-cached)
@@ -329,7 +349,7 @@ Returns the list of articles removed."
(let ((group (concat group "")))
(if (string-match ":" group)
(aset group (match-beginning 0) ?/))
- (gnus-replace-chars-in-string group ?. ?/))))
+ (nnheader-replace-chars-in-string group ?. ?/))))
(if (stringp article) article (int-to-string article))))
(defun gnus-cache-possibly-remove-article
@@ -431,16 +451,16 @@ Returns the list of articles removed."
(gnus-cache-enter-articles '(unread))
(gnus-mark-article-hook nil)
(gnus-expert-user t)
+ (nnmail-spool-file nil)
+ (gnus-use-dribble-file nil)
+ (gnus-novice-user nil)
(gnus-large-newsgroup nil))
(while newsrc
- (gnus-summary-read-group (car (car newsrc)))
- (if (not (eq major-mode 'gnus-summary-mode))
- ()
+ (gnus-summary-read-group (car (pop newsrc)) nil t)
+ (when (eq major-mode 'gnus-summary-mode)
(while gnus-newsgroup-unreads
- (gnus-summary-select-article t t nil (car gnus-newsgroup-unreads))
- (setq gnus-newsgroup-unreads (cdr gnus-newsgroup-unreads)))
- (kill-buffer (current-buffer)))
- (setq newsrc (cdr newsrc)))))
+ (gnus-summary-select-article t t nil (pop gnus-newsgroup-unreads)))
+ (kill-buffer (current-buffer))))))
(defun gnus-cache-read-active (&optional force)
"Read the cache active file."
@@ -472,6 +492,7 @@ Returns the list of articles removed."
(symbol-name sym) (cdr (symbol-value sym))
(car (symbol-value sym))))))
gnus-cache-active-hashtb)
+ (gnus-make-directory (file-name-directory gnus-cache-active-file))
(write-region
(point-min) (point-max) gnus-cache-active-file nil 'silent))
;; Mark the active hashtb as unaltered.
@@ -505,7 +526,7 @@ If LOW, update the lower bound instead."
(concat "^" (file-name-as-directory
(expand-file-name gnus-cache-directory)))
(directory-file-name directory))
- (gnus-replace-chars-in-string
+ (nnheader-replace-chars-in-string
(substring (directory-file-name directory) (match-end 0))
?/ ?.)))
nums alphs)
83 lisp/gnus-cite.el
View
@@ -1,5 +1,5 @@
;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: news, mail
@@ -207,12 +207,74 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
skip (gnus-cite-find-prefix number))
(gnus-cite-add-face number skip gnus-cite-attribution-face)))))
-(defun gnus-article-hide-citation (&optional show force)
- "Hide all cited text except attribution lines.
-See the documentation for `gnus-article-highlight-citation'."
+(defun gnus-article-fill-cited-article (&optional force)
+ "Do word wrapping in the current article."
+ (interactive (list t))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (gnus-cite-parse-maybe force)
+ (let ((buffer-read-only nil)
+ (alist gnus-cite-prefix-alist)
+ (inhibit-point-motion-hooks t)
+ prefix numbers number marks
+ (adaptive-fill-mode nil))
+ ;; Loop through citation prefixes.
+ (while alist
+ (setq numbers (pop alist)
+ prefix (pop numbers))
+ (while numbers
+ (setq number (pop numbers))
+ (goto-char (point-min))
+ (forward-line number)
+ (push (cons (point-marker) "") marks)
+ (while (and numbers
+ (= (1- number) (car numbers)))
+ (setq number (pop numbers)))
+ (goto-char (point-min))
+ (forward-line (1- number))
+ (push (cons (point-marker) prefix) marks)))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (push (cons (point-marker) "") marks)
+ (goto-char (point-max))
+ (re-search-backward gnus-signature-separator nil t)
+ (push (cons (point-marker) "") marks)
+ (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2)))))
+ (let* ((omarks marks))
+ (setq marks nil)
+ (while (cdr omarks)
+ (if (= (caar omarks) (caadr omarks))
+ (progn
+ (unless (equal (cdar omarks) "")
+ (push (car omarks) marks))
+ (unless (equal (cdadr omarks) "")
+ (push (cadr omarks) marks))
+ (setq omarks (cdr omarks)))
+ (push (car omarks) marks))
+ (setq omarks (cdr omarks)))
+ (push (car omarks) marks)
+ (setq marks (nreverse marks)))
+ (save-restriction
+ (while (cdr marks)
+ (widen)
+ (narrow-to-region (car (car marks)) (car (cadr marks)))
+ (let ((adaptive-fill-regexp (concat "^" (regexp-quote
+ (cdr (car marks)))
+ " *"))
+ (fill-prefix (cdr (car marks)))
+ )
+ (fill-region (point-min) (point-max)))
+ (set-marker (caar marks) nil)
+ (setq marks (cdr marks)))
+ (set-marker (caar marks) nil)))))
+
+(defun gnus-article-hide-citation (&optional arg force)
+ "Toggle hiding of all cited text except attribution lines.
+See the documentation for `gnus-article-highlight-citation'.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
(interactive (list current-prefix-arg 'force))
- (if show
- (gnus-article-show-hidden-text 'cite)
+ (unless (gnus-article-check-hidden-text 'cite arg)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-cite-parse-maybe force)
@@ -233,16 +295,17 @@ See the documentation for `gnus-article-highlight-citation'."
(nconc (list 'gnus-type 'cite)
gnus-hidden-properties)))))))))
-(defun gnus-article-hide-citation-maybe (&optional show force)
- "Hide cited text that has an attribution line.
+(defun gnus-article-hide-citation-maybe (&optional arg force)
+ "Toggle hiding of cited text that has an attribution line.
+If given a negative prefix, always show; if given a positive prefix,
+always hide.
This will do nothing unless at least `gnus-cite-hide-percentage'
percent and at least `gnus-cite-hide-absolute' lines of the body is
cited text with attributions. When called interactively, these two
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
(interactive (list current-prefix-arg 'force))
- (if show
- (gnus-article-show-hidden-text 'cite)
+ (unless (gnus-article-check-hidden-text 'cite arg)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-cite-parse-maybe force)
6 lisp/gnus-cus.el
View
@@ -1,5 +1,5 @@
;;; gnus-cus.el --- User friendly customization of Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: help, news
@@ -65,6 +65,7 @@ less space and be faster as a result.")
(summary-highlight
article-highlight
summary-menu group-menu article-menu
+ tree-highlight menu highlight
browse-menu server-menu
page-marker))
(name . gnus-visual)
@@ -115,6 +116,7 @@ want.")
(name . gnus-article-display-hook)
(type . list)
(default . (gnus-article-hide-headers-if-wanted
+ gnus-article-hide-boring-headers
gnus-article-treat-overstrike
gnus-article-maybe-highlight))
(data ((type . repeat)
@@ -332,7 +334,7 @@ alone.")
((eq gnus-background-mode 'dark)
(list (list "From" nil
(custom-face-lookup
- "dark blue" nil nil t t nil))
+ "light blue" nil nil t t nil))
(list "Subject" nil
(custom-face-lookup
"pink" nil nil t t nil))
6 lisp/gnus-demon.el
View
@@ -1,5 +1,5 @@
;;; gnus-demon.el --- daemonic Gnus behaviour
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
@@ -130,8 +130,8 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's.")
(string-to-number (aref dv 1))
(string-to-number (aref dv 2)) time
(or (aref dv 4) "UT")))
- (nseconds (- (gnus-seconds-since-epoch tdate)
- (gnus-seconds-since-epoch date))))
+ (nseconds (gnus-time-minus
+ (gnus-encode-date tdate) (gnus-encode-date date))))
(round
(/ (if (< nseconds 0)
(+ nseconds (* 60 60 24))
2  lisp/gnus-edit.el
View
@@ -1,5 +1,5 @@
;;; gnus-edit.el --- Gnus SCORE file editing
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: news, help
15 lisp/gnus-ems.el
View
@@ -1,5 +1,5 @@
;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
@@ -134,8 +134,8 @@ pounce directly on the real variables themselves."))
((string-match "XEmacs\\|Lucid" emacs-version)
(gnus-xmas-define))
- ((and (not (string-match "28.9" emacs-version))
- (not (string-match "29" emacs-version)))
+ ((or (not (boundp 'emacs-minor-version))
+ (< emacs-minor-version 30))
;; Remove the `intangible' prop.
(let ((props (and (boundp 'gnus-hidden-properties)
gnus-hidden-properties)))
@@ -167,6 +167,15 @@ pounce directly on the real variables themselves."))
(or (fboundp 'face-list)
(defun face-list (&rest args))))
+(eval-and-compile
+ (let ((case-fold-search t))
+ (cond
+ ((string-match "windows-nt\\|os/2" (format "%s" system-type))
+ (setq nnheader-file-name-translation-alist
+ (append nnheader-file-name-translation-alist
+ '((?: . ?_)
+ (?+ . ?-))))))))
+
(defun gnus-ems-redefine ()
(cond
((string-match "XEmacs\\|Lucid" emacs-version)
2  lisp/gnus-kill.el
View
@@ -1,5 +1,5 @@
;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
2  lisp/gnus-mh.el
View
@@ -1,5 +1,5 @@
;;; gnus-mh.el --- mh-e interface for Gnus
-;; Copyright (C) 1994,95 Free Software Foundation, Inc.
+;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
465 lisp/gnus-msg.el
View
@@ -1,5 +1,5 @@
;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -30,6 +30,19 @@
(require 'gnus-ems)
(eval-when-compile (require 'cl))
+;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
+(defvar gnus-post-method nil
+ "*Preferred method for posting USENET news.
+If this variable is nil, Gnus will use the current method to decide
+which method to use when posting. If it is non-nil, it will override
+the current method. This method will not be used in mail groups and
+the like, only in \"real\" newsgroups.
+
+The value must be a valid method as discussed in the documentation of
+`gnus-select-method'. It can also be a list of methods. If that is
+the case, the user will be queried for what select method to use when
+posting.")
+
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
@@ -48,11 +61,12 @@ newsgroup name. (In that case, `gnus-signature-file' and
If you want to insert the signature, you might put
`gnus-inews-insert-signature' in this hook.")
-(defvar gnus-use-followup-to t
+(defvar gnus-use-followup-to 'ask
"*Specifies what to do with Followup-To header.
-If nil, ignore the header. If it is t, use its value, but ignore
-`poster'. If it is the symbol `ask', query the user before posting.
-If it is the symbol `use', always use the value.")
+If nil, ignore the header. If it is t, use its value, but ignore
+\"poster\". If it is the symbol `ask', query the user whether to
+ignore the \"poster\" value. If it is the symbol `use', always use
+the value.")
(defvar gnus-followup-to-function nil
"*A variable that contains a function that returns a followup address.
@@ -120,6 +134,14 @@ message in, you can set this variable to a function that checks the
current newsgroup name and then returns a suitable group name (or list
of names).")
+(defvar gnus-message-archive-group
+ '((if (eq major-mode 'news-reply-mode) "misc-news" "misc-mail"))
+ "*Name of the group in which to save the messages you've written.
+This can either be a string, a list of strings; or an alist
+of regexps/functions/forms to be evaluated to return a string (or a list
+of strings). The functions are called with the name of the current
+group (or nil) as a parameter.")
+
(defvar gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
@@ -225,7 +247,7 @@ The function will only be called if you have the `Distribution' header in
(defvar gnus-check-before-posting
'(subject-cmsg multiple-headers sendsys message-id from
long-lines control-chars size new-text
- signature approved sender)
+ redirected-followup signature approved sender)
"In non-nil, Gnus will attempt to run some checks on outgoing posts.
If this variable is t, Gnus will check everything it can. If it is a
list, then those elements in that list will be checked.")
@@ -248,6 +270,11 @@ inserted at the beginning of the mail copy.")
"*This is inserted at the start of a mailed copy of a posted message.
If this variable is nil, no such courtesy message will be added.")
+(defvar gnus-mail-method 'sendmail
+ "*Method to use for composing mail.
+There are three legal values: `sendmail' (which is the default), `mh',
+and `vm'.")
+
(defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail)
"*Function to compose a reply.
Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail);
@@ -290,12 +317,13 @@ headers.")
(defvar gnus-post-news-buffer "*post-news*")
(defvar gnus-mail-buffer "*mail*")
-(defvar gnus-summary-send-map nil)
-(defvar gnus-send-bounce-map nil)
(defvar gnus-article-copy nil)
(defvar gnus-reply-subject nil)
+(defvar gnus-newsgroup-followup nil)
(defvar gnus-add-to-address nil)
(defvar gnus-in-reply-to nil)
+(defvar gnus-last-posting-server nil)
+
(eval-and-compile
(autoload 'gnus-uu-post-news "gnus-uu" nil t)
@@ -308,29 +336,29 @@ headers.")
;;; Gnus Posting Functions
;;;
-(define-prefix-command 'gnus-summary-send-map)
-(define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
-(define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
-(define-key gnus-summary-send-map "f" 'gnus-summary-followup)
-(define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
-(define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply)
-(define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original)
-(define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
-(define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
-(define-key gnus-summary-send-map "r" 'gnus-summary-reply)
-(define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
-(define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
-(define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
-(define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward)
-(define-key gnus-summary-send-map "op" 'gnus-summary-post-forward)
-(define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward)
-(define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward)
-
-(define-prefix-command 'gnus-send-bounce-map)
-(define-key gnus-summary-send-map "D" 'gnus-send-bounce-map)
-(define-key gnus-send-bounce-map "b" 'gnus-summary-resend-bounced-mail)
-(define-key gnus-send-bounce-map "c" 'gnus-summary-send-draft)
-(define-key gnus-send-bounce-map "r" 'gnus-summary-resend-message)
+(gnus-define-keys
+ (gnus-summary-send-map "S" gnus-summary-mode-map)
+ "p" gnus-summary-post-news
+ "f" gnus-summary-followup
+ "F" gnus-summary-followup-with-original
+ "b" gnus-summary-followup-and-reply
+ "B" gnus-summary-followup-and-reply-with-original
+ "c" gnus-summary-cancel-article
+ "s" gnus-summary-supersede-article
+ "r" gnus-summary-reply
+ "R" gnus-summary-reply-with-original
+ "m" gnus-summary-mail-other-window
+ "u" gnus-uu-post-news
+ "om" gnus-summary-mail-forward
+ "op" gnus-summary-post-forward
+ "Om" gnus-uu-digest-mail-forward
+ "Op" gnus-uu-digest-post-forward)
+
+(gnus-define-keys
+ (gnus-send-bounce-map "D" gnus-summary-send-map)
+ "b" gnus-summary-resend-bounced-mail
+ "c" gnus-summary-send-draft
+ "r" gnus-summary-resend-message)
;;; Internal functions.
@@ -451,7 +479,7 @@ header line with the old Message-ID."
(gnus-new-news gnus-newsgroup-name t)
(erase-buffer)
(insert-buffer-substring gnus-original-article-buffer)
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
;; Remove unwanted headers.
(when gnus-delete-supersedes-headers
(nnheader-remove-header gnus-delete-supersedes-headers t))
@@ -526,6 +554,71 @@ Type \\[describe-mode] in the buffer to get a list of commands."
(setq gnus-add-to-address group)))
(gnus-mail-reply yank to-address 'followup)))))
+(defun gnus-post-method (group query-method &optional silent)
+ "Return the posting method based on GROUP and query-method.
+If SILENT, don't prompt the user."
+ (let ((group-method (if (stringp group)
+ (gnus-find-method-for-group group)
+ group)))
+ (cond
+ ;; If the group-method is nil (which shouldn't happen) we use
+ ;; the default method.
+ ((null group-method)
+ gnus-select-method)
+ ;; We want this group's method.
+ ((and query-method (not (eq query-method 0)))
+ group-method)
+ ;; We query the user for a post method.
+ ((or query-method
+ (and gnus-post-method
+ (listp (car gnus-post-method))))
+ (let* ((methods
+ ;; Collect all methods we know about.
+ (append
+ (when gnus-post-method
+ (if (listp (car gnus-post-method))
+ gnus-post-method
+ (listp gnus-post-method)))
+ gnus-secondary-select-methods
+ (list gnus-select-method)
+ (list group-method)))
+ method-alist post-methods method)
+ ;; Weed out all mail methods.
+ (while methods
+ (setq method (gnus-server-get-method "" (pop methods)))
+ (when (or (gnus-method-option-p method 'post)
+ (gnus-method-option-p method 'post-mail))
+ (push method post-methods)))
+ ;; Create a name-method alist.
+ (setq method-alist
+ (mapcar
+ (lambda (m)
+ (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
+ post-methods))
+ ;; Query the user.
+ (cadr
+ (assoc
+ (setq gnus-last-posting-server
+ (if (and silent
+ gnus-last-posting-server)
+ ;; Just use the last value.
+ gnus-last-posting-server
+ (completing-read
+ "Posting method: " method-alist nil t
+ (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-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)))
+ group-method)
+ ;; Use the normal select method.
+ (t gnus-select-method))))
+
(defun gnus-news-group-p (group &optional article)
"Return non-nil if GROUP (and ARTICLE) come from a news server."
(or (gnus-member-of-valid 'post group) ; Ordinary news group.
@@ -534,8 +627,12 @@ Type \\[describe-mode] in the buffer to get a list of commands."
(defun gnus-inews-news (&optional use-group-method)
"Send a news message.
-If given a prefix, and the group is a foreign group, this function
-will attempt to use the foreign server to post the article."
+
+If given a non-zero prefix and the group is a foreign group, this
+function will attempt to use the foreign server to post the article.
+
+If given an zero prefix, the user will be prompted for a posting
+method to use."
(interactive "P")
(or gnus-current-select-method
(setq gnus-current-select-method gnus-select-method))
@@ -551,26 +648,26 @@ will attempt to use the foreign server to post the article."
;; Send to server.
(gnus-message 5 "Posting to USENET...")
(setq post-result (funcall gnus-inews-article-function use-group-method))
- (cond ((eq post-result 'illegal)
- (setq error t)
- (ding))
- (post-result
- (gnus-message 5 "Posting to USENET...done")
- (if (gnus-buffer-exists-p (car-safe reply))
- (progn
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-article-as-replied
- (cdr reply)))))
- (set-buffer-modified-p nil))
- (t
- ;; We cannot signal an error.
- (setq error t)
- (ding)
- (gnus-message
- 1 "Article rejected: %s"
- (gnus-status-message
- (gnus-post-method gnus-newsgroup-name use-group-method))))))
+ (cond
+ ((eq post-result 'illegal)
+ (setq error t)
+ (ding))
+ (post-result
+ (gnus-message 5 "Posting to USENET...done")
+ (set-buffer-modified-p nil)
+ ;; We mark the article as replied.
+ (when (gnus-buffer-exists-p (car-safe reply))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-mark-article-as-replied (cdr reply)))))
+ (t
+ ;; We cannot signal an error.
+ (setq error t)
+ (ding)
+ (gnus-message
+ 1 "Article rejected: %s"
+ (gnus-status-message
+ (gnus-post-method gnus-newsgroup-name use-group-method t))))))
(let ((conf gnus-prev-winconf))
(unless error
@@ -585,7 +682,8 @@ will attempt to use the foreign server to post the article."
(or (and (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(match-beginning 0))
- (point-max))))
+ (point-max)))
+ (goto-char (point-min)))
(defun gnus-inews-send-mail-copy ()
;; Mail the message if To, Bcc or Cc exists.
@@ -666,7 +764,7 @@ will attempt to use the foreign server to post the article."
(save-excursion
(save-restriction
(let ((case-fold-search t))
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
(while (re-search-forward "^X-\\(to\\|[bcf]cc\\|cc\\):" nil t)
(beginning-of-line)
(delete-char 2))
@@ -741,6 +839,24 @@ called."
(gnus-y-or-n-p
"The article contains an Approved header. Really post? ")
t)))
+ ;; Check whether a Followup-To has redirected the newsgroup.
+ (or
+ (gnus-check-before-posting 'redirected-followup)
+ (not gnus-newsgroup-followup)
+ (save-excursion
+ (let ((followups (gnus-tokenize-header
+ (mail-fetch-field "Newsgroups")))
+ (newsgroups (gnus-tokenize-header
+ (car gnus-newsgroup-followup)))
+ shared)
+ (while (and followups
+ (not (member followups newsgroups)))
+ (setq followups (cdr followups)))
+ (if followups
+ t
+ (gnus-y-or-n-p
+ "Followup redirected from original newsgroups. Really post? "
+ )))))
;; Check the Message-ID header.
(or (gnus-check-before-posting 'message-id)
(save-excursion
@@ -754,32 +870,33 @@ called."
"The Message-ID looks strange: \"%s\". Really post? "
message-id))))))
;; Check the From header.
- (or (gnus-check-before-posting 'from)
- (save-excursion
- (let* ((case-fold-search t)
- (from (mail-fetch-field "from")))
- (cond
- ((not from)
- (gnus-y-or-n-p "There is no From line. Really post? "))
- ((not (string-match "@[^\\.]*\\." from))
- (gnus-y-or-n-p
- (format
- "The address looks strange: \"%s\". Really post? " from)))
- ((string-match "(.*).*(.*)" from)
+ (or
+ (gnus-check-before-posting 'from)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (from (mail-fetch-field "from")))
+ (cond
+ ((not from)
+ (gnus-y-or-n-p "There is no From line. Really post? "))
+ ((not (string-match "@[^\\.]*\\." from))
+ (gnus-y-or-n-p
+ (format
+ "The address looks strange: \"%s\". Really post? " from)))
+ ((string-match "(.*).*(.*)" from)
+ (gnus-y-or-n-p
+ (format
+ "The From header looks strange: \"%s\". Really post? "
+ from)))
+ ((string-match "<[^>]+> *$" from)
+ (let ((name (substring from 0 (match-beginning 0))))
+ (or
+ (string-match "^ *\"[^\"]*\" *$" name)
+ (not (string-match "[][.!()<>@,;:\\]" name))
(gnus-y-or-n-p
(format
- "The From header looks strange: \"%s\". Really post? "
- from)))
- ((string-match "<[^>]+> *$" from)
- (let ((name (substring from 0 (match-beginning 0))))
- (or
- (string-match "^ *\"[^\"]*\" *$" name)
- (not (string-match "[][.!()<>@,;:\\]" name))
- (gnus-y-or-n-p
- (format
- "The From header name has bogus characters. Really post? "
- from)))))
- (t t)))))
+ "The From header name has bogus characters. Really post? "
+ from)))))
+ (t t)))))
)))
;; Check for long lines.
(or (gnus-check-before-posting 'long-lines)
@@ -833,6 +950,21 @@ called."
(count-lines (point) (point-max))))
t)))))))
+(defun gnus-tokenize-header (header &optional separator)
+ "Split HEADER into a list of header elements.
+\",\" is used as the separator."
+ (let* ((beg 0)
+ (separator (or separator ","))
+ (regexp
+ (format "[ \t]*\\([^%s]+\\)?\\(%s\\|\\'\\)" separator separator))
+ elems)
+ (while (and (string-match regexp header beg)
+ (< beg (length header)))
+ (when (match-beginning 1)
+ (push (match-string 1 header) elems))
+ (setq beg (match-end 0)))
+ (nreverse elems)))
+
(defun gnus-article-checksum ()
(let ((sum 0))
(save-excursion
@@ -986,8 +1118,8 @@ called."
;; Copy the article over to some group, possibly.
(and gcc (gnus-inews-do-gcc gcc))
;; Post the article.
- (let ((method (gnus-post-method gnus-newsgroup-name use-group-method)))
- (setq result (gnus-request-post method)))
+ (setq result (gnus-request-post
+ (gnus-post-method gnus-newsgroup-name use-group-method)))
(kill-buffer (current-buffer)))
(run-hooks 'gnus-message-sent-hook)
;; If the posting was unsuccessful (that it, it was rejected) we
@@ -1297,7 +1429,7 @@ a program specified by the rest of the value."
list file)
(save-excursion
(save-restriction
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
(while (setq file (mail-fetch-field "fcc"))
(push file list)
(nnheader-remove-header "fcc" nil t))
@@ -1463,8 +1595,9 @@ domain is undefined, the domain name is got from it."
(defun gnus-inews-date ()
"Current time string."
- (timezone-make-date-arpa-standard
- (current-time-string) (current-time-zone)))
+ (let ((now (current-time)))
+ (timezone-make-date-arpa-standard
+ (current-time-string now) (current-time-zone now))))
(defun gnus-inews-organization ()
"Return user's organization.
@@ -1634,6 +1767,7 @@ mailer."
(erase-buffer)
(gnus-mail-setup 'new to subject)
(gnus-inews-insert-gcc)
+ (gnus-inews-insert-archive-gcc)
(run-hooks 'gnus-mail-hook)))
(defun gnus-mail-reply (&optional yank to-address followup)
@@ -1657,7 +1791,7 @@ mailer."
(gnus-copy-article-buffer)
(save-restriction
(set-buffer gnus-article-copy)
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
(if (not followup)
;; This is a regular reply.
(if (gnus-functionp gnus-reply-to-function)
@@ -1681,7 +1815,9 @@ mailer."
(setq to (mail-fetch-field "to"))
(setq cc (mail-fetch-field "cc"))
(setq mct (mail-fetch-field "mail-copies-to"))
- (setq reply-to (mail-fetch-field "reply-to"))
+ (setq reply-to
+ (unless (gnus-group-get-parameter group 'broken-reply-to)
+ (mail-fetch-field "reply-to")))
(setq references (mail-fetch-field "references"))
(setq message-id (mail-fetch-field "message-id"))
@@ -1746,6 +1882,7 @@ mailer."
(auto-save-mode auto-save-default)
(gnus-inews-insert-gcc)
+ (gnus-inews-insert-archive-gcc)
(if (and follow-to (listp follow-to))
(progn
@@ -1833,15 +1970,13 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(gnus-inews-insert-bfcc)
(gnus-inews-insert-gcc)
+ (gnus-inews-insert-archive-gcc)
(gnus-inews-insert-signature)
(and gnus-post-prepare-function
(gnus-functionp gnus-post-prepare-function)
(funcall gnus-post-prepare-function group))
- (goto-char (point-min))
- (if group
- (re-search-forward "^Subject: " nil t)
- (re-search-forward "^Newsgroups: " nil t))
(run-hooks 'gnus-post-prepare-hook)
+ (gnus-inews-set-point)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
(gnus-inews-modify-mail-mode-map)
@@ -1875,7 +2010,7 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(gnus-copy-article-buffer)
(save-restriction
(set-buffer gnus-article-copy)
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
(if (gnus-functionp gnus-followup-to-function)
(save-excursion
(setq follow-to
@@ -1935,6 +2070,10 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(setq gnus-reply-subject (mail-header-subject gnus-current-headers))
(make-local-variable 'gnus-in-reply-to)
(setq gnus-in-reply-to message-of)
+ (when (and followup-to newsgroups)
+ (make-local-variable 'gnus-newsgroup-followup)
+ (setq gnus-newsgroup-followup
+ (cons newsgroups followup-to)))
(gnus-inews-insert-signature)
@@ -1973,7 +2112,9 @@ If INHIBIT-PROMPT, never prompt for a Subject."
gnus-auto-mail-to-author)
(or (save-excursion
(set-buffer gnus-article-copy)
- (gnus-fetch-field "reply-to"))
+ (unless (gnus-group-get-parameter
+ group 'broken-reply-to)
+ (gnus-fetch-field "reply-to")))
from)))
(x-mail (save-excursion
(set-buffer gnus-article-copy)
@@ -1996,7 +2137,8 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(gnus-inews-insert-bfcc)
(gnus-inews-insert-gcc)
-
+ (gnus-inews-insert-archive-gcc)
+
;; Now the headers should be ok, so we do the yanking.
(goto-char (point-min))
(re-search-forward
@@ -2033,20 +2175,18 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(make-local-variable 'gnus-article-check-size)
(setq gnus-article-check-size
- (cons (buffer-size) (gnus-article-checksum))))))))
+ (cons (buffer-size) (gnus-article-checksum)))
+ (gnus-inews-set-point))))))
(defun gnus-message-of (from date)
- "Take a FROM and a DATE and create an IN-REPLY-TO."
- (cond
- ((not from)
- nil)
- (t
+ "Take a FROM and a DATE and return an IN-REPLY-TO."
+ (when from
(let ((stop-pos
(string-match " *at \\| *@ \\| *(\\| *<" from)))
(concat (if stop-pos (substring from 0 stop-pos) from)
"'s message of "
(if (or (not date) (string= date ""))
- "(unknown date)" date))))))
+ "(unknown date)" date)))))
(defun gnus-mail-yank-original ()
(interactive)
@@ -2067,11 +2207,11 @@ If INHIBIT-PROMPT, never prompt for a Subject."
(let ((buffer-file-name nil))
(or dont-send (gnus-mail-send)))
(bury-buffer)
- ;; This mail group doesn't have a `to-address', so we add one
+ ;; This mail group doesn't have a `to-list', so we add one
;; here. Magic!
(and to-address
(gnus-group-add-parameter
- address-group (cons 'to-address to-address)))
+ address-group (cons 'to-list to-address)))
(if (get-buffer gnus-group-buffer)
(progn
(if (gnus-buffer-exists-p (car-safe reply))
@@ -2234,7 +2374,9 @@ If YANK is non-nil, include the original article."
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
- (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
+ (insert (gnus-version) "\n")
+ (emacs-version t)
+ (insert "\n\n\n\n\n")
(gnus-debug)
(goto-char (point-min))
(search-forward "Subject: " nil t)
@@ -2337,7 +2479,7 @@ this is a reply."
(let (references)
(save-excursion
(save-restriction
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
(nnheader-remove-header gnus-bounced-headers-junk t)
(setq references (mail-fetch-field "references"))
(goto-char (point-max))
@@ -2374,7 +2516,7 @@ Headers will be generated before sending."
;; Run final inews hooks. This hook may do FCC.
(run-hooks 'gnus-inews-article-hook)
(gnus-inews-do-gcc)
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
(nnheader-remove-header "^[gf]cc:" t)
(widen)
(goto-char (point-min))
@@ -2388,7 +2530,7 @@ Headers will be generated before sending."
(use-local-map (copy-keymap (current-local-map)))
(local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
(local-set-key "\C-c\C-p" 'gnus-put-message)
- (local-set-key "\C-c\C-d" 'gnus-put-draft-group))
+ (local-set-key "\C-c\C-d" 'gnus-put-in-draft-group))
(defun gnus-mail-setup (type &optional to subject in-reply-to cc
replybuffer actions)
@@ -2397,6 +2539,7 @@ Headers will be generated before sending."
(funcall
(cond
((or
+ (eq gnus-mail-method 'mh)
(and (or (eq type 'reply) (eq type 'followup))
(eq gnus-mail-reply-method 'gnus-mail-reply-using-mhe))
(and (eq type 'forward)
@@ -2406,6 +2549,7 @@ Headers will be generated before sending."
'gnus-mail-other-window-using-mhe)))
'gnus-mh-mail-setup)
((or
+ (eq gnus-mail-method 'vm)
(and (or (eq type 'reply) (eq type 'followup))
(eq gnus-mail-reply-method 'gnus-mail-reply-using-vm))
(and (eq type 'forward)
@@ -2422,11 +2566,7 @@ Headers will be generated before sending."
(defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions)
(mail-mode)
(mail-setup to subject nil cc replybuffer actions)
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (forward-line 1)
- (goto-char (point-max)))
+ (gnus-inews-set-point)
(gnus-inews-modify-mail-mode-map))
;;; Gcc handling.
@@ -2435,21 +2575,38 @@ Headers will be generated before sending."
(defun gnus-inews-do-gcc (&optional gcc)
(save-excursion
(save-restriction
- (gnus-narrow-to-headers)
+ (nnheader-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- end)
- (if (not gcc)
- () ; Nothing to be done.
+ (cur (current-buffer))
+ end groups group method)
+ (when gcc
(nnheader-remove-header "gcc")
+ (widen)
+ (setq groups (gnus-tokenize-header gcc " "))
;; Copy the article over to some group(s).
- (while (string-match
- "^[ \t]*\\([^ \t]+\\)\\([ \t]+\\|$\\)" gcc)
- (setq end (match-end 0))
- (condition-case ()
- (gnus-request-accept-article
- (substring gcc (match-beginning 1) (match-end 1)) t)
- (error nil))
- (setq gcc (substring gcc end))))))))
+ (while (setq group (pop groups))
+ (gnus-check-server
+ (setq method
+ (cond ((and (null (gnus-get-info group))
+ (eq (car gnus-message-archive-method)
+ (car (gnus-group-method-name group))))
+ ;; If the group doesn't exist, we assume
+ ;; it's an archive group...
+ gnus-message-archive-method)
+ (t (gnus-find-method-for-group group)))))
+ (unless (gnus-request-group group t method)
+ (gnus-request-create-group group method))
+ (gnus-check-server method)
+ (save-excursion
+ (nnheader-set-temp-buffer " *acc*")
+ (insert-buffer-substring cur)
+ (unless (condition-case ()
+ (gnus-request-accept-article group t method)
+ (error nil))
+ (gnus-message 1 "Couldn't store article in group %s: %s"
+ group (gnus-status-message method))
+ (sit-for 2))
+ (kill-buffer (current-buffer)))))))))
(defun gnus-inews-insert-bfcc ()
"Insert Bcc and Fcc headers."
@@ -2467,6 +2624,7 @@ Headers will be generated before sending."
(insert gnus-author-copy))))
(defun gnus-inews-insert-gcc ()
+ "Insert Gcc headers based on `gnus-outgoing-message-group'."
(save-excursion
(save-restriction
(gnus-inews-narrow-to-headers)
@@ -2482,6 +2640,50 @@ Headers will be generated before sending."
(mapconcat 'identity group " "))
"\n"))))))
+(defun gnus-inews-insert-archive-gcc ()
+ "Insert the Gcc to say where the article is to be archived."
+ (let* ((var gnus-message-archive-group)
+ result
+ (groups
+ (cond
+ ((stringp var)
+ ;; Just a single group.
+ (list var))
+ ((and (listp var) (stringp (car var)))
+ ;; A list of groups.
+ var)
+ (t
+ ;; An alist of regexps/functions/forms.
+ (while (and var
+ (not
+ (setq result
+ (cond
+ ((stringp (caar var))
+ ;; Regexp.
+ (when (string-match (caar var)
+ gnus-newsgroup-name)
+ (cdar var)))
+ ((gnus-functionp (car var))
+ ;; Function.
+ (funcall (car var) gnus-newsgroup-name))
+ (t
+ (eval (car var)))))))
+ (setq var (cdr var)))
+ result))))
+ (when groups
+ (when (stringp groups)
+ (setq groups (list groups)))
+ (save-excursion
+ (save-restriction
+ (gnus-inews-narrow-to-headers)
+ (goto-char (point-max))
+ (insert "Gcc: ")
+ (while groups
+ (insert (gnus-group-prefixed-name
+ (pop groups) gnus-message-archive-method))
+ (insert " "))
+ (insert "\n"))))))
+
;;; Handling rejected (and postponed) news.
(defun gnus-draft-group ()
@@ -2612,6 +2814,21 @@ Headers will be generated before sending."
(push (cons (car attribute) value-value)
gnus-required-mail-headers)))))))))
+(defun gnus-inews-set-point ()
+ "Move point to where the user probably wants to find it."
+ (gnus-inews-narrow-to-headers)
+ (cond
+ ((re-search-forward "^[^:]+:[ \t]*$" nil t)
+ (search-backward ":" )
+ (widen)
+ (forward-char 2))
+ (t
+ (goto-char (point-max))
+ (widen)
+ (forward-line 1)
+ (unless (looking-at "$")
+ (forward-line 2)))))
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
2  lisp/gnus-nocem.el
View
@@ -1,5 +1,5 @@
;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
303 lisp/gnus-picon.el
View
@@ -1,39 +1,78 @@
-;; gnus-picon.el: Copyright (C) 1995 Wes Hardaker
-;; Icon hacks for displaying pretty icons in Gnus.
-;;
-;; Author: Wes hardaker
-;; hardaker@ece.ucdavis.edu
-;;
+;;; gnus-picons.el: Icon hacks for displaying pretty icons in Gnus.
+;; Copyright (C) 1996 Wes Hardaker
+
+;; Author: Wes hardaker <hardaker@ece.ucdavis.edu>
+;; Keywords: gnus xpm annotation glyph faces
+
+;;; Commentary:
+
;; Usage:
-;; - You must have XEmacs to use this.
-;; - (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t)
-;; This HAS to have the 't' flag above to make sure it appends the hook.
+;; - You must have XEmacs (19.12 or above I think) to use this.
;; - Read the variable descriptions below.
;;
+;; - chose a setup:
+;;
+;; 1) display the icons in its own buffer:
+;;
+;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t)
+;; (add-hook 'gnus-summary-display-hook 'gnus-group-display-picons t)
+;; (setq gnus-picons-display-where 'picons)
+;;
+;; Then add the picons buffer to your display configuration:
+;; The picons buffer needs to be at least 48 pixels high,
+;; which for me is 5 lines:
+;;
+;; (gnus-add-configuration
+;; '(article (vertical 1.0
+;; (group 6)
+;; (picons 5)
+;; (summary .25 point)
+;; (article 1.0))))
+;;
+;; (gnus-add-configuration
+;; '(summary (vertical 1.0 (group 6)
+;; (picons 5)
+;; (summary 1.0 point))))
+;;
+;; 2) display the icons in the summary buffer
+;;
+;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t)
+;; (add-hook 'gnus-summary-display-hook 'gnus-group-display-picons t)
+;; (setq gnus-picons-display-where 'summary)
+;;
+;; 3) display the icons in the article buffer
+;;
+;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t)
+;; (add-hook 'gnus-article-display-hook 'gnus-group-display-picons t)
+;; (setq gnus-picons-display-where 'article)
+;;
+;;
;; Warnings:
;; - I'm not even close to being a lisp expert.
+;; - The 't' (append) flag MUST be in the add-hook line
;;
;; TODO:
-;; - Following the Gnus motto: We've got to build him bigger,
-;; better, stronger, faster than before... errr.... sorry.
-;; - Create a seperate frame to store icons in so icons are
-;; visibile immediately upon entering a group rather than just
-;; at the top of the article buffer.
+;; - Remove the TODO section in the headers.
;;
-;;
+
+;;; Code:
(require 'xpm)
(require 'annotations)
+(defvar gnus-picons-buffer "*Icon Buffer*"
+ "Buffer name to display the icons in if gnus-picons-display-where is 'picons.")
+
+(defvar gnus-picons-display-where 'picons
+ "Where to display the group and article icons.")
+
(defvar gnus-picons-database "/usr/local/faces"
- "defines the location of the faces database. For information on
- obtaining this database of pretty pictures, please see
- http://www.cs.indiana.edu/picons/ftp/index.html"
-)
+ "Defines the location of the faces database.
+For information on obtaining this database of pretty pictures, please
+see http://www.cs.indiana.edu/picons/ftp/index.html" )
(defvar gnus-picons-news-directory "news"
- "Sub-directory of the faces database containing the icons for
- newsgroups."
+ "Sub-directory of the faces database containing the icons for newsgroups."
)
(defvar gnus-picons-user-directories '("local" "users" "usenix" "misc/MISC")
@@ -41,81 +80,179 @@
)
(defvar gnus-picons-domain-directories '("domains")
- "List of directories to search for domain faces. Some people may
- want to add \"unknown\" to this list."
+ "List of directories to search for domain faces.
+Some people may want to add \"unknown\" to this list."
+)
+
+(setq gnus-group-annotations nil)
+(setq gnus-article-annotations nil)
+
+(defun gnus-picons-remove (plist)
+ (let ((listitem (car plist)))
+ (while (setq listitem (car plist))
+ (if (annotationp listitem)
+ (delete-annotation listitem))
+ (setq plist (cdr plist))))
)
+(defun gnus-picons-remove-all ()
+ "Removes all picons from the Gnus display(s)."
+ (interactive)
+ (gnus-picons-remove gnus-article-annotations)
+ (gnus-picons-remove gnus-group-annotations)
+ (setq gnus-article-annotations nil
+ gnus-group-annotations nil)
+ (if (bufferp gnus-picons-buffer)
+ (kill-buffer gnus-picons-buffer))
+)
+
+(defun gnus-get-buffer-name (variable)
+ "Returns the buffer name associated with the contents of a variable."
+ (cond ((symbolp variable)
+ (let ((newvar (cdr (assq variable gnus-window-to-buffer))))
+ (cond ((symbolp newvar)
+ (symbol-value newvar))
+ ((stringp newvar) newvar))))
+ ((stringp variable)
+ variable)))
+
(defun gnus-article-display-picons ()
- "prepare article buffer with pretty pictures"
+ "Display faces for an author and his/her domain in gnus-picons-display-where."
(interactive)
- (if (featurep 'xpm)
+ (if (and (featurep 'xpm)
+ (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
(save-excursion
- (beginning-of-buffer)
- (open-line 1)
- (let* ((iconpoint (point)) (from (mail-fetch-field "from"))
- (username
- (progn
- (string-match "\\([-_a-zA-Z0-9]+\\)@" from)
- (match-string 1 from)))
- (hostpath
- (gnus-picons-reverse-domain-path
- (replace-in-string
- (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*" "\\1")
- "\\." "/"))))
- (if (equal username from)
- (setq username (replace-in-string from
- ".*<\\([_a-zA-Z0-9-.]+\\)>.*"
- "\\1")))
- (insert username)
- (gnus-picons-insert-face-if-exists
- (concat gnus-picons-database "/" gnus-picons-news-directory)
- (concat (replace-in-string gnus-newsgroup-name "\\." "/") "/unknown")
- iconpoint)
- (mapcar '(lambda (pathpart)
- (gnus-picons-insert-face-if-exists
- (concat gnus-picons-database "/" pathpart)
- (concat hostpath "/" username)
- iconpoint))
- gnus-picons-user-directories)
- (mapcar '(lambda (pathpart)
- (gnus-picons-insert-face-if-exists
- (concat gnus-picons-database "/" pathpart)
- (concat hostpath "/" "unknown")
- iconpoint))
- gnus-picons-domain-directories)
- ))))
-
-(defun gnus-picons-insert-face-if-exists (path filename ipoint)
- "inserts a face at point if I can find one"
- (let ((pathfile (concat path "/" filename "/face")))
- (let ((newfilename
- (replace-in-string filename
- "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1")))
- (if (not (equal filename newfilename))
- (gnus-picons-insert-face-if-exists path newfilename ipoint)))
- (if (not (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint))
- (gnus-picons-try-to-find-face (concat pathfile ".xbm") ipoint))
+ (let* ((iconpoint (point)) (from (mail-fetch-field "from"))
+ (username
+ (progn
+ (string-match "\\([-_a-zA-Z0-9]+\\)@" from)
+ (match-string 1 from)))
+ (hostpath
+ (concat (gnus-picons-reverse-domain-path
+ (replace-in-string
+ (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*"
+ "\\1")
+ "\\." "/")) "/")))
+ (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where))
+ (beginning-of-buffer)
+ (setq iconpoint (point))
+ (if (not (looking-at "^$"))
+ (if buffer-read-only
+ (progn
+ (toggle-read-only)
+ (open-line 1)
+ (toggle-read-only)
+ )
+ (open-line 1)))
+
+ (end-of-line)
+ (gnus-picons-remove gnus-article-annotations)
+ (setq gnus-article-annotations 'nil)
+ (if (equal username from)
+ (setq username (progn
+ (string-match "<\\([_a-zA-Z0-9-.]+\\)>" from)
+ (match-string 1 from))))
+ (mapcar '(lambda (pathpart)
+ (setq gnus-article-annotations
+ (append
+ (gnus-picons-insert-face-if-exists
+ (concat
+ (file-name-as-directory
+ gnus-picons-database) pathpart)
+ (concat hostpath username)
+ iconpoint)
+ gnus-article-annotations)))
+ gnus-picons-user-directories)
+ (mapcar '(lambda (pathpart)
+ (setq gnus-article-annotations
+ (append
+ (gnus-picons-insert-face-if-exists
+ (concat (file-name-as-directory
+ gnus-picons-database) pathpart)
+ (concat hostpath "unknown")
+ iconpoint)
+ gnus-article-annotations)))
+ gnus-picons-domain-directories)
+ (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)
+ (if (and (featurep 'xpm)
+ (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
+ (save-excursion
+ (let
+ ((iconpoint (point)))
+ (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where))
+ (beginning-of-buffer)
+ (cond
+ ((listp gnus-group-annotations)
+ (mapcar 'delete-annotation gnus-group-annotations)
+ (setq gnus-group-annotations nil))
+ ((annotationp gnus-group-annotations)
+ (delete-annotation gnus-group-annotations)
+ (setq gnus-group-annotations nil))
+ )
+ (setq iconpoint (point))
+ (if (not (looking-at "^$"))
+ (open-line 1))
+ (gnus-picons-remove gnus-group-annotations)
+ (setq gnus-group-annotations nil)
+ (setq gnus-group-annotations
+ (gnus-picons-insert-face-if-exists
+ (concat (file-name-as-directory gnus-picons-database)
+ gnus-picons-news-directory)
+ (concat (replace-in-string gnus-newsgroup-name "\\." "/")
+ "/unknown")
+ iconpoint t))
+ (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))
+
+
+(defun gnus-picons-insert-face-if-exists (path filename ipoint &optional rev)
+ "Inserts a face at point if I can find one"
+ (let ((pathfile (concat path "/" filename "/face"))
+ (newfilename
+ (replace-in-string filename
+ "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1"))
+ (annotations nil))
+ (if (and rev
+ (not (equal filename newfilename)))
+ (setq annotations (append
+ (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
+ annotations)))
+ (if (eq (length annotations) (length (setq annotations (append
+ (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint)
+ annotations))))
+ (setq annotations (append
+ (gnus-picons-try-to-find-face
+ (concat pathfile ".xbm") ipoint)
+ annotations)))
+ (if (and (not rev)
+ (not (equal filename newfilename)))
+ (setq annotations (append
+ (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
+ annotations)))
+ annotations
)
)
(defun gnus-picons-try-to-find-face (path ipoint)
- "if path exists, display it as a bitmap. Returns t if succedded."
- (if (file-exists-p path)
- (progn
- (setq gl (make-glyph path))
- (set-glyph-face gl 'default)
- (setq annot (make-annotation gl ipoint 'text))
- t)
-; (insert (format "no: %s\n" path))
- nil))
+ "If PATH exists, display it as a bitmap. Returns t if succedded."
+ (if (file-exists-p path)
+ (progn
+; (insert (format "yes: %s\n" path))
+ (setq gl (make-glyph path))
+ (set-glyph-face gl 'default)
+ (list (make-annotation gl ipoint 'text)))
+; (insert (format "no: %s\n" path))
+ nil))
(defun gnus-picons-reverse-domain-path (str)
"a/b/c/d -> d/c/b/a"
(if (equal (replace-in-string str "^[^/]*$" "") "")
str
(concat (replace-in-string str "^.*/\\([_a-zA-Z0-9-]+\\)$" "\\1") "/"
- (gnus-picons-reverse-domain-path
- (replace-in-string str "^\\(.*\\)/[_a-zA-Z0-9-]+$" "\\1")))))
-
-
+ (gnus-picons-reverse-domain-path
+ (replace-in-string str "^\\(.*\\)/[_a-zA-Z0-9-]+$" "\\1")))))
608 lisp/gnus-salt.el
View
@@ -0,0 +1,608 @@
+;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+
+;;;
+;;; gnus-pick-mode
+;;;
+
+(defvar gnus-pick-mode nil
+ "Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
+
+(defvar gnus-pick-display-summary nil
+ "*Display summary while reading.")
+
+(defvar gnus-pick-mode-hook nil
+ "Hook run in summary pick mode buffers.")
+
+;;; Internal variables.
+
+(defvar gnus-pick-mode-map nil)
+
+(unless gnus-pick-mode-map
+ (setq gnus-pick-mode-map (make-sparse-keymap))
+
+ (gnus-define-keys
+ gnus-pick-mode-map
+ "t" gnus-uu-mark-thread
+ "T" gnus-uu-unmark-thread
+ " " gnus-summary-mark-as-processable
+ "u" gnus-summary-unmark-as-processable
+ "U" gnus-summary-unmark-all-processable
+ "r" gnus-uu-mark-region
+ "R" gnus-uu-unmark-region
+ "e" gnus-uu-mark-by-regexp
+ "E" gnus-uu-mark-by-regexp
+ "b" gnus-uu-mark-buffer
+ "B" gnus-uu-unmark-buffer
+ "\r" gnus-pick-start-reading))
+
+(defun gnus-pick-make-menu-bar ()
+ (unless (boundp 'gnus-pick-menu)
+ (easy-menu-define
+ gnus-pick-menu gnus-pick-mode-map ""
+ '("Pick"
+ ("Pick"
+ ["Article" gnus-summary-mark-as-processable t]
+ ["Thread" gnus-uu-mark-thread t]
+ ["Region" gnus-uu-mark-region t]
+ ["Regexp" gnus-uu-mark-regexp t]
+ ["Buffer" gnus-uu-mark-buffer t])
+ ("Unpick"
+ ["Article" gnus-summary-unmark-as-processable t]
+ ["Thread" gnus-uu-unmark-thread t]
+ ["Region" gnus-uu-unmark-region t]
+ ["Regexp" gnus-uu-unmark-regexp t]
+ ["Buffer" gnus-uu-unmark-buffer t])
+ ["Start reading" gnus-pick-start-reading t]
+ ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
+
+(defun gnus-pick-mode (&optional arg)
+ "Minor mode for provind a pick-and-read interface in Gnus summary buffers."
+ (interactive "P")
+ (when (eq major-mode 'gnus-summary-mode)
+ (make-local-variable 'gnus-pick-mode)
+ (setq gnus-pick-mode
+ (if (null arg) (not gnus-pick-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-pick-mode
+ ;; Make sure that we don't select any articles upon group entry.
+ (make-local-variable 'gnus-auto-select-first)
+ (setq gnus-auto-select-first nil)
+ ;; Set up the menu.
+ (when (and menu-bar-mode
+ (gnus-visual-p 'pick-menu 'menu))
+ (gnus-pick-make-menu-bar))
+ (unless (assq 'gnus-pick-mode minor-mode-alist)
+ (push '(gnus-pick-mode " Pick") minor-mode-alist))
+ (unless (assq 'gnus-topic-mode minor-mode-map-alist)
+ (push (cons 'gnus-topic-mode gnus-pick-mode-map)
+ minor-mode-map-alist))
+ (run-hooks 'gnus-pick-mode-hook))))
+
+(defun gnus-pick-start-reading (&optional catch-up)
+ "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 catch-up
+ (gnus-summary-limit-mark-excluded-as-read))
+ (gnus-configure-windows (if gnus-pick-display-summary 'summary 'pick) t))
+
+
+;;;
+;;; gnus-binary-mode
+;;;
+
+(defvar gnus-binary-mode nil
+ "Minor mode for provind a binary group interface in Gnus summary buffers.")
+
+(defvar gnus-binary-mode-hook nil
+ "Hook run in summary binary mode buffers.")
+
+(defvar gnus-binary-mode-map nil)
+
+(unless gnus-binary-mode-map
+ (setq gnus-binary-mode-map (make-sparse-keymap))
+
+ (gnus-define-keys
+ gnus-binary-mode-map
+ "g" gnus-binary-show-article))
+
+(defun gnus-binary-make-menu-bar ()
+ (unless (boundp 'gnus-binary-menu)
+ (easy-menu-define
+ gnus-binary-menu gnus-binary-mode-map ""
+ '("Pick"
+ ["Switch binary mode off" gnus-binary-mode t]))))
+
+(defun gnus-binary-mode (&optional arg)
+ "Minor mode for providing a binary group interface in Gnus summary buffers."
+ (interactive "P")
+ (when (eq major-mode 'gnus-summary-mode)
+ (make-local-variable 'gnus-binary-mode)
+ (setq gnus-binary-mode
+ (if (null arg) (not gnus-binary-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-binary-mode
+ ;; Make sure that we don't select any articles upon group entry.
+ (make-local-variable 'gnus-auto-select-first)
+ (setq gnus-auto-select-first nil)
+ (make-local-variable 'gnus-summary-display-article-function)
+ (setq gnus-summary-display-article-function 'gnus-binary-display-article)
+ ;; Set up the menu.
+ (when (and menu-bar-mode
+ (gnus-visual-p 'binary-menu 'menu))
+ (gnus-binary-make-menu-bar))
+ (unless (assq 'gnus-binary-mode minor-mode-alist)
+ (push '(gnus-binary-mode " Binary") minor-mode-alist))
+ (unless (assq 'gnus-topic-mode minor-mode-map-alist)
+ (push (cons 'gnus-topic-mode gnus-binary-mode-map)
+ minor-mode-map-alist))
+ (run-hooks 'gnus-binary-mode-hook))))
+
+(defun gnus-binary-display-article (article &optional all-header)
+ "Run ARTICLE through the binary decode functions."
+ (when (gnus-summary-goto-subject article)
+ (let ((gnus-view-pseudos 'automatic))
+ (gnus-uu-decode-uu))))
+
+(defun gnus-binary-show-article (&optional arg)
+ "Bypass the binary functions and show the article."
+ (interactive "P")
+ (let (gnus-summary-display-article-function)
+ (gnus-summary-show-article arg)))
+
+;;;
+;;; gnus-tree-mode
+;;;
+
+(defvar gnus-tree-line-format "%(%[%3,3n%]%)"
+ "Format of tree elements.")
+
+(defvar gnus-tree-minimize-window t
+ "If non-nil, minimize the tree buffer window.
+If a number, never let the tree buffer grow taller than that number of
+lines.")
+
+(defvar gnus-selected-tree-face 'modeline
+ "*Face used for highlighting selected articles in the thread tree.")
+
+(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) (?\{ . ?\}))
+ "Brackets used in tree nodes.")
+
+(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
+ "Charaters used to connect parents with children.")
+
+(defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z"
+ "*The format specification for the tree mode line.")
+
+(defvar gnus-generate-tree-function 'gnus-generate-vertical-tree
+ "*Function for generating a thread tree.
+Two predefined functions are available:
+`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.")
+
+(defvar gnus-tree-mode-hook nil
+ "*Hook run in tree mode buffers.")
+
+(defvar gnus-tree-buffer "*Tree*"
+ "Buffer where Gnus thread trees are displayed.")
+
+;;; Internal variables.
+
+(defvar gnus-tree-line-format-alist
+ `((?n gnus-tmp-name ?s)
+ (?f gnus-tmp-from ?s)
+ (?N gnus-tmp-number ?d)
+ (?\[ gnus-tmp-open-bracket ?c)
+ (?\] gnus-tmp-close-bracket ?c)
+ (?s gnus-tmp-subject ?s)))
+
+(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist)
+
+(defvar gnus-tree-mode-line-format-spec nil)
+(defvar gnus-tree-line-format-spec nil)
+
+(defvar gnus-tree-node-length nil)
+(defvar gnus-selected-tree-overlay nil)
+
+(defvar gnus-tree-displayed-thread nil)
+
+(defvar gnus-tree-mode-map nil)
+(put 'gnus-tree-mode 'mode-class 'special)
+
+(unless gnus-tree-mode-map
+ (setq gnus-tree-mode-map (make-keymap))
+ (suppress-keymap gnus-tree-mode-map)
+ (gnus-define-keys
+ gnus-tree-mode-map
+ "\r" gnus-tree-select-article
+ gnus-mouse-2 gnus-tree-pick-article
+ "\C-?" gnus-tree-read-summary-keys)
+
+ (substitute-key-definition
+ 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
+
+(defun gnus-tree-make-menu-bar ()
+ )
+
+(defun gnus-tree-mode ()
+ "Major mode for displaying thread trees."
+ (interactive)
+ (setq gnus-tree-mode-line-format-spec
+ (gnus-parse-format gnus-tree-mode-line-format
+ gnus-summary-mode-line-format-alist))
+ (setq gnus-tree-line-format-spec
+ (gnus-parse-format gnus-tree-line-format
+ gnus-tree-line-format-alist t))
+ (when (and menu-bar-mode
+ (gnus-visual-p 'tree-menu 'menu))
+ (gnus-tree-make-menu-bar))
+ (kill-all-local-variables)
+ (gnus-simplify-mode-line)
+ (setq mode-name "Tree")
+ (setq major-mode 'gnus-tree-mode)
+ (use-local-map gnus-tree-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (setq truncate-lines t)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (gnus-tree-node-insert (make-mail-header "") nil)
+ (setq gnus-tree-node-length (1- (point))))
+ (run-hooks 'gnus-tree-mode-hook))
+
+(defun gnus-tree-read-summary-keys (&optional arg)
+ "Read a summary buffer key sequence and execute it."
+ (interactive "P")
+ (let ((buf (current-buffer))
+ win)
+ (gnus-article-read-summary-keys arg nil t)
+ (when (setq win (get-buffer-window buf))
+ (select-window win)
+ (when gnus-selected-tree-overlay
+ (goto-char (overlay-end gnus-selected-tree-overlay)))
+ (gnus-tree-minimize))))
+
+(defun gnus-tree-select-article (article)
+ "Select the article under point, if any."
+ (interactive (list (gnus-tree-article-number)))
+ (let ((buf (current-buffer)))
+ (when article
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-goto-article article))
+ (select-window (get-buffer-window buf)))))
+
+(defun gnus-tree-pick-article (e)
+ "Select the article under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-tree-select-article (gnus-tree-article-number)))
+
+(defun gnus-tree-article-number ()
+ (get-text-property (point) 'gnus-number))
+
+(defun gnus-tree-article-region (article)
+ "Return a cons with BEG and END of the article region."
+ (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
+ (when pos
+ (cons pos (next-single-property-change pos 'gnus-number)))))
+
+(defun gnus-tree-goto-article (article)
+ (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
+ (when pos
+ (goto-char pos))))
+
+(defun gnus-tree-recenter ()
+ "Center point in the tree window."
+ (when (get-buffer-window (current-buffer))
+ (save-selected-window
+ (select-window (get-buffer-window (current-buffer)))
+ (let* ((top (cond ((< (window-height) 4) 0)
+ ((< (window-height) 7) 1)
+ (t 2)))
+ (height (1- (window-height)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- height))
+ (point)))
+ (window (get-buffer-window (current-buffer))))
+ ;; Set the window start to either `bottom', which is the biggest
+ ;; possible valid number, or the second line from the top,
+ ;; whichever is the least.
+ (set-window-start
+ window (min bottom (save-excursion
+ (forward-line (- top)) (point))))))))
+
+(defun gnus-get-tree-buffer ()
+ "Return the tree buffer properly initialized."
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-tree-buffer))
+ (unless (eq major-mode 'gnus-tree-mode)
+ (gnus-add-current-to-buffer-list)
+ (gnus-tree-mode))
+ (current-buffer)))
+
+(defun gnus-tree-minimize ()
+ (when (and gnus-tree-minimize-window
+ (not (one-window-p)))
+ (let* ((window-min-height 2)
+ (height (count-lines (point-min) (point-max)))
+ (min (max (1- window-min-height) height))
+ (tot (if (numberp gnus-tree-minimize-window)
+ (min gnus-tree-minimize-window min)
+ min))
+ (win (get-buffer-window (current-buffer)))
+ (wh (and win (1- (window-height win)))))
+ (when (and win
+ (not (eq tot wh)))
+ (save-selected-window
+ (select-window win)
+ (enlarge-window (- tot wh)))))))
+
+;;; Generating the tree.
+
+(defun gnus-tree-node-insert (header sparse)
+ (let* ((dummy (stringp header))
+ (header (if (vectorp header) header
+ (progn
+ (setq header (make-mail-header "*****"))
+ (mail-header-set-number header 0)
+ (mail-header-set-lines header 0)
+ (mail-header-set-chars header 0)
+ header)))
+ (gnus-tmp-from (mail-header-from header))
+ (gnus-tmp-subject (mail-header-subject header))
+ (gnus-tmp-number (mail-header-number header))
+ (gnus-tmp-name
+ (cond
+ ((string-match "(.+)