home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / gnus / gnus.el < prev    next >
Encoding:
Text File  |  1993-03-14  |  230.6 KB  |  6,571 lines

  1. ;;; GNUS: an NNTP-based News Reader for GNU Emacs
  2. ;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD.
  3. ;; Copyright (C) 1987, 1988, 1989, 1990 Masanobu UMEDA
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22. ;; How to Install GNUS:
  23. ;; (0) First of all, remove GNUS related OLD *.elc files (at least nntp.elc).
  24. ;; (1) Unshar gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el, and nntp.el.
  25. ;; (2) byte-compile-file nntp.el, gnus.el, gnuspost.el, gnusmail.el, and gnusmisc.el.
  26. ;;     If you have a local news spool, byte-compile-file nnspool.el, too.
  27. ;; (3) Define three environment variables in .login file as follows:
  28. ;;
  29. ;;     setenv    NNTPSERVER    flab
  30. ;;     setenv    DOMAINNAME    "stars.flab.Fujitsu.CO.JP"
  31. ;;     setenv    ORGANIZATION    "Fujitsu Laboratories Ltd., Kawasaki, Japan."
  32. ;;
  33. ;;     Or instead, define lisp variables in your .emacs, site-init.el,
  34. ;;     or default.el as follows:
  35. ;;
  36. ;;     (setq gnus-nntp-server "flab")
  37. ;;     (setq gnus-local-domain "stars.flab.Fujitsu.CO.JP")
  38. ;;     (setq gnus-local-organization "Fujitsu Laboratories Ltd., ...")
  39. ;;
  40. ;;     If the function (system-name) returns the full internet name,
  41. ;;     you don't have to define the domain.
  42. ;;
  43. ;; (4) You may have to define NNTP service name as number 119.
  44. ;;
  45. ;;     (setq gnus-nntp-service 119)
  46. ;;
  47. ;;     Or, if you'd like to use a local news spool directly in stead
  48. ;;     of NNTP, install nnspool.el and set the variable to nil as
  49. ;;     follows:
  50. ;;
  51. ;;     (setq gnus-nntp-service nil)
  52. ;;
  53. ;; (5) If you'd like to use the GENERICFROM feature like the Bnews,
  54. ;;     define the variable as follows:
  55. ;;
  56. ;;     (setq gnus-use-generic-from t)
  57. ;;
  58. ;; (6) Define autoload entries in .emacs file as follows:
  59. ;;
  60. ;;     (autoload 'gnus "gnus" "Read network news." t)
  61. ;;     (autoload 'gnus-post-news "gnuspost" "Post a news." t)
  62. ;;
  63. ;; (7) Read nntp.el if you have problems with NNTP or kanji handling.
  64. ;;
  65. ;; (8) Install mhspool.el, tcp.el, and tcp.c if it is necessary.
  66. ;;
  67. ;;     mhspool.el is a package for reading articles or mail in your
  68. ;;     private directory using GNUS.
  69. ;;
  70. ;;     tcp.el and tcp.c are necessary if and only if your Emacs does
  71. ;;     not have the function `open-network-stream' which is used for
  72. ;;     communicating with NNTP server inside Emacs.
  73. ;;
  74. ;; (9) Install an Info file generated from the texinfo manual gnus.texinfo.
  75. ;;
  76. ;;     If you are not allowed to create the Info file to the standard
  77. ;;     Info-directory, create it in your private directory and set the
  78. ;;     variable gnus-Info-directory to that directory.
  79.  
  80. ;; GNUS Mailing List:
  81. ;; There are two mailing lists for GNUS lovers in the world:
  82. ;;
  83. ;;    info-gnus@flab.fujitsu.co.jp, and
  84. ;;    info-gnus-english@tut.cis.ohio-state.edu.
  85. ;;
  86. ;; They are intended to exchange useful information about GNUS, such
  87. ;; as bug fixes, useful hooks, and extensions.  The major difference
  88. ;; between the lists is what the official language is.  Both Japanese
  89. ;; and English are available in info-gnus, while English is only
  90. ;; available in info-gnus-english. There is no need to subscribe to
  91. ;; info-gnus if you cannot read Japanese messages, because most of the
  92. ;; discussion and important announcements will be sent to
  93. ;; info-gnus-english. Moreover, if you can read gnu.emacs.gnus
  94. ;; newsgroup of USENET, you need not, either. info-gnus-english and
  95. ;; gnu.emacs.gnus are linked each other.
  96. ;;
  97. ;; Please send subscription request to:
  98. ;;
  99. ;;     info-gnus-request@flab.fujitsu.co.jp, or
  100. ;;    info-gnus-english-request@cis.ohio-state.edu
  101.  
  102. ;; TO DO:
  103. ;; (1) Incremental update of active info.
  104. ;; (2) GNUS own poster.
  105. ;; (3) Multi-GNUS (Talking to many hosts same time).
  106. ;; (4) Asynchronous transmission of large messages.
  107.  
  108. (provide 'gnus)
  109. (require 'nntp)
  110. (require 'mail-utils)
  111.  
  112. (defvar gnus-nntp-server (getenv "NNTPSERVER")
  113.   "*The name of the host running NNTP server.
  114. If it is a string such as `:DIRECTORY', the user's private DIRECTORY
  115. is used as a news spool.
  116. Initialized from the NNTPSERVER environment variable.")
  117.  
  118. (defvar gnus-nntp-service "nntp"
  119.   "*NNTP service name (\"nntp\" or 119).
  120. Go to a local news spool if its value is nil.")
  121.  
  122. (defvar gnus-news-system 'Bnews
  123.   "*News software system name of the news server, such as Bnews and Cnews.
  124. This variable is intended to hide implementation dependent differences
  125. between news systems.")
  126.  
  127. (defvar gnus-startup-file "~/.newsrc"
  128.   "*Your .newsrc file. Use `.newsrc-SERVER' instead if exists.")
  129.  
  130. (defvar gnus-signature-file "~/.signature"
  131.   "*Your .signature file. Use `.signature-DISTRIBUTION' instead if exists.")
  132.  
  133. (defvar gnus-use-cross-reference t
  134.   "*Specifies what to do with cross references (Xref: field).
  135. If nil, ignore cross references.  If t, mark articles as read in
  136. subscribed newsgroups.  Otherwise, if not nil nor t, mark articles as
  137. read in all newsgroups.")
  138.  
  139. (defvar gnus-use-followup-to t
  140.   "*Specifies what to do with Followup-To: field.
  141. If nil, ignore followup-to: field.  If t, use its value execpt for
  142. `poster'.  Otherewise, if not nil nor t, always use its value.")
  143.  
  144. (defvar gnus-large-newsgroup 50
  145.   "*The number of articles which indicates a large newsgroup.
  146. If the number of articles in a newsgroup is greater than the value,
  147. confirmation is required for selecting the newsgroup.")
  148.  
  149. (defvar gnus-author-copy (getenv "AUTHORCOPY")
  150.   "*File name saving a copy of an article posted using FCC: field.
  151. Initialized from the AUTHORCOPY environment variable.
  152.  
  153. Articles are saved using a function specified by the the variable
  154. gnus-author-copy-saver (gnus-rmail-output is default) if a file name is
  155. given.  Instead, if the first character of the name is `|', the
  156. contents of the article is piped out to the named program. It is
  157. possible to save an article in an MH folder as follows:
  158.  
  159. (setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
  160.  
  161. (defvar gnus-author-copy-saver (function gnus-rmail-output)
  162.   "*A function called with a file name to save an author copy to.
  163. The default function is `gnus-rmail-output' which saves in Unix mailbox format.")
  164.  
  165. (defvar gnus-use-long-file-name
  166.   (not (memq system-type '(usg-unix-v xenix)))
  167.   "*Non-nil means that a newsgroup name is used as a default file name
  168. to save articles to. If it's nil, the directory form of a newsgroup is
  169. used instead.")
  170.  
  171. (defvar gnus-article-save-directory (getenv "SAVEDIR")
  172.   "*A directory name to save articles to (default to ~/News).
  173. Initialized from the SAVEDIR environment variable.")
  174.  
  175. (defvar gnus-default-article-saver (function gnus-Subject-save-in-rmail)
  176.   "*A function to save articles in your favorite format.
  177. The function must be interactively callable (in other words, it must
  178. be an Emacs command).
  179.  
  180. GNUS provides the following functions:
  181.     gnus-Subject-save-in-rmail (in Rmail format)
  182.     gnus-Subject-save-in-mail (in Unix mail format)
  183.     gnus-Subject-save-in-folder (in an MH folder)
  184.     gnus-Subject-save-in-file (in article format).")
  185.  
  186. (defvar gnus-rmail-save-name (function gnus-plain-save-name)
  187.   "*A function generating a file name to save articles in Rmail format.
  188. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
  189.  
  190. (defvar gnus-mail-save-name (function gnus-plain-save-name)
  191.   "*A function generating a file name to save articles in Unix mail format.
  192. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
  193.  
  194. (defvar gnus-folder-save-name (function gnus-folder-save-name)
  195.   "*A function generating a file name to save articles in MH folder.
  196. The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
  197.  
  198. (defvar gnus-file-save-name (function gnus-numeric-save-name)
  199.   "*A function generating a file name to save articles in article format.
  200. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
  201.  
  202. (defvar gnus-kill-file-name "KILL"
  203.   "*File name of a KILL file.")
  204.  
  205. (defvar gnus-default-distribution "local"
  206.   "*Use this value as distribution if no distribution is specified.")
  207.  
  208. (defvar gnus-novice-user t
  209.   "*Non-nil means that you are a novice to USENET.  If non-nil,
  210. verbose messages may be displayed or your confirmations may be required.")
  211.  
  212. (defvar gnus-interactive-post t
  213.   "*Newsgroup, subject, and distribution will be asked for if non-nil.")
  214.  
  215. (defvar gnus-user-login-name nil
  216.   "*The login name of the user.
  217. Got from the USER and LOGNAME environment variable if undefined.")
  218.  
  219. (defvar gnus-user-full-name nil
  220.   "*The full name of the user.
  221. Got from the NAME environment variable if undefined.")
  222.  
  223. (defvar gnus-show-threads t
  224.   "*Show conversation threads in Subject Mode if non-nil.")
  225.  
  226. (defvar gnus-thread-hide-subject t
  227.   "*Non-nil means hide subjects for thread subtrees.")
  228.  
  229. (defvar gnus-thread-hide-subtree nil
  230.   "*Non-nil means hide thread subtrees initially.
  231. If non-nil, you have to run the command gnus-Subject-show-thread by
  232. hand or by using gnus-Select-article-hook to show hidden threads.")
  233.  
  234. (defvar gnus-thread-hide-killed t
  235.   "*Non-nil means hide killed thread subtrees automatically.")
  236.  
  237. (defvar gnus-thread-ignore-subject nil
  238.   "*Don't take care of subject differences, but only references if non-nil.
  239. If it is non-nil, some commands work with subjects do not work properly.")
  240.  
  241. (defvar gnus-thread-indent-level 4
  242.   "*Indentation of thread subtrees.")
  243.  
  244. (defvar gnus-ignored-headers
  245.   "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
  246.   "*All random fields within the header of a message.")
  247.  
  248. (defvar gnus-show-all-headers nil
  249.   "*Show all headers of an article if non-nil.")
  250.  
  251. (defvar gnus-save-all-headers nil
  252.   "*Save all headers of an article if non-nil.")
  253.  
  254. (defvar gnus-optional-headers (function gnus-optional-lines-and-from)
  255.   "*A function generating a optional string displayed in GNUS Subject
  256. mode buffer.  The function is called with an article HEADER. The
  257. result must be a string excluding `[' and `]'.")
  258.  
  259. (defvar gnus-auto-extend-newsgroup t
  260.   "*Extend visible artciles to forward and backward if non-nil.")
  261.  
  262. (defvar gnus-auto-select-first t
  263.   "*Select the first unread article automagically if non-nil.
  264. If you want to prevent automatic selection of the first unread article
  265. in some newsgroups, set the variable to nil in gnus-Select-group-hook
  266. or gnus-Apply-kill-hook.")
  267.  
  268. (defvar gnus-auto-select-next t
  269.   "*Select the next newsgroup automagically if non-nil.
  270. If the value is t and the next newsgroup is empty, GNUS will exit
  271. Subject mode and go back to Group mode.  If the value is neither nil
  272. nor t, GNUS will select the following unread newsgroup. Especially, if
  273. the value is the symbol `quietly', the next unread newsgroup will be
  274. selected without any confirmations.")
  275.  
  276. (defvar gnus-auto-select-same nil
  277.   "*Select the next article with the same subject automagically if non-nil.")
  278.  
  279. (defvar gnus-auto-center-subject t
  280.   "*Always center the current subject in GNUS Subject mode window if non-nil.")
  281.  
  282. (defvar gnus-break-pages t
  283.   "*Break an article into pages if non-nil.
  284. Page delimiter is specified by the variable `gnus-page-delimiter'.")
  285.  
  286. (defvar gnus-page-delimiter "^\^L"
  287.   "*Regexp describing line-beginnings that separate pages of news article.")
  288.  
  289. (defvar gnus-digest-show-summary t
  290.   "*Show a summary of undigestified messages if non-nil.")
  291.  
  292. (defvar gnus-digest-separator "^Subject:[ \t]"
  293.   "*Regexp that separates messages in a digest article.")
  294.  
  295. (defvar gnus-use-full-window t
  296.   "*Non-nil means to take up the entire screen of Emacs.")
  297.  
  298. (defvar gnus-window-configuration
  299.   '((SelectNewsgroup (0 1 0))
  300.     (ExitNewsgroup   (1 0 0))
  301.     (SelectArticle   (0 3 10))
  302.     (ExpandSubject   (0 1 0)))
  303.   "*Specify window configurations for each action.
  304. The format of the variable is a list of (ACTION (G S A)), where
  305. G, S, and A are the relative height of Group, Subject, and Article
  306. windows, respectively.  ACTION is `SelectNewsgroup', `ExitNewsgroup',
  307. `SelectArticle', or `ExpandSubject'.")
  308.  
  309. (defvar gnus-mail-reply-method
  310.   (function gnus-mail-reply-using-mail)
  311.   "*A function to compose reply mail.
  312. The function gnus-mail-reply-using-mail uses usual sendmail mail
  313. program.  The function gnus-mail-reply-using-mhe uses mh-e mail
  314. program.  You can use yet another program by customizing this variable.")
  315.  
  316. (defvar gnus-mail-forward-method
  317.   (function gnus-mail-forward-using-mail)
  318.   "*A function to forward current message to another user.
  319. The function gnus-mail-reply-using-mail uses usual sendmail mail
  320. program. You can use yet another program by customizing this variable.")
  321.  
  322. (defvar gnus-mail-other-window-method
  323.   (function gnus-mail-other-window-using-mail)
  324.   "*A function to compose mail in other window.
  325. The function gnus-mail-other-window-using-mail uses usual sendmail
  326. mail program.  The function gnus-mail-other-window-using-mhe uses mh-e
  327. mail program.  You can use yet another program by customizing this variable.")
  328.  
  329. (defvar gnus-subscribe-newsgroup-method
  330.   (function gnus-subscribe-alphabetically)
  331.   "*A function called with a newsgroup name when new newsgroup is found.
  332. The function gnus-subscribe-randomly inserts a new newsgroup a the
  333. beginning of newsgroups.  The function gnus-subscribe-alphabetically
  334. inserts it in strict alphabetic order.  The function
  335. gnus-subscribe-hierarchically inserts it in hierarchical newsgroup
  336. order.")
  337.  
  338. (defvar gnus-Group-mode-hook nil
  339.   "*A hook for GNUS Group Mode.")
  340.  
  341. (defvar gnus-Subject-mode-hook nil
  342.   "*A hook for GNUS Subject Mode.")
  343.  
  344. (defvar gnus-Article-mode-hook nil
  345.   "*A hook for GNUS Article Mode.")
  346.  
  347. (defvar gnus-Kill-file-mode-hook nil
  348.   "*A hook for GNUS KILL File Mode.")
  349.  
  350. (defvar gnus-Open-server-hook nil
  351.   "*A hook called just before opening connection to news server.")
  352.  
  353. (defvar gnus-Startup-hook nil
  354.   "*A hook called at start up time.
  355. This hook is called after GNUS is connected to the NNTP server. So, it
  356. is possible to change the behavior of GNUS according to the selected
  357. NNTP server.")
  358.  
  359. (defvar gnus-Group-prepare-hook nil
  360.   "*A hook called after newsgroup list is created in the Newsgroup buffer.
  361. If you want to modify the Newsgroup buffer, you can use this hook.")
  362.  
  363. (defvar gnus-Subject-prepare-hook nil
  364.   "*A hook called after subject list is created in the Subject buffer.
  365. If you want to modify the Subject buffer, you can use this hook.")
  366.  
  367. (defvar gnus-Article-prepare-hook nil
  368.   "*A hook called after an article is prepared in the Article buffer.
  369. If you want to run a special decoding program like nkf, use this hook.")
  370.  
  371. (defvar gnus-Select-group-hook nil
  372.   "*A hook called when a newsgroup is selected.
  373. If you want to sort Subject buffer by date and then by subject, you
  374. can use the following hook:
  375.  
  376. (setq gnus-Select-group-hook
  377.       (function
  378.        (lambda ()
  379.      ;; First of all, sort by date.
  380.      (gnus-sort-headers
  381.       (function
  382.        (lambda (a b)
  383.          (gnus-date-lessp (gnus-header-date a)
  384.                   (gnus-header-date b)))))
  385.      ;; Then sort by subject string ignoring `Re:'.
  386.      ;; If case-fold-search is non-nil, case of letters is ignored.
  387.      (gnus-sort-headers
  388.       (function
  389.        (lambda (a b)
  390.          (gnus-string-lessp
  391.           (gnus-simplify-subject (gnus-header-subject a) 're)
  392.           (gnus-simplify-subject (gnus-header-subject b) 're)
  393.           )))))))
  394.  
  395. If you'd like to simplify subjects like the
  396. `gnus-Subject-next-same-subject' command does, you can use the
  397. following hook:
  398.  
  399. (setq gnus-Select-group-hook
  400.       (function
  401.        (lambda ()
  402.      (mapcar (function
  403.           (lambda (header)
  404.             (nntp-set-header-subject
  405.              header
  406.              (gnus-simplify-subject
  407.               (gnus-header-subject header) 're-only))))
  408.          gnus-newsgroup-headers))))
  409.  
  410. In some newsgroups author name is meaningless. It is possible to
  411. prevent listing author names in GNUS Subject buffer as follows:
  412.  
  413. (setq gnus-Select-group-hook
  414.       (function
  415.        (lambda ()
  416.      (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name)
  417.         (setq gnus-optional-headers
  418.               (function gnus-optional-lines)))
  419.            (t
  420.         (setq gnus-optional-headers
  421.               (function gnus-optional-lines-and-from)))))))")
  422.  
  423. (defvar gnus-Select-article-hook
  424.   (function (lambda () (gnus-Subject-show-thread)))
  425.   "*A hook called when an article is selected.
  426. The default hook shows conversation thread subtrees of the selected
  427. article automatically as follows:
  428.  
  429. (setq gnus-Select-article-hook
  430.       (function 
  431.        (lambda ()
  432.      (gnus-Subject-show-thread))))
  433.  
  434. If you'd like to undigestify digest articles automagically, you can
  435. use the following hook:
  436.  
  437. (setq gnus-Select-article-hook
  438.       (function
  439.        (lambda ()
  440.      (gnus-Subject-show-thread)
  441.      (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
  442.         (gnus-Subject-read-digest))
  443.            ((and (string-equal \"comp.text\" gnus-newsgroup-name)
  444.              (string-match \"^TeXhax Digest\"
  445.                    (gnus-header-subject gnus-current-headers)))
  446.         (gnus-Subject-read-digest)
  447.         )))))")
  448.  
  449. (defvar gnus-Select-digest-hook
  450.   (function
  451.    (lambda ()
  452.      ;; Reply-To: is required by `undigestify-rmail-message'.
  453.      (or (mail-position-on-field "Reply-to" t)
  454.      (progn
  455.        (mail-position-on-field "Reply-to")
  456.        (insert (gnus-fetch-field "From"))))))
  457.   "*A hook called when reading digest messages using Rmail.
  458. This hook can be used to modify incomplete digest articles as follows
  459. (this is the default):
  460.  
  461. (setq gnus-Select-digest-hook
  462.       (function
  463.        (lambda ()
  464.      ;; Reply-To: is required by `undigestify-rmail-message'.
  465.      (or (mail-position-on-field \"Reply-to\" t)
  466.          (progn
  467.            (mail-position-on-field \"Reply-to\")
  468.            (insert (gnus-fetch-field \"From\")))))))")
  469.  
  470. (defvar gnus-Rmail-digest-hook nil
  471.   "*A hook called when reading digest messages using Rmail.
  472. This hook is intended to customize Rmail mode for reading digest articles.")
  473.  
  474. (defvar gnus-Apply-kill-hook (function gnus-apply-kill-file)
  475.   "*A hook called when a newsgroup is selected and subject list is prepared.
  476. This hook is intended to apply a KILL file to the selected newsgroup.
  477. The function `gnus-apply-kill-file' is called defaultly.
  478.  
  479. Since a general KILL file is too heavy to use only for a few
  480. newsgroups, I recommend you to use a lighter hook function. For
  481. example, if you'd like to apply a KILL file to articles which contains
  482. a string `rmgroup' in subject in newsgroup `control', you can use the
  483. following hook:
  484.  
  485. (setq gnus-Apply-kill-hook
  486.       (function
  487.        (lambda ()
  488.      (cond ((string-match \"control\" gnus-newsgroup-name)
  489.         (gnus-kill \"Subject\" \"rmgroup\")
  490.         (gnus-expunge \"X\"))))))")
  491.  
  492. (defvar gnus-Mark-article-hook
  493.   (function
  494.    (lambda ()
  495.      (or (memq gnus-current-article gnus-newsgroup-marked)
  496.      (gnus-Subject-mark-as-read gnus-current-article))
  497.      (gnus-Subject-set-current-mark "+")))
  498.   "*A hook called when an article is selected at the first time.
  499. The hook is intended to mark an article as read (or unread)
  500. automatically when it is selected.
  501.  
  502. If you'd like to mark as unread (-) instead, use the following hook:
  503.  
  504. (setq gnus-Mark-article-hook
  505.       (function
  506.        (lambda ()
  507.      (gnus-Subject-mark-as-unread gnus-current-article)
  508.      (gnus-Subject-set-current-mark \"+\"))))")
  509.  
  510. (defvar gnus-Inews-article-hook nil
  511.   "*A hook called before posting an article.
  512. If you'd like to run a special encoding program, use this hook.")
  513.  
  514. (defvar gnus-Exit-group-hook nil
  515.   "*A hook called when exiting (not quitting) Subject mode.
  516. If your machine is so slow that exiting from Subject mode takes very
  517. long time, set the variable gnus-use-cross-reference to nil. This
  518. inhibits marking articles as read using cross-reference information.")
  519.  
  520. (defvar gnus-Suspend-gnus-hook nil
  521.   "*A hook called when suspending (not exiting) GNUS.")
  522.  
  523. (defvar gnus-Exit-gnus-hook nil
  524.   "*A hook called when exiting (not suspending) GNUS.")
  525.  
  526. (defvar gnus-Save-newsrc-hook nil
  527.   "*A hook called when saving the newsrc file.
  528. This hook is called before saving .newsrc file.")
  529.  
  530.  
  531. ;; Site dependent variables. You have to define these variables in
  532. ;;  site-init.el, default.el or your .emacs.
  533.  
  534. (defvar gnus-local-timezone (condition-case ()
  535.                 (let ((zoneinfo (current-time-zone)))
  536.                   (or (if (nth 1 zoneinfo) (nth 3 zoneinfo))
  537.                       (nth 2 zoneinfo)))
  538.                   (error nil))
  539.   "*Local time zone. Both styles, \"JST\" and +0900 are acceptable.
  540. If its value is non-nil, valid Date: field will be generated in terms
  541. of RFC822.  In this case, timezone package must be installed.")
  542.  
  543. (defvar gnus-local-domain nil
  544.   "*Your domain name without your host name like: \"stars.flab.Fujitsu.CO.JP\"
  545. The `DOMAINNAME' environment variable is used instead if defined.  If
  546. the function (system-name) returns the full internet name, there is no
  547. need to define the name.")
  548.  
  549. (defvar gnus-local-organization nil
  550.   "*Your organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\"
  551. The `ORGANIZATION' environment variable is used instead if defined.")
  552.  
  553. (defvar gnus-use-generic-from nil
  554.   "*If nil, prepend local host name to the defined domain in the From:
  555. field; if stringp, use this; if non-nil, strip of the local host name.")
  556.  
  557. (defvar gnus-use-generic-path nil
  558.   "*If nil, use the NNTP server name in the Path: field; if stringp,
  559. use this; if non-nil, use no host name (user name only)")
  560.  
  561. (defvar gnus-Info-directory (car Info-directory-list)
  562.   "*A directory placing an Info file of GNUS.")
  563.  
  564.  
  565. ;; Internal variables.
  566.  
  567. (defconst gnus-version "GNUS 3.14.Lucid"
  568.   "Version numbers of this version of GNUS.")
  569.  
  570. (defvar gnus-Info-nodes
  571.   '((gnus-Group-mode . "(gnus)Newsgroup Commands")
  572.     (gnus-Subject-mode . "(gnus)Subject Commands")
  573.     (gnus-Article-mode . "(gnus)Article Commands")
  574.     (gnus-Kill-file-mode . "(gnus)KILL File")
  575.     (gnus-Browse-killed-mode . "(gnus)Maintenance"))
  576.   "Assoc list of major modes and related Info nodes.")
  577.  
  578. (defvar gnus-access-methods
  579.   '((nntp
  580.      (gnus-retrieve-headers .    nntp-retrieve-headers)
  581.      (gnus-open-server .    nntp-open-server)
  582.      (gnus-close-server .    nntp-close-server)
  583.      (gnus-server-opened .    nntp-server-opened)
  584.      (gnus-status-message .    nntp-status-message)
  585.      (gnus-request-article .    nntp-request-article)
  586.      (gnus-request-group .    nntp-request-group)
  587.      (gnus-request-list .    nntp-request-list)
  588.      (gnus-request-post .    nntp-request-post))
  589.     (nnspool
  590.      (gnus-retrieve-headers .    nnspool-retrieve-headers)
  591.      (gnus-open-server .    nnspool-open-server)
  592.      (gnus-close-server .    nnspool-close-server)
  593.      (gnus-server-opened .    nnspool-server-opened)
  594.      (gnus-status-message .    nnspool-status-message)
  595.      (gnus-request-article .    nnspool-request-article)
  596.      (gnus-request-group .    nnspool-request-group)
  597.      (gnus-request-list .    nnspool-request-list)
  598.      (gnus-request-post .    nnspool-request-post))
  599.     (mhspool
  600.      (gnus-retrieve-headers .    mhspool-retrieve-headers)
  601.      (gnus-open-server .    mhspool-open-server)
  602.      (gnus-close-server .    mhspool-close-server)
  603.      (gnus-server-opened .    mhspool-server-opened)
  604.      (gnus-status-message .    mhspool-status-message)
  605.      (gnus-request-article .    mhspool-request-article)
  606.      (gnus-request-group .    mhspool-request-group)
  607.      (gnus-request-list .    mhspool-request-list)
  608.      (gnus-request-post .    mhspool-request-post)))
  609.   "Access method for NNTP, nnspool, and mhspool.")
  610.  
  611. (defvar gnus-Group-buffer "*Newsgroup*")
  612. (defvar gnus-Subject-buffer "*Subject*")
  613. (defvar gnus-Article-buffer "*Article*")
  614. (defvar gnus-Digest-buffer "GNUS Digest")
  615. (defvar gnus-Digest-summary-buffer "GNUS Digest-summary")
  616.  
  617. (defvar gnus-buffer-list
  618.   (list gnus-Group-buffer gnus-Subject-buffer gnus-Article-buffer
  619.     gnus-Digest-buffer gnus-Digest-summary-buffer)
  620.   "GNUS buffer names which should be killed when exiting.")
  621.  
  622. (defvar gnus-variable-list
  623.   '(gnus-newsrc-options
  624.     gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
  625.     gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)
  626.   "GNUS variables saved in the quick startup file.")
  627.  
  628. (defvar gnus-overload-functions
  629.   '((news-inews gnus-inews-news "rnewspost")
  630.     (caesar-region gnus-caesar-region "rnews"))
  631.   "Functions overloaded by gnus.
  632. It is a list of `(original overload &optional file)'.")
  633.  
  634. (defvar gnus-newsrc-options nil
  635.   "Options line in the .newsrc file.")
  636.  
  637. (defvar gnus-newsrc-options-n-yes nil
  638.   "Regexp representing subscribed newsgroups.")
  639.  
  640. (defvar gnus-newsrc-options-n-no nil
  641.   "Regexp representing unsubscribed newsgroups.")
  642.  
  643. (defvar gnus-newsrc-assoc nil
  644.   "Assoc list of read articles.")
  645.  
  646. (defvar gnus-killed-assoc nil
  647.   "Assoc list of newsgroups removed from gnus-newsrc-assoc.")
  648.  
  649. (defvar gnus-marked-assoc nil
  650.   "Assoc list of articles marked as unread.")
  651.  
  652. (defvar gnus-unread-hashtb nil
  653.   "Hashtable of unread articles.")
  654.  
  655. (defvar gnus-active-hashtb nil
  656.   "Hashtable of active articles.")
  657.  
  658. (defvar gnus-octive-hashtb nil
  659.   "Hashtable of OLD active articles.")
  660.  
  661. (defvar gnus-current-startup-file nil
  662.   "Startup file for the current host.")
  663.  
  664. (defvar gnus-last-search-regexp nil
  665.   "Default regexp for article search command.")
  666.  
  667. (defvar gnus-last-shell-command nil
  668.   "Default shell command on article.")
  669.  
  670. (defvar gnus-have-all-newsgroups nil)
  671.  
  672. (defvar gnus-newsgroup-name nil)
  673. (defvar gnus-newsgroup-begin nil)
  674. (defvar gnus-newsgroup-end nil)
  675. (defvar gnus-newsgroup-last-rmail nil)
  676. (defvar gnus-newsgroup-last-mail nil)
  677. (defvar gnus-newsgroup-last-folder nil)
  678. (defvar gnus-newsgroup-last-file nil)
  679.  
  680. (defvar gnus-newsgroup-unreads nil
  681.   "List of unread articles in the current newsgroup.")
  682.  
  683. (defvar gnus-newsgroup-unselected nil
  684.   "List of unselected unread articles in the current newsgroup.")
  685.  
  686. (defvar gnus-newsgroup-marked nil
  687.   "List of marked articles in the current newsgroup (a subset of unread art).")
  688.  
  689. (defvar gnus-newsgroup-headers nil
  690.   "List of article headers in the current newsgroup.
  691. If the varialbe is modified (added or deleted), the function
  692. gnus-clear-hashtables-for-newsgroup-headers must be called to clear
  693. the hash tables.")
  694. (defvar gnus-newsgroup-headers-hashtb-by-id nil)
  695. (defvar gnus-newsgroup-headers-hashtb-by-number nil)
  696.  
  697. (defvar gnus-current-article nil)
  698. (defvar gnus-current-headers nil)
  699. (defvar gnus-current-history nil)
  700. (defvar gnus-have-all-headers nil)
  701. (defvar gnus-last-article nil)
  702. (defvar gnus-current-kill-article nil)
  703.  
  704. ;; Save window configuration.
  705. (defvar gnus-winconf-kill-file nil)
  706.  
  707. (defvar gnus-Group-mode-map nil)
  708. (defvar gnus-Subject-mode-map nil)
  709. (defvar gnus-Article-mode-map nil)
  710. (defvar gnus-Kill-file-mode-map nil)
  711.  
  712. (defvar rmail-last-file (expand-file-name "~/XMBOX"))
  713. (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
  714.  
  715. ;; Define GNUS Subsystems.
  716. (autoload 'gnus-Subject-read-digest "gnus-digest"
  717.        "Expand the current message as a digest" t)
  718. (autoload 'gnus-Group-post-news "gnuspost"
  719.       "Post an article." t)
  720. (autoload 'gnus-Subject-post-news "gnuspost"
  721.       "Post an article." t)
  722. (autoload 'gnus-Subject-post-reply "gnuspost"
  723.       "Post a reply article." t)
  724. (autoload 'gnus-Subject-post-reply-with-original "gnuspost"
  725.       "Post a reply article with original article." t)
  726. (autoload 'gnus-Subject-cancel-article "gnuspost"
  727.       "Cancel an article you posted." t)
  728.  
  729. (autoload 'gnus-Subject-mail-reply "gnusmail"
  730.       "Reply mail to news author." t)
  731. (autoload 'gnus-Subject-mail-reply-with-original "gnusmail"
  732.       "Reply mail to news author with original article." t)
  733. (autoload 'gnus-Subject-mail-forward "gnusmail"
  734.       "Forward the current message to another user." t)
  735. (autoload 'gnus-Subject-mail-other-window "gnusmail"
  736.       "Compose mail in other window." t)
  737.  
  738. (autoload 'gnus-Group-kill-region "gnusmisc"
  739.       "Kill newsgroups in current region." t)
  740. (autoload 'gnus-Group-kill-group "gnusmisc"
  741.       "Kill newsgroup on current line." t)
  742. (autoload 'gnus-Group-yank-group "gnusmisc"
  743.       "Yank the last killed newsgroup on current line." t)
  744. (autoload 'gnus-Browse-killed-groups "gnusmisc"
  745.       "Browse the killed newsgroups." t)
  746. (autoload 'gnus-gmt-to-local "gnusmisc"
  747.       "Rewrite Date field in GMT to local in current buffer.")
  748.  
  749. (autoload 'timezone-make-sortable-date "timezone")
  750. (autoload 'timezone-parse-date "timezone")
  751.  
  752. (autoload 'rmail-output "rmailout"
  753.       "Append this message to Unix mail file named FILE-NAME." t)
  754. (autoload 'mail-position-on-field "sendmail")
  755. (autoload 'mh-find-path "mh-e")
  756. (autoload 'mh-prompt-for-folder "mh-e")
  757.  
  758. (put 'gnus-Group-mode 'mode-class 'special)
  759. (put 'gnus-Subject-mode 'mode-class 'special)
  760. (put 'gnus-Article-mode 'mode-class 'special)
  761.  
  762.  
  763. ;;(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
  764.  
  765. (defun gnus-pop-to-buffer (buffer)
  766.   (let ((pre-display-buffer-function nil)) ; don't use a new screen
  767.     (pop-to-buffer buffer)))
  768.  
  769. (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
  770.   "Pop to BUFFER, evaluate FORMS, and then returns to original window."
  771.   (` (let ((GNUSStartBufferWindow (selected-window)))
  772.        (unwind-protect
  773.        (progn
  774.          (gnus-pop-to-buffer (, buffer))
  775.          (,@ forms))
  776.      (select-window GNUSStartBufferWindow)))))
  777.  
  778. (defmacro gnus-make-hashtable ()
  779.   '(make-abbrev-table))
  780.  
  781. (defmacro gnus-gethash (string hashtable)
  782.   "Get hash value of STRING in HASHTABLE."
  783.   ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
  784.   (` (abbrev-expansion (, string) (, hashtable))))
  785.  
  786. (defmacro gnus-sethash (string value hashtable)
  787.   "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
  788.   ;; We cannot use define-abbrev since it only accepts string as value.
  789.   (` (set (intern (, string) (, hashtable)) (, value))))
  790.  
  791. ;; Note: Macros defined here are also defined in nntp.el. I don't like
  792. ;; to put them here, but many users got troubled with the old
  793. ;; definitions in nntp.elc. These codes are NNTP 3.10 version.
  794.  
  795. (defmacro nntp-header-number (header)
  796.   "Return article number in HEADER."
  797.   (` (aref (, header) 0)))
  798.  
  799. (defmacro nntp-set-header-number (header number)
  800.   "Set article number of HEADER to NUMBER."
  801.   (` (aset (, header) 0 (, number))))
  802.  
  803. (defmacro nntp-header-subject (header)
  804.   "Return subject string in HEADER."
  805.   (` (aref (, header) 1)))
  806.  
  807. (defmacro nntp-set-header-subject (header subject)
  808.   "Set article subject of HEADER to SUBJECT."
  809.   (` (aset (, header) 1 (, subject))))
  810.  
  811. (defmacro nntp-header-from (header)
  812.   "Return author string in HEADER."
  813.   (` (aref (, header) 2)))
  814.  
  815. (defmacro nntp-set-header-from (header from)
  816.   "Set article author of HEADER to FROM."
  817.   (` (aset (, header) 2 (, from))))
  818.  
  819. (defmacro nntp-header-xref (header)
  820.   "Return xref string in HEADER."
  821.   (` (aref (, header) 3)))
  822.  
  823. (defmacro nntp-set-header-xref (header xref)
  824.   "Set article xref of HEADER to xref."
  825.   (` (aset (, header) 3 (, xref))))
  826.  
  827. (defmacro nntp-header-lines (header)
  828.   "Return lines in HEADER."
  829.   (` (aref (, header) 4)))
  830.  
  831. (defmacro nntp-set-header-lines (header lines)
  832.   "Set article lines of HEADER to LINES."
  833.   (` (aset (, header) 4 (, lines))))
  834.  
  835. (defmacro nntp-header-date (header)
  836.   "Return date in HEADER."
  837.   (` (aref (, header) 5)))
  838.  
  839. (defmacro nntp-set-header-date (header date)
  840.   "Set article date of HEADER to DATE."
  841.   (` (aset (, header) 5 (, date))))
  842.  
  843. (defmacro nntp-header-id (header)
  844.   "Return Id in HEADER."
  845.   (` (aref (, header) 6)))
  846.  
  847. (defmacro nntp-set-header-id (header id)
  848.   "Set article Id of HEADER to ID."
  849.   (` (aset (, header) 6 (, id))))
  850.  
  851. (defmacro nntp-header-references (header)
  852.   "Return references in HEADER."
  853.   (` (aref (, header) 7)))
  854.  
  855. (defmacro nntp-set-header-references (header ref)
  856.   "Set article references of HEADER to REF."
  857.   (` (aset (, header) 7 (, ref))))
  858.  
  859.  
  860. ;;;
  861. ;;; GNUS Group Mode
  862. ;;;
  863.  
  864. (if gnus-Group-mode-map
  865.     nil
  866.   (setq gnus-Group-mode-map (make-keymap))
  867.   (suppress-keymap gnus-Group-mode-map)
  868.   (define-key gnus-Group-mode-map " " 'gnus-Group-read-group)
  869.   (define-key gnus-Group-mode-map "=" 'gnus-Group-select-group)
  870.   (define-key gnus-Group-mode-map "j" 'gnus-Group-jump-to-group)
  871.   (define-key gnus-Group-mode-map "n" 'gnus-Group-next-unread-group)
  872.   (define-key gnus-Group-mode-map "p" 'gnus-Group-prev-unread-group)
  873.   (define-key gnus-Group-mode-map "\177" 'gnus-Group-prev-unread-group)
  874.   (define-key gnus-Group-mode-map "N" 'gnus-Group-next-group)
  875.   (define-key gnus-Group-mode-map "P" 'gnus-Group-prev-group)
  876.   (define-key gnus-Group-mode-map "\C-n" 'gnus-Group-next-group)
  877.   (define-key gnus-Group-mode-map "\C-p" 'gnus-Group-prev-group)
  878.   (define-key gnus-Group-mode-map "\r" 'next-line)
  879.   (define-key gnus-Group-mode-map "/" 'isearch-forward)
  880.   (define-key gnus-Group-mode-map "<" 'beginning-of-buffer)
  881.   (define-key gnus-Group-mode-map ">" 'end-of-buffer)
  882.   (define-key gnus-Group-mode-map "u" 'gnus-Group-unsubscribe-current-group)
  883.   (define-key gnus-Group-mode-map "U" 'gnus-Group-unsubscribe-group)
  884.   (define-key gnus-Group-mode-map "c" 'gnus-Group-catch-up)
  885.   (define-key gnus-Group-mode-map "C" 'gnus-Group-catch-up-all)
  886.   (define-key gnus-Group-mode-map "l" 'gnus-Group-list-groups)
  887.   (define-key gnus-Group-mode-map "L" 'gnus-Group-list-all-groups)
  888.   (define-key gnus-Group-mode-map "g" 'gnus-Group-get-new-news)
  889.   (define-key gnus-Group-mode-map "R" 'gnus-Group-restart)
  890.   (define-key gnus-Group-mode-map "b" 'gnus-Group-check-bogus-groups)
  891.   (define-key gnus-Group-mode-map "r" 'gnus-Group-restrict-groups)
  892.   (define-key gnus-Group-mode-map "a" 'gnus-Group-post-news)
  893.   (define-key gnus-Group-mode-map "\ek" 'gnus-Group-edit-local-kill)
  894.   (define-key gnus-Group-mode-map "\eK" 'gnus-Group-edit-global-kill)
  895.   (define-key gnus-Group-mode-map "\C-w" 'gnus-Group-kill-region)
  896.   (define-key gnus-Group-mode-map "\C-k" 'gnus-Group-kill-group)
  897.   (define-key gnus-Group-mode-map "\C-y" 'gnus-Group-yank-group)
  898.   (define-key gnus-Group-mode-map "\C-c\C-y" 'gnus-Browse-killed-groups)
  899.   (define-key gnus-Group-mode-map "V" 'gnus-version)
  900.   (define-key gnus-Group-mode-map "x" 'gnus-Group-force-update)
  901.   (define-key gnus-Group-mode-map "s" 'gnus-Group-force-update)
  902.   (define-key gnus-Group-mode-map "z" 'gnus-Group-suspend)
  903.   (define-key gnus-Group-mode-map "q" 'gnus-Group-exit)
  904.   (define-key gnus-Group-mode-map "Q" 'gnus-Group-quit)
  905.   (define-key gnus-Group-mode-map "?" 'gnus-Group-describe-briefly)
  906.   (define-key gnus-Group-mode-map "\C-c\C-i" 'gnus-Info-find-node))
  907.  
  908. (defun gnus-Group-mode ()
  909.   "Major mode for reading network news.
  910. All normal editing commands are turned off.
  911. Instead, these commands are available:
  912.  
  913. SPC    Read articles in this newsgroup.
  914. =    Select this newsgroup.
  915. j    Move to the specified newsgroup.
  916. n    Move to the next unread newsgroup.
  917. p    Move to the previous unread newsgroup.
  918. C-n    Move to the next newsgroup.
  919. C-p    Move to the previous newsgroup.
  920. /    Do an incremental search forward.
  921. <    Move point to the beginning of this buffer.
  922. >    Move point to the end of this buffer.
  923. u    Unsubscribe from (subscribe to) this newsgroup.
  924. U    Unsubscribe from (subscribe to) the specified newsgroup.
  925. c    Mark all articles as read, preserving marked articles.
  926. C    Mark all articles in this newsgroup as read.
  927. l    Revert this buffer.
  928. L    List all newsgroups.
  929. g    Get new news.
  930. R    Force to read the raw .newsrc file and get new news.
  931. b    Check bogus newsgroups.
  932. r    Restrict visible newsgroups to the current region.
  933. a    Post a new article.
  934. ESC k    Edit a local KILL file applied to this newsgroup.
  935. ESC K    Edit a global KILL file applied to all newsgroups.
  936. C-w    Kill newsgroups in current region (excluding current point).
  937. C-k    Kill this newsgroup.
  938. C-y    Yank killed newsgroup here.
  939. C-c C-y    Browse killed newsgroups.
  940. s    Save .newsrc file.
  941. z    Suspend reading news.
  942. q    Quit reading news.
  943. Q    Quit reading news without saving .newsrc file.
  944. V    Show the version number of this GNUS.
  945. ?    Describe Group Mode commands briefly.
  946. C-h m    Describe Group Mode.
  947. C-c C-i    Read Info about Group Mode.
  948.  
  949.   The name of the host running NNTP server is asked for if no default
  950. host is specified. It is also possible to choose another NNTP server
  951. even when the default server is defined by giving a prefix argument to
  952. the command `\\[gnus]'.
  953.  
  954.   If an NNTP server is preceded by a colon such as `:Mail', the user's
  955. private directory `~/Mail' is used as a news spool. This makes it
  956. possible to read mail stored in MH folders or articles saved by GNUS.
  957. File names of mail or articles must consist of only numeric
  958. characters. Otherwise, they are ignored.
  959.  
  960.   If there is a file named `~/.newsrc-SERVER', it is used as the
  961. startup file instead of standard one when talking to SERVER.  It is
  962. possible to talk to many hosts by using different startup files for
  963. each.
  964.  
  965.   Option `-n' of the options line in the startup file is recognized
  966. properly the same as the Bnews system. For example, if the options
  967. line is `options -n !talk talk.rumors', newsgroups under the `talk'
  968. hierarchy except for `talk.rumors' are ignored while checking new
  969. newsgroups.
  970.  
  971.   If there is a file named `~/.signature-DISTRIBUTION', it is used as
  972. signature file instead of standard one when posting a news in
  973. DISTRIBUTION.
  974.  
  975.   If an Info file generated from `gnus.texinfo' is installed, you can
  976. read an appropriate Info node of the Info file according to the
  977. current major mode of GNUS by \\[gnus-Info-find-node].
  978.  
  979.   The variable `gnus-version', `nntp-version', `nnspool-version', and
  980. `mhspool-version' have the version numbers of this version of gnus.el,
  981. nntp.el, nnspool.el, and mhspoo.el, respectively.
  982.  
  983. User customizable variables:
  984.  gnus-nntp-server
  985.     Specifies the name of the host running the NNTP server. If its
  986.     value is a string such as `:DIRECTORY', the user's private
  987.     DIRECTORY is used as a news spool. The variable is initialized
  988.     from the NNTPSERVER environment variable.
  989.  
  990.  gnus-nntp-service
  991.     Specifies a NNTP service name. It is usually \"nntp\" or 119.  Nil
  992.     forces GNUS to use a local news spool if the variable
  993.     `gnus-nntp-server' is set to the local host name.
  994.  
  995.  gnus-startup-file
  996.     Specifies a startup file (.newsrc). If there is a file named
  997.     `.newsrc-SERVER', it's used instead when talking to SERVER. I
  998.     recommend you to use the server specific file, if you'd like to
  999.     talk to many servers.  Especially if you'd like to read your
  1000.     private directory, the name of the file must be
  1001.     `.newsrc-:DIRECTORY'.
  1002.  
  1003.  gnus-signature-file
  1004.     Specifies a signature file (.signature). If there is a file named
  1005.     `.signature-DISTRIBUTION', it's used instead when posting an
  1006.     article in DISTRIBUTION. Set the variable to nil to prevent
  1007.     appending the file automatically. If you use an NNTP inews which
  1008.     comes with the NNTP package, you may have to set the variable to
  1009.     nil.
  1010.  
  1011.  gnus-use-cross-reference
  1012.     Specifies what to do with cross references (Xref: field).  If it
  1013.     is nil, cross references are ignored.  If it is t, articles in
  1014.     subscribed newsgroups are only marked as read.  Otherwise, if it
  1015.     is not nil nor t, articles in all newsgroups are marked as read.
  1016.  
  1017.  gnus-use-followup-to
  1018.     Specifies what to do with followup-to: field.  If it is nil, its
  1019.     value is ignored.  If it is non-nil, its value is used as followup
  1020.     newsgroups.  Especially, if it is t and field value is `poster',
  1021.     your confirmation is required.
  1022.  
  1023.  gnus-author-copy
  1024.     Specifies a file name to save a copy of article you posted using
  1025.     FCC: field.  If the first character of the value is `|', the
  1026.     contents of the article is piped out to a program specified by the
  1027.     rest of the value.  The variable is initialized from the
  1028.     AUTHORCOPY environment variable.
  1029.  
  1030.  gnus-author-copy-saver
  1031.     Specifies a function to save an author copy.  The function is
  1032.     called with a file name.  The default function `gnus-rmail-output'
  1033.     saves in Unix mail format.
  1034.  
  1035.  gnus-kill-file-name
  1036.     Use specified file name as a KILL file (default to `KILL').
  1037.  
  1038.  gnus-novice-user
  1039.     Non-nil means that you are a novice to USENET.  If non-nil,
  1040.     verbose messages may be displayed or your confirmations may be
  1041.     required.
  1042.  
  1043.  gnus-interactive-post
  1044.     Non-nil means that newsgroup, subject and distribution are asked
  1045.     for interactively when posting a new article.
  1046.  
  1047.  gnus-use-full-window
  1048.     Non-nil means to take up the entire screen of Emacs.
  1049.  
  1050.  gnus-window-configuration
  1051.     Specifies the configuration of Group, Subject, and Article
  1052.     windows.  It is a list of (ACTION (G S A)), where G, S, and A are
  1053.     the relative height of Group, Subject, and Article windows,
  1054.     respectively.  ACTION is `SelectNewsgroup', `ExitNewsgroup',
  1055.     `SelectArticle', or `ExpandSubject'.
  1056.  
  1057.  gnus-subscribe-newsgroup-method
  1058.     Specifies a function called with a newsgroup name when new
  1059.     newsgroup is found.  The default definition adds new newsgroup at
  1060.     the beginning of other newsgroups.
  1061.  
  1062. Various hooks for customization:
  1063.  gnus-Group-mode-hook
  1064.     Entry to this mode calls the value with no arguments, if that
  1065.     value is non-nil. This hook is called before GNUS is connected to
  1066.     the NNTP server. So, you can change or define the NNTP server in
  1067.     this hook.
  1068.  
  1069.  gnus-Startup-hook
  1070.     Called with no arguments after the NNTP server is selected. It is
  1071.     possible to change the behavior of GNUS or initialize the
  1072.     variables according to the selected NNTP server.
  1073.  
  1074.  gnus-Group-prepare-hook
  1075.     Called with no arguments after a newsgroup list is created in the
  1076.     Newsgroup buffer, if that value is non-nil.
  1077.  
  1078.  gnus-Save-newsrc-hook
  1079.     Called with no arguments when saving newsrc file if that value is
  1080.     non-nil.
  1081.  
  1082.  gnus-Inews-article-hook
  1083.     Called with no arguments when posting an article if that value is
  1084.     non-nil. This hook is called just before posting an article, while
  1085.     news-inews-hook is called before preparing article headers. If
  1086.     you'd like to convert kanji code of the article, this hook is recommended.
  1087.  
  1088.  gnus-Suspend-gnus-hook
  1089.     Called with no arguments when suspending (not exiting) GNUS, if
  1090.     that value is non-nil.
  1091.  
  1092.  gnus-Exit-gnus-hook
  1093.     Called with no arguments when exiting (not suspending) GNUS, if
  1094.     that value is non-nil."
  1095.   (interactive)
  1096.   (kill-all-local-variables)
  1097.   ;; Gee.  Why don't you upgrade?
  1098.   (cond ((boundp 'mode-line-modified)
  1099.      (setq mode-line-modified "--- "))
  1100.     ((listp (default-value 'mode-line-format))
  1101.      (setq mode-line-format
  1102.            (cons "--- " (cdr (default-value 'mode-line-format)))))
  1103.     (t
  1104.      (setq mode-line-format
  1105.            "--- GNUS: List of Newsgroups  %[(%m)%]----%3p-%-")))
  1106.   (setq major-mode 'gnus-Group-mode)
  1107.   (setq mode-name "Newsgroup")
  1108.   (setq mode-line-buffer-identification    "GNUS: List of Newsgroups")
  1109.   (setq mode-line-process nil)
  1110.   (use-local-map gnus-Group-mode-map)
  1111.   (buffer-disable-undo (current-buffer))
  1112.   (setq buffer-read-only t)        ;Disable modification
  1113.   (run-hooks 'gnus-Group-mode-hook))
  1114.  
  1115. ;;;###autoload
  1116. (defun gnus (&optional confirm)
  1117.   "Read network news.
  1118. If optional argument CONFIRM is non-nil, ask NNTP server."
  1119.   (interactive "P")
  1120.   ;; Might as well build this in so that people know it exists :-)
  1121.   (if (string-match "Lucid" emacs-version) (require 'gnus-lucid))
  1122.   (unwind-protect
  1123.       (progn
  1124.     (switch-to-buffer (get-buffer-create gnus-Group-buffer))
  1125.     (gnus-Group-mode)
  1126.     (gnus-start-news-server confirm))
  1127.     (if (not (gnus-server-opened))
  1128.     (gnus-Group-quit)
  1129.       ;; NNTP server is successfully open. 
  1130.       (setq mode-line-process (format " {%s}" gnus-nntp-server))
  1131.       (let ((buffer-read-only nil))
  1132.     (erase-buffer)
  1133.     (gnus-Group-startup-message)
  1134.     (sit-for 0))
  1135.       (run-hooks 'gnus-Startup-hook)
  1136.       (gnus-setup-news-info)
  1137.       (if gnus-novice-user
  1138.       (gnus-Group-describe-briefly)) ;Show brief help message.
  1139.       (gnus-Group-list-groups nil)
  1140.       )))
  1141.  
  1142. (defun gnus-Group-startup-message ()
  1143.   "Insert startup message in current buffer."
  1144.   ;; Insert the message.
  1145.   (insert "
  1146.                    GNUS Version 3.14.Lucid
  1147.  
  1148.          NNTP-based News Reader for GNU Emacs
  1149.  
  1150.  
  1151. If you have any trouble with this software, please let me
  1152. know. I will fix your problems in the next release.
  1153.  
  1154. Comments, suggestions, and bug fixes are welcome.
  1155.  
  1156. Masanobu UMEDA
  1157. umerin@mse.kyutech.ac.jp")
  1158.   ;; And then hack it.
  1159.   ;; 57 is the longest line.
  1160.   (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2))
  1161.   (goto-char (point-min))
  1162.   ;; +4 is fuzzy factor.
  1163.   (insert-char ?\n (/ (max (- (window-height) 18) 0) 2)))
  1164.  
  1165. (defun gnus-Group-list-groups (show-all)
  1166.   "List newsgroups in the Newsgroup buffer.
  1167. If argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
  1168.   (interactive "P")
  1169.   (let ((last-group            ;Current newsgroup.
  1170.      (gnus-Group-group-name))
  1171.     (next-group            ;Next possible newsgroup.
  1172.      (progn
  1173.        (gnus-Group-search-forward nil nil)
  1174.        (gnus-Group-group-name)))
  1175.     (prev-group            ;Previous possible newsgroup.
  1176.      (progn
  1177.        (gnus-Group-search-forward t nil)
  1178.        (gnus-Group-group-name))))
  1179.     (gnus-Group-prepare show-all)
  1180.     (if (zerop (buffer-size))
  1181.     (message "No news is good news")
  1182.       ;; Go to last newsgroup if possible.  If cannot, try next and
  1183.       ;; previous.  If all fail, go to first unread newsgroup.
  1184.       (goto-char (point-min))
  1185.       (or (and last-group
  1186.            (re-search-forward
  1187.         (concat "^.+: " (regexp-quote last-group) "$") nil t))
  1188.       (and next-group
  1189.            (re-search-forward
  1190.         (concat "^.+: " (regexp-quote next-group) "$") nil t))
  1191.       (and prev-group
  1192.            (re-search-forward
  1193.         (concat "^.+: " (regexp-quote prev-group) "$") nil t))
  1194.       (re-search-forward "^[ \t]+[1-9][0-9]*:" nil t))
  1195.       ;; Adjust cursor point.
  1196.       (beginning-of-line)
  1197.       (search-forward ":" nil t)
  1198.       )))
  1199.  
  1200. (defun gnus-Group-prepare (&optional all)
  1201.   "Prepare list of newsgroups in current buffer.
  1202. If optional argument ALL is non-nil, unsubscribed groups are also listed."
  1203.   (let ((buffer-read-only nil)
  1204.     (newsrc gnus-newsrc-assoc)
  1205.     (group-info nil)
  1206.     (group-name nil)
  1207.     (unread-count 0)
  1208.     ;; This specifies the format of Group buffer.
  1209.     (cntl "%s%s%5d: %s\n"))
  1210.     (erase-buffer)
  1211.     ;; List newsgroups.
  1212.     (while newsrc
  1213.       (setq group-info (car newsrc))
  1214.       (setq group-name (car group-info))
  1215.       (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
  1216.       (if (or all
  1217.           (and (nth 1 group-info)    ;Subscribed.
  1218.            (> unread-count 0)))    ;There are unread articles.
  1219.       ;; Yes, I can use gnus-Group-prepare-line, but this is faster.
  1220.       (insert
  1221.        (format cntl
  1222.            ;; Subscribed or not.
  1223.            (if (nth 1 group-info) " " "U")
  1224.            ;; Has new news?
  1225.            (if (and (> unread-count 0)
  1226.                 (>= 0
  1227.                 (- unread-count
  1228.                    (length
  1229.                     (cdr (assoc group-name
  1230.                         gnus-marked-assoc))))))
  1231.                "*" " ")
  1232.            ;; Number of unread articles.
  1233.            unread-count
  1234.            ;; Newsgroup name.
  1235.            group-name))
  1236.     )
  1237.       (setq newsrc (cdr newsrc))
  1238.       )
  1239.     (setq gnus-have-all-newsgroups all)
  1240.     (goto-char (point-min))
  1241.     (run-hooks 'gnus-Group-prepare-hook)
  1242.     ))
  1243.  
  1244. (defun gnus-Group-prepare-line (info)
  1245.   "Return a string for the Newsgroup buffer from INFO.
  1246. INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
  1247.   (let* ((group-name (car info))
  1248.      (unread-count
  1249.       (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
  1250.           ;; Not in hash table, so compute it now.
  1251.           (gnus-number-of-articles
  1252.            (gnus-difference-of-range
  1253.         (nth 2 (gnus-gethash group-name gnus-active-hashtb))
  1254.         (nthcdr 2 info)))))
  1255.      ;; This specifies the format of Group buffer.
  1256.      (cntl "%s%s%5d: %s\n"))
  1257.     (format cntl
  1258.         ;; Subscribed or not.
  1259.         (if (nth 1 info) " " "U")
  1260.         ;; Has new news?
  1261.         (if (and (> unread-count 0)
  1262.              (>= 0
  1263.              (- unread-count
  1264.                 (length
  1265.                  (cdr (assoc group-name gnus-marked-assoc))))))
  1266.         "*" " ")
  1267.         ;; Number of unread articles.
  1268.         unread-count
  1269.         ;; Newsgroup name.
  1270.         group-name
  1271.         )))
  1272.  
  1273. (defun gnus-Group-update-group (group &optional visible-only)
  1274.   "Update newsgroup info of GROUP.
  1275. If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
  1276.   (let ((buffer-read-only nil)
  1277.     (visible nil))
  1278.     ;; Buffer may be narrowed.
  1279.     (save-restriction
  1280.       (widen)
  1281.       ;; Search point to modify.
  1282.       (goto-char (point-min))
  1283.       (if (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
  1284.       ;; GROUP is listed in current buffer. So, delete old line.
  1285.       (progn
  1286.         (setq visible t)
  1287.         (beginning-of-line)
  1288.         (delete-region (point) (progn (forward-line 1) (point)))
  1289.         ))
  1290.       (if (or visible (not visible-only))
  1291.       (progn
  1292.         (insert (gnus-Group-prepare-line (assoc group gnus-newsrc-assoc)))
  1293.         (forward-line -1)        ;Move point on that line.
  1294.         ))
  1295.       )))
  1296.  
  1297. ;; GNUS Group mode command
  1298.  
  1299. (defun gnus-Group-group-name ()
  1300.   "Get newsgroup name around point."
  1301.   (save-excursion
  1302.     (beginning-of-line)
  1303.     (if (looking-at ".[* \t]*[0-9]+:[ \t]+\\([^ \t\n]+\\)$")
  1304.     (buffer-substring (match-beginning 1) (match-end 1))
  1305.       )))
  1306.  
  1307. (defun gnus-Group-read-group (all &optional no-article)
  1308.   "Read news in this newsgroup.
  1309. If argument ALL is non-nil, already read articles become readable.
  1310. If optional argument NO-ARTICLE is non-nil, no article body is displayed."
  1311.   (interactive "P")
  1312.   (let ((group (gnus-Group-group-name))) ;Newsgroup name to read.
  1313.     (if group
  1314.     (gnus-Subject-read-group
  1315.      group
  1316.      (or all
  1317.          ;;(not (nth 1 (assoc group gnus-newsrc-assoc)))    ;Unsubscribed
  1318.          (zerop
  1319.           (nth 1 (gnus-gethash group gnus-unread-hashtb))))    ;No unread
  1320.      no-article
  1321.      ))
  1322.     ))
  1323.  
  1324. (defun gnus-Group-select-group (all)
  1325.   "Select this newsgroup.
  1326. No article is selected automatically.
  1327. If argument ALL is non-nil, already read articles become readable."
  1328.   (interactive "P")
  1329.   (gnus-Group-read-group all t))
  1330.  
  1331. (defun gnus-Group-jump-to-group (group)
  1332.   "Jump to newsgroup GROUP."
  1333.   (interactive
  1334.    (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
  1335.   (goto-char (point-min))
  1336.   (or (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
  1337.       (if (assoc group gnus-newsrc-assoc)
  1338.       ;; Add GROUP entry, then seach again.
  1339.       (gnus-Group-update-group group)))
  1340.   ;; Adjust cursor point.
  1341.   (beginning-of-line)
  1342.   (search-forward ":" nil t))
  1343.  
  1344. (defun gnus-Group-search-forward (backward any-group)
  1345.   "Search for newsgroup forward.
  1346. If 1st argument BACKWARD is non-nil, search backward instead.
  1347. If 2nd argument ANY-GROUP is non-nil, unsubscribed or empty group
  1348. may be selected."
  1349.   (let ((func (if backward 're-search-backward 're-search-forward))
  1350.     (regexp 
  1351.      (format "^%s[ \t]*\\(%s\\):"
  1352.          (if any-group ".." " [ \t]")
  1353.          (if any-group "[0-9]+" "[1-9][0-9]*")))
  1354.     (found nil))
  1355.     (if backward
  1356.     (beginning-of-line)
  1357.       (end-of-line))
  1358.     (setq found (funcall func regexp nil t))
  1359.     ;; Adjust cursor point.
  1360.     (beginning-of-line)
  1361.     (search-forward ":" nil t)
  1362.     ;; Return T if found.
  1363.     found
  1364.     ))
  1365.  
  1366. (defun gnus-Group-next-group (n)
  1367.   "Go to next N'th newsgroup."
  1368.   (interactive "p")
  1369.   (while (and (> n 1)
  1370.           (gnus-Group-search-forward nil t))
  1371.     (setq n (1- n)))
  1372.   (or (gnus-Group-search-forward nil t)
  1373.       (message "No more newsgroups")))
  1374.  
  1375. (defun gnus-Group-next-unread-group (n)
  1376.   "Go to next N'th unread newsgroup."
  1377.   (interactive "p")
  1378.   (while (and (> n 1)
  1379.           (gnus-Group-search-forward nil nil))
  1380.     (setq n (1- n)))
  1381.   (or (gnus-Group-search-forward nil nil)
  1382.       (message "No more unread newsgroups")))
  1383.  
  1384. (defun gnus-Group-prev-group (n)
  1385.   "Go to previous N'th newsgroup."
  1386.   (interactive "p")
  1387.   (while (and (> n 1)
  1388.           (gnus-Group-search-forward t t))
  1389.     (setq n (1- n)))
  1390.   (or (gnus-Group-search-forward t t)
  1391.       (message "No more newsgroups")))
  1392.  
  1393. (defun gnus-Group-prev-unread-group (n)
  1394.   "Go to previous N'th unread newsgroup."
  1395.   (interactive "p")
  1396.   (while (and (> n 1)
  1397.           (gnus-Group-search-forward t nil))          
  1398.     (setq n (1- n)))
  1399.   (or (gnus-Group-search-forward t nil)
  1400.       (message "No more unread newsgroups")))
  1401.  
  1402. (defun gnus-Group-catch-up (all &optional quietly)
  1403.   "Mark all articles not marked as unread in current newsgroup as read.
  1404. If prefix argument ALL is non-nil, all articles are marked as read.
  1405. Cross references (Xref: field) of articles are ignored."
  1406.   (interactive "P")
  1407.   (let* ((group (gnus-Group-group-name))
  1408.          (marked (if (not all)
  1409.              (cdr (assoc group gnus-marked-assoc)))))
  1410.     (and group
  1411.      (or quietly
  1412.          (y-or-n-p
  1413.           (if all
  1414.           "Do you really want to mark everything as read? "
  1415.         "Delete all articles not marked as read? ")))
  1416.      (progn
  1417.        (message "")            ;Erase "Yes or No" question.
  1418.        ;; Any marked articles will be preserved.
  1419.        (gnus-update-unread-articles group marked marked)
  1420.        (gnus-Group-update-group group)
  1421.        (gnus-Group-next-group 1)))
  1422.     ))
  1423.  
  1424. (defun gnus-Group-catch-up-all (&optional quietly)
  1425.   "Mark all articles in current newsgroup as read.
  1426. Cross references (Xref: field) of articles are ignored."
  1427.   (interactive)
  1428.   (gnus-Group-catch-up t quietly))
  1429.  
  1430. (defun gnus-Group-unsubscribe-current-group ()
  1431.   "Toggle subscribe from/to unsubscribe current group."
  1432.   (interactive)
  1433.   (gnus-Group-unsubscribe-group (gnus-Group-group-name))
  1434.   (gnus-Group-next-group 1))
  1435.  
  1436. (defun gnus-Group-unsubscribe-group (group)
  1437.   "Toggle subscribe from/to unsubscribe GROUP.
  1438. New newsgroup is added to .newsrc automatically."
  1439.   (interactive
  1440.    (list (completing-read "Newsgroup: "
  1441.               gnus-active-hashtb nil 'require-match)))
  1442.   (let ((newsrc (assoc group gnus-newsrc-assoc)))
  1443.     (cond ((not (null newsrc))
  1444.        ;; Toggle subscription flag.
  1445.        (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
  1446.        (gnus-update-newsrc-buffer group)
  1447.        (gnus-Group-update-group group)
  1448.        ;; Adjust cursor point.
  1449.        (beginning-of-line)
  1450.        (search-forward ":" nil t))
  1451.       ((and (stringp group)
  1452.         (gnus-gethash group gnus-active-hashtb))
  1453.        ;; Add new newsgroup.
  1454.        (gnus-add-newsgroup group)
  1455.        (gnus-Group-update-group group)
  1456.        ;; Adjust cursor point.
  1457.        (beginning-of-line)
  1458.        (search-forward ":" nil t))
  1459.       (t (error "No such newsgroup: %s" group)))
  1460.     ))
  1461.  
  1462. (defun gnus-Group-list-all-groups ()
  1463.   "List all of newsgroups in the Newsgroup buffer."
  1464.   (interactive)
  1465.   (gnus-Group-list-groups t))
  1466.  
  1467. (defun gnus-Group-get-new-news ()
  1468.   "Get newly arrived articles. In fact, read the active file again."
  1469.   (interactive)
  1470.   (gnus-setup-news-info)
  1471.   (gnus-Group-list-groups gnus-have-all-newsgroups))
  1472.  
  1473. (defun gnus-Group-restart ()
  1474.   "Force GNUS to read the raw startup file."
  1475.   (interactive)
  1476.   (gnus-save-newsrc-file)
  1477.   (gnus-setup-news-info t)        ;Force to read the raw startup file.
  1478.   (gnus-Group-list-groups gnus-have-all-newsgroups))
  1479.  
  1480. (defun gnus-Group-check-bogus-groups ()
  1481.   "Check bogus newsgroups."
  1482.   (interactive)
  1483.   (gnus-check-bogus-newsgroups t)    ;Require confirmation.
  1484.   (gnus-Group-list-groups gnus-have-all-newsgroups))
  1485.  
  1486. (defun gnus-Group-restrict-groups (start end)
  1487.   "Restrict visible newsgroups to the current region (START and END).
  1488. Type \\[widen] to remove restriction."
  1489.   (interactive "r")
  1490.   (save-excursion
  1491.     (narrow-to-region (progn
  1492.             (goto-char start)
  1493.             (beginning-of-line)
  1494.             (point))
  1495.               (progn
  1496.             (goto-char end)
  1497.             (forward-line 1)
  1498.             (point))))
  1499.   (message (substitute-command-keys "Type \\[widen] to remove restriction")))
  1500.  
  1501. (defun gnus-Group-edit-global-kill ()
  1502.   "Edit a global KILL file."
  1503.   (interactive)
  1504.   (setq gnus-current-kill-article nil)    ;No articles selected.
  1505.   (gnus-Kill-file-edit-file nil)     ;Nil stands for global KILL file.
  1506.   (message
  1507.    (substitute-command-keys
  1508.     "Editing a global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
  1509.  
  1510. (defun gnus-Group-edit-local-kill ()
  1511.   "Edit a local KILL file."
  1512.   (interactive)
  1513.   (setq gnus-current-kill-article nil)    ;No articles selected.
  1514.   (gnus-Kill-file-edit-file (gnus-Group-group-name))
  1515.   (message
  1516.    (substitute-command-keys
  1517.     "Editing a local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
  1518.  
  1519. (defun gnus-Group-force-update ()
  1520.   "Update .newsrc file."
  1521.   (interactive)
  1522.   (gnus-save-newsrc-file))
  1523.  
  1524. (defun gnus-Group-suspend ()
  1525.   "Suspend the current GNUS session.
  1526. In fact, cleanup buffers except for Group Mode buffer.
  1527. The hook gnus-Suspend-gnus-hook is called before actually suspending."
  1528.   (interactive)
  1529.   (run-hooks 'gnus-Suspend-gnus-hook)
  1530.   ;; Kill GNUS buffers except for Group Mode buffer.
  1531.   (let ((buffers gnus-buffer-list))
  1532.     (while buffers
  1533.       (and (not (eq (car buffers) gnus-Group-buffer))
  1534.        (get-buffer (car buffers))
  1535.        (kill-buffer (car buffers)))
  1536.       (setq buffers (cdr buffers))
  1537.       ))
  1538.   (bury-buffer))
  1539.  
  1540. (defun gnus-Group-exit ()
  1541.   "Quit reading news after updating .newsrc.
  1542. The hook gnus-Exit-gnus-hook is called before actually quitting."
  1543.   (interactive)
  1544.   (if (or noninteractive        ;For gnus-batch-kill
  1545.       (zerop (buffer-size))        ;No news is good news.
  1546.       (not (gnus-server-opened))    ;NNTP connection closed.
  1547.       (y-or-n-p "Are you sure you want to quit reading news? "))
  1548.       (progn
  1549.     (message "")            ;Erase "Yes or No" question.
  1550.     (run-hooks 'gnus-Exit-gnus-hook)
  1551.     (gnus-save-newsrc-file)
  1552.     (gnus-clear-system)
  1553.     (gnus-close-server))
  1554.     ))
  1555.  
  1556. (defun gnus-Group-quit ()
  1557.   "Quit reading news without updating .newsrc.
  1558. The hook gnus-Exit-gnus-hook is called before actually quitting."
  1559.   (interactive)
  1560.   (if (or (zerop (buffer-size))
  1561.       (not (gnus-server-opened))
  1562.       (yes-or-no-p
  1563.        (format "Quit reading news without saving %s? "
  1564.            (file-name-nondirectory gnus-current-startup-file))))
  1565.       (progn
  1566.     (message "")            ;Erase "Yes or No" question.
  1567.     (run-hooks 'gnus-Exit-gnus-hook)
  1568.     (gnus-clear-system)
  1569.     (gnus-close-server))
  1570.     ))
  1571.  
  1572. (defun gnus-Group-describe-briefly ()
  1573.   "Describe Group mode commands briefly."
  1574.   (interactive)
  1575.   (message
  1576.    (concat
  1577.     (substitute-command-keys "\\[gnus-Group-read-group]:Select  ")
  1578.     (substitute-command-keys "\\[gnus-Group-next-unread-group]:Forward  ")
  1579.     (substitute-command-keys "\\[gnus-Group-prev-unread-group]:Backward  ")
  1580.     (substitute-command-keys "\\[gnus-Group-exit]:Exit  ")
  1581.     (substitute-command-keys "\\[gnus-Info-find-node]:Run Info  ")
  1582.     (substitute-command-keys "\\[gnus-Group-describe-briefly]:This help")
  1583.     )))
  1584.  
  1585.  
  1586. ;;;
  1587. ;;; GNUS Subject Mode
  1588. ;;;
  1589.  
  1590. (if gnus-Subject-mode-map
  1591.     nil
  1592.   (setq gnus-Subject-mode-map (make-keymap))
  1593.   (suppress-keymap gnus-Subject-mode-map)
  1594.   (define-key gnus-Subject-mode-map " " 'gnus-Subject-next-page)
  1595.   (define-key gnus-Subject-mode-map "\177" 'gnus-Subject-prev-page)
  1596.   (define-key gnus-Subject-mode-map "\r" 'gnus-Subject-scroll-up)
  1597.   (define-key gnus-Subject-mode-map "n" 'gnus-Subject-next-unread-article)
  1598.   (define-key gnus-Subject-mode-map "p" 'gnus-Subject-prev-unread-article)
  1599.   (define-key gnus-Subject-mode-map "N" 'gnus-Subject-next-article)
  1600.   (define-key gnus-Subject-mode-map "P" 'gnus-Subject-prev-article)
  1601.   (define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-same-subject)
  1602.   (define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-same-subject)
  1603.   ;;(define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-unread-same-subject)
  1604.   ;;(define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-unread-same-subject)
  1605.   (define-key gnus-Subject-mode-map "\C-c\C-n" 'gnus-Subject-next-digest)
  1606.   (define-key gnus-Subject-mode-map "\C-c\C-p" 'gnus-Subject-prev-digest)
  1607.   (define-key gnus-Subject-mode-map "\C-n" 'gnus-Subject-next-subject)
  1608.   (define-key gnus-Subject-mode-map "\C-p" 'gnus-Subject-prev-subject)
  1609.   (define-key gnus-Subject-mode-map "\en" 'gnus-Subject-next-unread-subject)
  1610.   (define-key gnus-Subject-mode-map "\ep" 'gnus-Subject-prev-unread-subject)
  1611.   ;;(define-key gnus-Subject-mode-map "\C-cn" 'gnus-Subject-next-group)
  1612.   ;;(define-key gnus-Subject-mode-map "\C-cp" 'gnus-Subject-prev-group)
  1613.   (define-key gnus-Subject-mode-map "." 'gnus-Subject-first-unread-article)
  1614.   (define-key gnus-Subject-mode-map "/" 'isearch-forward)
  1615.   (define-key gnus-Subject-mode-map "s" 'gnus-Subject-isearch-article)
  1616.   (define-key gnus-Subject-mode-map "\es" 'gnus-Subject-search-article-forward)
  1617.   (define-key gnus-Subject-mode-map "\eS" 'gnus-Subject-search-article-backward)
  1618.   (define-key gnus-Subject-mode-map "<" 'gnus-Subject-beginning-of-article)
  1619.   (define-key gnus-Subject-mode-map ">" 'gnus-Subject-end-of-article)
  1620.   (define-key gnus-Subject-mode-map "j" 'gnus-Subject-goto-subject)
  1621.   (define-key gnus-Subject-mode-map "J" 'gnus-Subject-goto-article)
  1622.   (define-key gnus-Subject-mode-map "l" 'gnus-Subject-goto-last-article)
  1623.   (define-key gnus-Subject-mode-map "^" 'gnus-Subject-refer-parent-article)
  1624.   (define-key gnus-Subject-mode-map "\er" 'gnus-Subject-refer-article)
  1625.   (define-key gnus-Subject-mode-map "u" 'gnus-Subject-mark-as-unread-forward)
  1626.   (define-key gnus-Subject-mode-map "U" 'gnus-Subject-mark-as-unread-backward)
  1627.   (define-key gnus-Subject-mode-map "d" 'gnus-Subject-mark-as-read-forward)
  1628.   (define-key gnus-Subject-mode-map "D" 'gnus-Subject-mark-as-read-backward)
  1629.   (define-key gnus-Subject-mode-map "\eu" 'gnus-Subject-clear-mark-forward)
  1630.   (define-key gnus-Subject-mode-map "\eU" 'gnus-Subject-clear-mark-backward)
  1631.   (define-key gnus-Subject-mode-map "k" 'gnus-Subject-kill-same-subject-and-select)
  1632.   (define-key gnus-Subject-mode-map "\C-k" 'gnus-Subject-kill-same-subject)
  1633.   (define-key gnus-Subject-mode-map "\e\C-t" 'gnus-Subject-toggle-threads)
  1634.   (define-key gnus-Subject-mode-map "\e\C-s" 'gnus-Subject-show-thread)
  1635.   (define-key gnus-Subject-mode-map "\e\C-h" 'gnus-Subject-hide-thread)
  1636.   (define-key gnus-Subject-mode-map "\e\C-f" 'gnus-Subject-next-thread)
  1637.   (define-key gnus-Subject-mode-map "\e\C-b" 'gnus-Subject-prev-thread)
  1638.   (define-key gnus-Subject-mode-map "\e\C-u" 'gnus-Subject-up-thread)
  1639.   (define-key gnus-Subject-mode-map "\e\C-d" 'gnus-Subject-down-thread)
  1640.   (define-key gnus-Subject-mode-map "\e\C-k" 'gnus-Subject-kill-thread)
  1641.   (define-key gnus-Subject-mode-map "&" 'gnus-Subject-execute-command)
  1642.   ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up)
  1643.   ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-all)
  1644.   (define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-and-exit)
  1645.   ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-all-and-exit)
  1646.   (define-key gnus-Subject-mode-map "\C-t" 'gnus-Subject-toggle-truncation)
  1647.   (define-key gnus-Subject-mode-map "x" 'gnus-Subject-delete-marked-as-read)
  1648.   (define-key gnus-Subject-mode-map "X" 'gnus-Subject-delete-marked-with)
  1649.   (define-key gnus-Subject-mode-map "\C-c\C-sn" 'gnus-Subject-sort-by-number)
  1650.   (define-key gnus-Subject-mode-map "\C-c\C-sa" 'gnus-Subject-sort-by-author)
  1651.   (define-key gnus-Subject-mode-map "\C-c\C-ss" 'gnus-Subject-sort-by-subject)
  1652.   (define-key gnus-Subject-mode-map "\C-c\C-sd" 'gnus-Subject-sort-by-date)
  1653.   (define-key gnus-Subject-mode-map "\C-c\C-s\C-n" 'gnus-Subject-sort-by-number)
  1654.   (define-key gnus-Subject-mode-map "\C-c\C-s\C-a" 'gnus-Subject-sort-by-author)
  1655.   (define-key gnus-Subject-mode-map "\C-c\C-s\C-s" 'gnus-Subject-sort-by-subject)
  1656.   (define-key gnus-Subject-mode-map "\C-c\C-s\C-d" 'gnus-Subject-sort-by-date)
  1657.   (define-key gnus-Subject-mode-map "=" 'gnus-Subject-expand-window)
  1658.   (define-key gnus-Subject-mode-map "G" 'gnus-Subject-reselect-current-group)
  1659.   (define-key gnus-Subject-mode-map "w" 'gnus-Subject-stop-page-breaking)
  1660.   (define-key gnus-Subject-mode-map "\C-c\C-r" 'gnus-Subject-caesar-message)
  1661.   (define-key gnus-Subject-mode-map "g" 'gnus-Subject-show-article)
  1662.   (define-key gnus-Subject-mode-map "t" 'gnus-Subject-toggle-header)
  1663.   (define-key gnus-Subject-mode-map "v" 'gnus-Subject-show-all-headers)
  1664.   (define-key gnus-Subject-mode-map "\C-d" 'gnus-Subject-read-digest)
  1665.   (define-key gnus-Subject-mode-map "a" 'gnus-Subject-post-news)
  1666.   (define-key gnus-Subject-mode-map "f" 'gnus-Subject-post-reply)
  1667.   (define-key gnus-Subject-mode-map "F" 'gnus-Subject-post-reply-with-original)
  1668.   (define-key gnus-Subject-mode-map "C" 'gnus-Subject-cancel-article)
  1669.   (define-key gnus-Subject-mode-map "r" 'gnus-Subject-mail-reply)
  1670.   (define-key gnus-Subject-mode-map "R" 'gnus-Subject-mail-reply-with-original)
  1671.   (define-key gnus-Subject-mode-map "\C-c\C-f" 'gnus-Subject-mail-forward)
  1672.   (define-key gnus-Subject-mode-map "m" 'gnus-Subject-mail-other-window)
  1673.   (define-key gnus-Subject-mode-map "o" 'gnus-Subject-save-article)
  1674.   (define-key gnus-Subject-mode-map "\C-o" 'gnus-Subject-save-in-mail)
  1675.   (define-key gnus-Subject-mode-map "|" 'gnus-Subject-pipe-output)
  1676.   (define-key gnus-Subject-mode-map "\ek" 'gnus-Subject-edit-local-kill)
  1677.   (define-key gnus-Subject-mode-map "\eK" 'gnus-Subject-edit-global-kill)
  1678.   (define-key gnus-Subject-mode-map "V" 'gnus-version)
  1679.   (define-key gnus-Subject-mode-map "q" 'gnus-Subject-exit)
  1680.   (define-key gnus-Subject-mode-map "Q" 'gnus-Subject-quit)
  1681.   (define-key gnus-Subject-mode-map "?" 'gnus-Subject-describe-briefly)
  1682.   (define-key gnus-Subject-mode-map "\C-c\C-i" 'gnus-Info-find-node))
  1683.  
  1684. (defun gnus-Subject-mode ()
  1685.   "Major mode for reading articles in this newsgroup.
  1686. All normal editing commands are turned off.
  1687. Instead, these commands are available:
  1688.  
  1689. SPC    Scroll to the next page of the current article.  The next unread
  1690.     article is selected automatically at the end of the message.
  1691. DEL    Scroll to the previous page of the current article.
  1692. RET    Scroll up (or down) one line the current article.
  1693. n    Move to the next unread article.
  1694. p    Move to the previous unread article.
  1695. N    Move to the next article.
  1696. P    Move to the previous article.
  1697. ESC C-n    Move to the next article which has the same subject as the
  1698.     current article.
  1699. ESC C-p    Move to the previous article which has the same subject as the
  1700.     current article.
  1701. \\[gnus-Subject-next-unread-same-subject]
  1702.     Move to the next unread article which has the same subject as the
  1703.     current article.
  1704. \\[gnus-Subject-prev-unread-same-subject]
  1705.     Move to the previous unread article which has the same subject as
  1706.     the current article.
  1707. C-c C-n    Scroll to the next digested message of the current article.
  1708. C-c C-p    Scroll to the previous digested message of the current article.
  1709. C-n    Move to the next subject.
  1710. C-p    Move to the previous subject.
  1711. ESC n    Move to the next unread subject.
  1712. ESC p    Move to the previous unread subject.
  1713. \\[gnus-Subject-next-group]
  1714.     Exit the current newsgroup and select the next unread newsgroup.
  1715. \\[gnus-Subject-prev-group]
  1716.     Exit the current newsgroup and select the previous unread newsgroup.
  1717. .    Jump to the first unread article in the current newsgroup.
  1718. /    Do an incremental search forward on subjects.
  1719. s    Do an incremental search forward on the current article.
  1720. ESC s    Search for an article containing a regexp forward.
  1721. ESC S    Search for an article containing a regexp backward.
  1722. <    Move point to the beginning of the current article.
  1723. >    Move point to the end of the current article.
  1724. j    Jump to the article specified by the numeric article ID.
  1725. J    Jump to the article specified by the numeric article ID, then read it.
  1726. l    Jump to the article you read last.
  1727. ^    Refer to parent of the current article.
  1728. ESC r    Refer to the article specified by the Message-ID.
  1729. u    Mark the current article as unread, and go forward.
  1730. U    Mark the current article as unread, and go backward.
  1731. d    Mark the current article as read, and go forward.
  1732. D    Mark the current article as read, and go backward.
  1733. ESC u    Clear the current article's mark, and go forward.
  1734. ESC U    Clear the current article's mark, and go backward.
  1735. k    Mark articles which has the same subject as the current article as
  1736.     read, and then select the next unread article.
  1737. C-k    Mark articles which has the same subject as the current article as
  1738.     read.
  1739. ESC k    Edit a local KILL file applied to the current newsgroup.
  1740. ESC K    Edit a global KILL file applied to all newsgroups.
  1741. ESC C-t    Toggle showing conversation threads.
  1742. ESC C-s    Show thread subtrees.
  1743. ESC C-h    Hide thread subtrees.
  1744. \\[gnus-Subject-show-all-threads]    Show all thread subtrees.
  1745. \\[gnus-Subject-hide-all-threads]    Hide all thread subtrees.
  1746. ESC C-f    Go to the same level next thread.
  1747. ESC C-b    Go to the same level previous thread.
  1748. ESC C-d    Go downward current thread.
  1749. ESC C-u    Go upward current thread.
  1750. ESC C-k    Mark articles under current thread as read.
  1751. &    Execute a command for each article conditionally.
  1752. \\[gnus-Subject-catch-up]
  1753.     Mark all articles as read in the current newsgroup, preserving
  1754.     articles marked as unread.
  1755. \\[gnus-Subject-catch-up-all]
  1756.     Mark all articles as read in the current newsgroup.
  1757. \\[gnus-Subject-catch-up-and-exit]
  1758.     Catch up all articles not marked as unread, and then exit the
  1759.     current newsgroup.
  1760. \\[gnus-Subject-catch-up-all-and-exit]
  1761.     Catch up all articles, and then exit the current newsgroup.
  1762. C-t    Toggle truncations of subject lines.
  1763. x    Delete subject lines marked as read.
  1764. X    Delete subject lines with the specific marks.
  1765. C-c C-s C-n    Sort subjects by article number.
  1766. C-c C-s C-a    Sort subjects by article author.
  1767. C-c C-s C-s    Sort subjects alphabetically.
  1768. C-c C-s C-d    Sort subjects by date.
  1769. =    Expand Subject window to show headers full window.
  1770. G    Reselect the current newsgroup. Prefix argument means to select all.
  1771. w    Stop page breaking by linefeed.
  1772. C-c C-r    Caesar rotates letters by 13/47 places.
  1773. g    Force to show the current article.
  1774. t    Show original article header if pruned header currently shown, or
  1775.     vice versa.
  1776. v    Show original article header.
  1777. C-d    Expand the current message as a digest
  1778. a    Post a new article.
  1779. f    Post a reply article.
  1780. F    Post a reply article with original article.
  1781. C    Cancel the current article.
  1782. r    Mail a message to the author.
  1783. R    Mail a message to the author with original author.
  1784. C-c C-f    Forward the current message to another user.
  1785. m    Mail a message in other window.
  1786. o    Save the current article in your favorite format.
  1787. C-o    Append the current article to a file in Unix mail format.
  1788. |    Pipe the contents of the current article to a subprocess.
  1789. q    Quit reading news in the current newsgroup.
  1790. Q    Quit reading news without recording unread articles information.
  1791. V    Show the version number of this GNUS.
  1792. ?    Describe Subject Mode commands briefly.
  1793. C-h m    Describe Subject Mode.
  1794. C-c C-i    Read Info about Subject Mode.
  1795.  
  1796. User customizable variables:
  1797.  gnus-large-newsgroup
  1798.     The number of articles which indicates a large newsgroup. If the
  1799.     number of articles in a newsgroup is greater than the value, the
  1800.     number of articles to be selected is asked for. If the given value
  1801.     N is positive, the last N articles is selected. If N is negative,
  1802.     the first N articles are selected. An empty string means to select
  1803.     all articles.
  1804.  
  1805.  gnus-use-long-file-name
  1806.     Non-nil means that a newsgroup name is used as a default file name
  1807.     to save articles to. If it's nil, the directory form of a
  1808.     newsgroup is used instead.
  1809.  
  1810.  gnus-default-article-saver
  1811.     Specifies your favorite article saver which is interactively
  1812.     funcallable. Following functions are available:
  1813.  
  1814.     gnus-Subject-save-in-rmail (in Rmail format)
  1815.     gnus-Subject-save-in-mail (in Unix mail format)
  1816.     gnus-Subject-save-in-folder (in MH folder)
  1817.     gnus-Subject-save-in-file (in article format).
  1818.  
  1819.  gnus-rmail-save-name
  1820.  gnus-mail-save-name
  1821.  gnus-folder-save-name
  1822.  gnus-file-save-name
  1823.     Specifies a function generating a file name to save articles in
  1824.     specified format.  The function is called with NEWSGROUP, HEADERS,
  1825.     and optional LAST-FILE.  Access macros to the headers are defined
  1826.     as nntp-header-FIELD, and functions are defined as
  1827.     gnus-header-FIELD.
  1828.  
  1829.  gnus-article-save-directory
  1830.     Specifies a directory name to save articles to using the commands
  1831.     gnus-Subject-save-in-rmail, gnus-Subject-save-in-mail and
  1832.     gnus-Subject-save-in-file. The variable is initialized from the
  1833.     SAVEDIR environment variable.
  1834.  
  1835.  gnus-show-all-headers
  1836.     Non-nil means that all headers of an article are shown.
  1837.  
  1838.  gnus-save-all-headers
  1839.     Non-nil means that all headers of an article are saved in a file.
  1840.  
  1841.  gnus-show-threads
  1842.     Non-nil means that conversation threads are shown in tree structure.
  1843.  
  1844.  gnus-thread-hide-subject
  1845.     Non-nil means that subjects for thread subtrees are hidden.
  1846.  
  1847.  gnus-thread-hide-subtree
  1848.     Non-nil means that thread subtrees are hidden initially.
  1849.  
  1850.  gnus-thread-hide-killed
  1851.     Non-nil means that killed thread subtrees are hidden automatically.
  1852.  
  1853.  gnus-thread-ignore-subject
  1854.     Non-nil means that subject differences are ignored in constructing
  1855.     thread trees.
  1856.  
  1857.  gnus-thread-indent-level
  1858.     Indentation of thread subtrees.
  1859.  
  1860.  gnus-optional-headers
  1861.     Specifies a function which generates an optional string displayed
  1862.     in the Subject buffer. The function is called with an article
  1863.     HEADERS.  The result must be a string excluding `[' and `]'.  The
  1864.     default function returns a string like NNN:AUTHOR, where NNN is
  1865.     the number of lines in an article and AUTHOR is the name of the
  1866.     author.
  1867.  
  1868.  gnus-auto-extend-newsgroup
  1869.     Non-nil means visible articles are extended to forward and
  1870.     backward automatically if possible.
  1871.  
  1872.  gnus-auto-select-first
  1873.     Non-nil means the first unread article is selected automagically
  1874.     when a newsgroup is selected normally (by gnus-Group-read-group).
  1875.     If you'd like to prevent automatic selection of the first unread
  1876.     article in some newsgroups, set the variable to nil in
  1877.     gnus-Select-group-hook or gnus-Apply-kill-hook.
  1878.  
  1879.  gnus-auto-select-next
  1880.     Non-nil means the next newsgroup is selected automagically at the
  1881.     end of the newsgroup. If the value is t and the next newsgroup is
  1882.     empty (no unread articles), GNUS will exit Subject mode and go
  1883.     back to Group mode. If the value is neither nil nor t, GNUS won't
  1884.     exit Subject mode but select the following unread newsgroup.
  1885.     Especially, if the value is the symbol `quietly', the next unread
  1886.     newsgroup will be selected without any confirmations.
  1887.  
  1888.  gnus-auto-select-same
  1889.     Non-nil means an article with the same subject as the current
  1890.     article is selected automagically like `rn -S'.
  1891.  
  1892.  gnus-auto-center-subject
  1893.     Non-nil means the point of Subject Mode window is always kept
  1894.     centered.
  1895.  
  1896.  gnus-break-pages
  1897.     Non-nil means an article is broken into pages at page delimiters.
  1898.     This may not work with some versions of GNU Emacs earlier than
  1899.     version 18.50.
  1900.  
  1901.  gnus-page-delimiter
  1902.     Specifies a regexp describing line-beginnings that separate pages
  1903.     of news article.
  1904.  
  1905.  [gnus-more-message is obsolete.  overlay-arrow-string interfares
  1906.     with other subsystems, such as dbx mode.]
  1907.  
  1908.  gnus-digest-show-summary
  1909.     Non-nil means that a summary of digest messages is shown when
  1910.     reading a digest article using `gnus-Subject-rmail-digest'
  1911.     command.
  1912.  
  1913.  gnus-digest-separator
  1914.     Specifies a regexp separating messages in a digest article.
  1915.  
  1916.  gnus-mail-reply-method
  1917.  gnus-mail-other-window-method
  1918.     Specifies a function to begin composing mail message using
  1919.     commands gnus-Subject-mail-reply and
  1920.     gnus-Subject-mail-other-window.  Functions
  1921.     gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe are
  1922.     available for the value of gnus-mail-reply-method.  And functions
  1923.     gnus-mail-other-window-using-mail and
  1924.     gnus-mail-other-window-using-mhe are available for the value of
  1925.     gnus-mail-other-window-method.
  1926.  
  1927. Various hooks for customization:
  1928.  gnus-Subject-mode-hook
  1929.     Entry to this mode calls the value with no arguments, if that
  1930.     value is non-nil.
  1931.  
  1932.  gnus-Select-group-hook
  1933.     Called with no arguments when newsgroup is selected, if that value
  1934.     is non-nil. It is possible to sort subjects in this hook. See the
  1935.     documentation of this variable for more information.
  1936.  
  1937.  gnus-Subject-prepare-hook
  1938.     Called with no arguments after a subject list is created in the
  1939.     Subject buffer, if that value is non-nil. If you'd like to modify
  1940.     the buffer, you can use this hook.
  1941.  
  1942.  gnus-Select-article-hook
  1943.     Called with no arguments when an article is selected, if that
  1944.     value is non-nil. See the documentation of this variable for more
  1945.     information.
  1946.  
  1947.  gnus-Select-digest-hook
  1948.     Called with no arguments when reading digest messages using Rmail,
  1949.     if that value is non-nil. This hook can be used to modify an
  1950.     article so that Rmail can work with it. See the documentation of
  1951.     the variable for more information.
  1952.  
  1953.  gnus-Rmail-digest-hook
  1954.     Called with no arguments when reading digest messages using Rmail,
  1955.     if that value is non-nil. This hook is intended to customize Rmail
  1956.     mode.
  1957.  
  1958.  gnus-Apply-kill-hook
  1959.     Called with no arguments when a newsgroup is selected and the
  1960.     Subject buffer is prepared. This hook is intended to apply a KILL
  1961.     file to the selected newsgroup. The format of KILL file is
  1962.     completely different from that of version 3.8. You have to rewrite
  1963.     them in the new format. See the documentation of Kill file mode
  1964.     for more information.
  1965.  
  1966.  gnus-Mark-article-hook
  1967.     Called with no arguments when an article is selected at the first
  1968.     time. The hook is intended to mark an article as read (or unread)
  1969.     automatically when it is selected.  See the documentation of the
  1970.     variable for more information.
  1971.  
  1972.  gnus-Exit-group-hook
  1973.     Called with no arguments when exiting the current newsgroup, if
  1974.     that value is non-nil. If your machine is so slow that exiting
  1975.     from Subject mode takes very long time, inhibit marking articles
  1976.     as read using cross-references by setting the variable
  1977.     gnus-use-cross-reference to nil in this hook."
  1978.   (interactive)
  1979.   (kill-all-local-variables)
  1980.   ;; Gee.  Why don't you upgrade?
  1981.   (cond ((boundp 'mode-line-modified)
  1982.      (setq mode-line-modified "--- "))
  1983.     ((listp (default-value 'mode-line-format))
  1984.      (setq mode-line-format
  1985.            (cons "--- " (cdr (default-value 'mode-line-format))))))
  1986.   (make-local-variable 'global-mode-string)
  1987.   (setq global-mode-string nil)
  1988.   (setq major-mode 'gnus-Subject-mode)
  1989.   (setq mode-name "Subject")
  1990.   ;;(setq mode-line-process '(" " gnus-newsgroup-name))
  1991.   (make-local-variable 'minor-mode-alist)
  1992.   (or (assq 'gnus-show-threads minor-mode-alist)
  1993.       (setq minor-mode-alist
  1994.         (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
  1995.   (gnus-Subject-set-mode-line)
  1996.   (use-local-map gnus-Subject-mode-map)
  1997.   (buffer-disable-undo (current-buffer))
  1998.   (setq buffer-read-only t)        ;Disable modification
  1999.   (setq truncate-lines t)        ;Stop line folding
  2000.   (setq selective-display t)
  2001.   (setq selective-display-ellipses t)    ;Display `...'
  2002.   ;;(setq case-fold-search t)
  2003.   (run-hooks 'gnus-Subject-mode-hook))
  2004.  
  2005. (defun gnus-Subject-setup-buffer ()
  2006.   "Initialize subject display buffer."
  2007.   (if (get-buffer gnus-Subject-buffer)
  2008.       (set-buffer gnus-Subject-buffer)
  2009.     (set-buffer (get-buffer-create gnus-Subject-buffer))
  2010.     (gnus-Subject-mode)
  2011.     ))
  2012.  
  2013. (defun gnus-Subject-read-group (group &optional show-all no-article)
  2014.   "Start reading news in newsgroup GROUP.
  2015. If optional 1st argument SHOW-ALL is non-nil, already read articles are
  2016. also listed.
  2017. If optional 2nd argument NO-ARTICLE is non-nil, no article is selected
  2018. initially."
  2019.   (message "Retrieving newsgroup: %s..." group)
  2020.   (if (gnus-select-newsgroup group show-all)
  2021.       (progn
  2022.     ;; Don't switch-to-buffer to prevent displaying old contents
  2023.     ;;  of the buffer until new subjects list is created.
  2024.     ;; Suggested by Juha Heinanen <jh@tut.fi>
  2025.     (gnus-Subject-setup-buffer)
  2026.     ;; You can change the order of subjects in this hook.
  2027.     (run-hooks 'gnus-Select-group-hook)
  2028.     (gnus-Subject-prepare)
  2029.     ;; Function `gnus-apply-kill-file' must be called in this hook.
  2030.     (run-hooks 'gnus-Apply-kill-hook)
  2031.     (if (zerop (buffer-size))
  2032.         ;; This newsgroup is empty.
  2033.         (progn
  2034.           (gnus-Subject-catch-up-and-exit nil t) ;Without confirmations.
  2035.           (message "No unread news"))
  2036.       ;; Hide conversation thread subtrees.  We cannot do this in
  2037.       ;; gnus-Subject-prepare-hook since kill processing may not
  2038.       ;; work with hidden articles.
  2039.       (and gnus-show-threads
  2040.            gnus-thread-hide-subtree
  2041.            (gnus-Subject-hide-all-threads))
  2042.       ;; Show first unread article if requested.
  2043.       (goto-char (point-min))
  2044.       (if (and (not no-article)
  2045.            gnus-auto-select-first
  2046.            (gnus-Subject-first-unread-article))
  2047.           ;; Window is configured automatically.
  2048.           ;; Current buffer may be changed as a result of hook
  2049.           ;; evaluation, especially by gnus-Subject-rmail-digest
  2050.           ;; command, so we should adjust cursor point carefully.
  2051.           (if (eq (current-buffer) (get-buffer gnus-Subject-buffer))
  2052.           (progn
  2053.             ;; Adjust cursor point.
  2054.             (beginning-of-line)
  2055.             (search-forward ":" nil t)))
  2056.         (gnus-configure-windows 'SelectNewsgroup)
  2057.         (gnus-pop-to-buffer gnus-Subject-buffer)
  2058.         (gnus-Subject-set-mode-line)
  2059.         ;; I sometime get confused with the old Article buffer.
  2060.         (if (get-buffer gnus-Article-buffer)
  2061.         (if (get-buffer-window gnus-Article-buffer)
  2062.             (save-excursion
  2063.               (set-buffer gnus-Article-buffer)
  2064.               (let ((buffer-read-only nil))
  2065.             (erase-buffer)))
  2066.           (kill-buffer gnus-Article-buffer)))
  2067.         ;; Adjust cursor point.
  2068.         (beginning-of-line)
  2069.         (search-forward ":" nil t))
  2070.       ))
  2071.     ;; Cannot select newsgroup GROUP.
  2072.     (if (gnus-gethash group gnus-active-hashtb)
  2073.     (progn
  2074.       ;; If NNTP is used, nntp_access file may not be installed
  2075.       ;; properly.  Otherwise, may be active file problem.
  2076.       (ding)
  2077.       (message
  2078.        (gnus-nntp-message
  2079.         (format "Cannot select %s.  May be security or active file problem." group)))
  2080.       (sit-for 0))
  2081.       ;; Check bogus newsgroups.
  2082.       ;; We must be in Group Mode buffer.
  2083.       (gnus-Group-check-bogus-groups))
  2084.     ))
  2085.  
  2086. (defun gnus-Subject-prepare ()
  2087.   "Prepare subject list of current newsgroup in Subject mode buffer."
  2088.   (let ((buffer-read-only nil))
  2089.     ;; Note: The next codes are not actually used because the user who
  2090.     ;; want it can define them in gnus-Select-group-hook.
  2091.     ;; Print verbose messages if too many articles are selected.
  2092.     ;;    (and (numberp gnus-large-newsgroup)
  2093.     ;;       (> (length gnus-newsgroup-headers) gnus-large-newsgroup)
  2094.     ;;       (message "Preparing headers..."))
  2095.     (erase-buffer)
  2096.     (gnus-Subject-prepare-threads
  2097.      (if gnus-show-threads
  2098.      (gnus-make-threads gnus-newsgroup-headers)
  2099.        gnus-newsgroup-headers) 0)
  2100.     ;; Erase header retrieval message.
  2101.     (message "")
  2102.     ;; Call hooks for modifying Subject mode buffer.
  2103.     ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
  2104.     (goto-char (point-min))
  2105.     (run-hooks 'gnus-Subject-prepare-hook)
  2106.     ))
  2107.  
  2108. ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>
  2109.  
  2110. (defun gnus-Subject-prepare-threads (threads level)
  2111.   "Prepare Subject buffer from THREADS and indentation LEVEL.
  2112. THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).'"
  2113.   (let ((thread nil)
  2114.     (header nil)
  2115.     (number nil)
  2116.     ;; `M Indent NUM: [OPT] SUBJECT'
  2117.     (cntl (format "%%s %%s%%%dd: [%%s] %%s\n"
  2118.               (length (prin1-to-string gnus-newsgroup-end)))))
  2119.     (while threads
  2120.       (setq thread (car threads))
  2121.       (setq threads (cdr threads))
  2122.       ;; If thread is a cons, hierarchical threads is given.
  2123.       ;; Otherwise, thread itself is header.
  2124.       (if (consp thread)
  2125.       (setq header (car thread))
  2126.     (setq header thread))
  2127.       ;; Print valid header only.
  2128.       (if (vectorp header)        ;Depends on nntp.el.
  2129.       (progn
  2130.         (setq number (nntp-header-number header))
  2131.         (insert
  2132.          (format cntl
  2133.              ;; Read or not.
  2134.              (cond ((memq number gnus-newsgroup-marked)  "-")
  2135.                ((memq number gnus-newsgroup-unreads) " ")
  2136.                (t "D"))
  2137.              ;; Thread level.
  2138.              (make-string (* level gnus-thread-indent-level) ? )
  2139.              ;; Article number.
  2140.              number
  2141.              ;; Optional headers.
  2142.              (or (and gnus-optional-headers
  2143.                   (funcall gnus-optional-headers header)) "")
  2144.              ;; Its subject string.
  2145.              (concat (if (or (zerop level)
  2146.                      (not gnus-thread-hide-subject))
  2147.                  nil
  2148.                    (make-string (window-width) ? ))
  2149.                  (nntp-header-subject header))
  2150.              ))
  2151.         ))
  2152.       ;; Print subthreads.
  2153.       (and (consp thread)
  2154.        (cdr thread)
  2155.        (gnus-Subject-prepare-threads (cdr thread) (1+ level)))
  2156.       )))
  2157.  
  2158. (defun gnus-Subject-set-mode-line ()
  2159.   "Set Subject mode line string."
  2160.   ;; The value must be a string to escape %-constructs.
  2161.   (let ((subject
  2162.      (if gnus-current-headers
  2163.          (nntp-header-subject gnus-current-headers) gnus-newsgroup-name)))
  2164.     (setq mode-line-buffer-identification
  2165.       (concat "GNUS: "
  2166.           subject
  2167.           ;; Enough spaces to pad subject to 17 positions.
  2168.           (make-string (max 0 (- 17 (length subject))) ? ))))
  2169.   (set-buffer-modified-p t))
  2170.  
  2171. ;; GNUS Subject mode command.
  2172.  
  2173. (defun gnus-Subject-search-group (&optional backward)
  2174.   "Search for next unread newsgroup.
  2175. If optional argument BACKWARD is non-nil, search backward instead."
  2176.   (save-excursion
  2177.     (set-buffer gnus-Group-buffer)
  2178.     (save-excursion
  2179.       ;; We don't want to alter current point of Group mode buffer.
  2180.       (if (gnus-Group-search-forward backward nil)
  2181.       (gnus-Group-group-name))
  2182.       )))
  2183.  
  2184. (defun gnus-Subject-search-subject (backward unread subject)
  2185.   "Search for article forward.
  2186. If 1st argument BACKWARD is non-nil, search backward.
  2187. If 2nd argument UNREAD is non-nil, only unread article is selected.
  2188. If 3rd argument SUBJECT is non-nil, the article which has
  2189. the same subject will be searched for."
  2190.   (let ((func (if backward 're-search-backward 're-search-forward))
  2191.     (article nil)
  2192.     ;; We have to take care of hidden lines.
  2193.     (regexp 
  2194.      (format "^%s[ \t]+\\([0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s"
  2195.          ;;(if unread " " ".")
  2196.          (cond ((eq unread t) " ") (unread "[ ---]") (t "."))
  2197.          (if subject
  2198.              (concat "\\([Rr][Ee]:[ \t]+\\)*"
  2199.                  (regexp-quote (gnus-simplify-subject subject))
  2200.                  ;; Ignore words in parentheses.
  2201.                  "\\([ \t]*([^\r\n]*)\\)*[ \t]*\\(\r\\|$\\)")
  2202.            "")
  2203.          )))
  2204.     (if backward
  2205.     (beginning-of-line)
  2206.       (end-of-line))
  2207.     (if (funcall func regexp nil t)
  2208.     (setq article
  2209.           (string-to-int
  2210.            (buffer-substring (match-beginning 1) (match-end 1)))))
  2211.     ;; Adjust cursor point.
  2212.     (beginning-of-line)
  2213.     (search-forward ":" nil t)
  2214.     ;; This is the result.
  2215.     article
  2216.     ))
  2217.  
  2218. (defun gnus-Subject-search-forward (&optional unread subject)
  2219.   "Search for article forward.
  2220. If 1st optional argument UNREAD is non-nil, only unread article is selected.
  2221. If 2nd optional argument SUBJECT is non-nil, the article which has
  2222. the same subject will be searched for."
  2223.   (gnus-Subject-search-subject nil unread subject))
  2224.  
  2225. (defun gnus-Subject-search-backward (&optional unread subject)
  2226.   "Search for article backward.
  2227. If 1st optional argument UNREAD is non-nil, only unread article is selected.
  2228. If 2nd optional argument SUBJECT is non-nil, the article which has
  2229. the same subject will be searched for."
  2230.   (gnus-Subject-search-subject t unread subject))
  2231.  
  2232. (defun gnus-Subject-article-number ()
  2233.   "Article number around point. If nothing, return current number."
  2234.   (save-excursion
  2235.     (beginning-of-line)
  2236.     (if (looking-at ".[ \t]+\\([0-9]+\\):")
  2237.     (string-to-int
  2238.      (buffer-substring (match-beginning 1) (match-end 1)))
  2239.       ;; If search fail, return current article number.
  2240.       gnus-current-article
  2241.       )))
  2242.  
  2243. (defun gnus-Subject-subject-string ()
  2244.   "Return current subject string or nil if nothing."
  2245.   (save-excursion
  2246.     ;; It is possible to implement this function using
  2247.     ;;  `gnus-Subject-article-number' and `gnus-newsgroup-headers'.
  2248.     (beginning-of-line)
  2249.     ;; We have to take care of hidden lines.
  2250.     (if (looking-at ".[ \t]+[0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]")
  2251.     (buffer-substring (match-beginning 1) (match-end 1)))
  2252.     ))
  2253.  
  2254. (defun gnus-Subject-goto-subject (article)
  2255.   "Move point to ARTICLE's subject."
  2256.   (interactive
  2257.    (list
  2258.     (string-to-int
  2259.      (completing-read "Article number: "
  2260.               (mapcar
  2261.                (function
  2262.             (lambda (headers)
  2263.               (list
  2264.                (int-to-string (nntp-header-number headers)))))
  2265.                gnus-newsgroup-headers)
  2266.               nil 'require-match))))
  2267.   (let ((current (point)))
  2268.     (goto-char (point-min))
  2269.     (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t))
  2270.     (progn (goto-char current) nil))
  2271.     ))
  2272.  
  2273. (defun gnus-Subject-recenter ()
  2274.   "Center point in Subject mode window."
  2275.   ;; Scroll window so as to cursor comes center of Subject mode window
  2276.   ;;  only when article is displayed.
  2277.   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
  2278.   ;; Recenter only when requested.
  2279.   ;; Subbested by popovich@park.cs.columbia.edu
  2280.   (and gnus-auto-center-subject
  2281.        (get-buffer-window gnus-Article-buffer)
  2282.        (< (/ (- (window-height) 1) 2)
  2283.       (count-lines (point) (point-max)))
  2284.        (recenter (/ (- (window-height) 2) 2))))
  2285.  
  2286. ;; Walking around Group mode buffer.
  2287.  
  2288. (defun gnus-Subject-jump-to-group (newsgroup)
  2289.   "Move point to NEWSGROUP in Group mode buffer."
  2290.   ;; Keep update point of Group mode buffer if visible.
  2291.   (if (eq (current-buffer)
  2292.       (get-buffer gnus-Group-buffer))
  2293.       (save-window-excursion
  2294.     ;; Take care of tree window mode.
  2295.     (if (get-buffer-window gnus-Group-buffer)
  2296.         (pop-to-buffer gnus-Group-buffer))
  2297.     (gnus-Group-jump-to-group newsgroup))
  2298.     (save-excursion
  2299.       ;; Take care of tree window mode.
  2300.       (if (get-buffer-window gnus-Group-buffer)
  2301.       (pop-to-buffer gnus-Group-buffer)
  2302.     (set-buffer gnus-Group-buffer))
  2303.       (gnus-Group-jump-to-group newsgroup))))
  2304.  
  2305. (defun gnus-Subject-next-group (no-article)
  2306.   "Exit current newsgroup and then select next unread newsgroup.
  2307. If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
  2308.   (interactive "P")
  2309.   ;; Make sure Group mode buffer point is on current newsgroup.
  2310.   (gnus-Subject-jump-to-group gnus-newsgroup-name)
  2311.   (let ((group (gnus-Subject-search-group)))
  2312.     (if (null group)
  2313.     (progn
  2314.       (message "Exiting %s..." gnus-newsgroup-name)  
  2315.       (gnus-Subject-exit)
  2316.       (message ""))
  2317.       (message "Selecting %s..." group)
  2318.       (gnus-Subject-exit t)        ;Exit Subject mode temporary.
  2319.       ;; We are now in Group mode buffer.
  2320.       ;; Make sure Group mode buffer point is on GROUP.
  2321.       (gnus-Subject-jump-to-group group)
  2322.       (gnus-Subject-read-group group nil no-article)
  2323.       (or (eq (current-buffer)
  2324.           (get-buffer gnus-Subject-buffer))
  2325.       (eq gnus-auto-select-next t)
  2326.       ;; Expected newsgroup has nothing to read since the articles
  2327.       ;; are marked as read by cross-referencing. So, try next
  2328.       ;; newsgroup. (Make sure we are in Group mode buffer now.)
  2329.       (and (eq (current-buffer)
  2330.            (get-buffer gnus-Group-buffer))
  2331.            (gnus-Group-group-name)
  2332.            (gnus-Subject-read-group
  2333.         (gnus-Group-group-name) nil no-article))
  2334.       )
  2335.       )))
  2336.  
  2337. (defun gnus-Subject-prev-group (no-article)
  2338.   "Exit current newsgroup and then select previous unread newsgroup.
  2339. If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
  2340.   (interactive "P")
  2341.   ;; Make sure Group mode buffer point is on current newsgroup.
  2342.   (gnus-Subject-jump-to-group gnus-newsgroup-name)
  2343.   (let ((group (gnus-Subject-search-group t)))
  2344.     (if (null group)
  2345.     (progn
  2346.       (message "Exiting %s..." gnus-newsgroup-name)  
  2347.       (gnus-Subject-exit)
  2348.       (message ""))
  2349.       (message "Selecting %s..." group)
  2350.       (gnus-Subject-exit t)        ;Exit Subject mode temporary.
  2351.       ;; We are now in Group mode buffer.
  2352.       ;; We have to adjust point of Group mode buffer because current
  2353.       ;; point is moved to next unread newsgroup by exiting.
  2354.       (gnus-Subject-jump-to-group group)
  2355.       (gnus-Subject-read-group group nil no-article)
  2356.       (or (eq (current-buffer)
  2357.           (get-buffer gnus-Subject-buffer))
  2358.       (eq gnus-auto-select-next t)
  2359.       ;; Expected newsgroup has nothing to read since the articles
  2360.       ;; are marked as read by cross-referencing. So, try next
  2361.       ;; newsgroup. (Make sure we are in Group mode buffer now.)
  2362.       (and (eq (current-buffer)
  2363.            (get-buffer gnus-Group-buffer))
  2364.            (gnus-Subject-search-group t)
  2365.            (gnus-Subject-read-group
  2366.         (gnus-Subject-search-group t) nil no-article))
  2367.       )
  2368.       )))
  2369.  
  2370. ;; Walking around subject lines.
  2371.  
  2372. (defun gnus-Subject-next-subject (n &optional unread)
  2373.   "Go to next N'th subject line.
  2374. If optional argument UNREAD is non-nil, only unread article is selected."
  2375.   (interactive "p")
  2376.   (while (and (> n 1)
  2377.           (gnus-Subject-search-forward unread))
  2378.     (setq n (1- n)))
  2379.   (cond ((gnus-Subject-search-forward unread)
  2380.      (gnus-Subject-recenter))
  2381.     (unread
  2382.      (message "No more unread articles"))
  2383.     (t
  2384.      (message "No more articles"))
  2385.     ))
  2386.  
  2387. (defun gnus-Subject-next-unread-subject (n)
  2388.   "Go to next N'th unread subject line."
  2389.   (interactive "p")
  2390.   (gnus-Subject-next-subject n t))
  2391.  
  2392. (defun gnus-Subject-prev-subject (n &optional unread)
  2393.   "Go to previous N'th subject line.
  2394. If optional argument UNREAD is non-nil, only unread article is selected."
  2395.   (interactive "p")
  2396.   (while (and (> n 1)
  2397.           (gnus-Subject-search-backward unread))
  2398.     (setq n (1- n)))
  2399.   (cond ((gnus-Subject-search-backward unread)
  2400.      (gnus-Subject-recenter))
  2401.     (unread
  2402.      (message "No more unread articles"))
  2403.     (t
  2404.      (message "No more articles"))
  2405.     ))
  2406.  
  2407. (defun gnus-Subject-prev-unread-subject (n)
  2408.   "Go to previous N'th unread subject line."
  2409.   (interactive "p")
  2410.   (gnus-Subject-prev-subject n t))
  2411.  
  2412. ;; Walking around subject lines with displaying articles.
  2413.  
  2414. (defun gnus-Subject-expand-window ()
  2415.   "Expand Subject window to show headers full window."
  2416.   (interactive)
  2417.   (gnus-configure-windows 'ExpandSubject)
  2418.   (gnus-pop-to-buffer gnus-Subject-buffer))
  2419.  
  2420. (defun gnus-Subject-display-article (article &optional all-header)
  2421.   "Display ARTICLE in Article buffer."
  2422.   (if (null article)
  2423.       nil
  2424.     (gnus-configure-windows 'SelectArticle)
  2425.     (gnus-pop-to-buffer gnus-Subject-buffer)
  2426.     (gnus-Article-prepare article all-header)
  2427.     (gnus-Subject-recenter)
  2428.     (gnus-Subject-set-mode-line)
  2429.     (run-hooks 'gnus-Select-article-hook)
  2430.     ;; Successfully display article.
  2431.     t
  2432.     ))
  2433.  
  2434. (defun gnus-Subject-select-article (&optional all-headers force)
  2435.   "Select the current article.
  2436. Optional argument ALL-HEADERS is non-nil, show all headers."
  2437.   (let ((article (gnus-Subject-article-number)))
  2438.     (if (or (null gnus-current-article)
  2439.         (/= article gnus-current-article)
  2440.         (and force (not (eq all-headers gnus-have-all-headers))))
  2441.     ;; The selected subject is different from that of the current article.
  2442.     (gnus-Subject-display-article article all-headers)
  2443.       (gnus-configure-windows 'SelectArticle)
  2444.       (gnus-pop-to-buffer gnus-Subject-buffer))
  2445.     ))
  2446.  
  2447. (defun gnus-Subject-set-current-mark (&optional current-mark)
  2448.   "Put `+' at the current article.
  2449. Optional argument specifies CURRENT-MARK instead of `+'."
  2450.   (save-excursion
  2451.     (set-buffer gnus-Subject-buffer)
  2452.     (let ((buffer-read-only nil))
  2453.       (goto-char (point-min))
  2454.       ;; First of all clear mark at last article.
  2455.       (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t)
  2456.       (progn
  2457.         (delete-char -1)
  2458.         (insert " ")
  2459.         (goto-char (point-min))))
  2460.       (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t)
  2461.       (progn
  2462.         (delete-char 1)
  2463.         (insert (or current-mark "+"))))
  2464.       )))
  2465.  
  2466. ;;(defun gnus-Subject-next-article (unread &optional subject)
  2467. ;;  "Select article after current one.
  2468. ;;If argument UNREAD is non-nil, only unread article is selected."
  2469. ;;  (interactive "P")
  2470. ;;  (cond ((gnus-Subject-display-article
  2471. ;;      (gnus-Subject-search-forward unread subject)))
  2472. ;;    (unread
  2473. ;;     (message "No more unread articles"))
  2474. ;;    (t
  2475. ;;     (message "No more articles"))
  2476. ;;    ))
  2477.  
  2478. (defun gnus-Subject-next-article (unread &optional subject)
  2479.   "Select article after current one.
  2480. If argument UNREAD is non-nil, only unread article is selected."
  2481.   (interactive "P")
  2482.   (let ((header nil))
  2483.     (cond ((gnus-Subject-display-article
  2484.         (gnus-Subject-search-forward unread subject)))
  2485.       ((and subject
  2486.         gnus-auto-select-same
  2487.         (gnus-set-difference gnus-newsgroup-unreads
  2488.                      gnus-newsgroup-marked)
  2489.         (memq this-command
  2490.               '(gnus-Subject-next-unread-article
  2491.             gnus-Subject-next-page
  2492.             gnus-Subject-kill-same-subject-and-select
  2493.             ;;gnus-Subject-next-article
  2494.             ;;gnus-Subject-next-same-subject
  2495.             ;;gnus-Subject-next-unread-same-subject
  2496.             )))
  2497.        ;; Wrap article pointer if there are unread articles.
  2498.        ;; Hook function, such as gnus-Subject-rmail-digest, may
  2499.        ;; change current buffer, so need check.
  2500.        (let ((buffer (current-buffer))
  2501.          (last-point (point)))
  2502.          ;; No more articles with same subject, so jump to the first
  2503.          ;; unread article.
  2504.          (gnus-Subject-first-unread-article)
  2505.          ;;(and (eq buffer (current-buffer))
  2506.          ;;    (= (point) last-point)
  2507.          ;;    ;; Ignore given SUBJECT, and try again.
  2508.          ;;    (gnus-Subject-next-article unread nil))
  2509.          (and (eq buffer (current-buffer))
  2510.           (< (point) last-point)
  2511.           (message "Wrapped"))
  2512.          ))
  2513.       ((and gnus-auto-extend-newsgroup
  2514.         (not unread)        ;Not unread only
  2515.         (not subject)        ;Only if subject is not specified.
  2516.         (setq header (gnus-more-header-forward)))
  2517.        ;; Extend to next article if possible.
  2518.        ;; Basic ideas by himacdonald@watdragon.waterloo.edu
  2519.        (gnus-extend-newsgroup header nil)
  2520.        ;; Threads feature must be turned off.
  2521.        (let ((buffer-read-only nil))
  2522.          (goto-char (point-max))
  2523.          (gnus-Subject-prepare-threads (list header) 0))
  2524.        (gnus-Subject-goto-article gnus-newsgroup-end))
  2525.       (t
  2526.        ;; Select next newsgroup automatically if requested.
  2527.        (let ((this-event last-command-event)
  2528.          (group (gnus-Subject-search-group))
  2529.          (auto-select
  2530.           (and gnus-auto-select-next
  2531.                ;;(null (gnus-set-difference gnus-newsgroup-unreads
  2532.                ;;                gnus-newsgroup-marked))
  2533.                (memq this-command
  2534.                  '(gnus-Subject-next-unread-article
  2535.                    gnus-Subject-next-article
  2536.                    gnus-Subject-next-page
  2537.                    gnus-Subject-next-same-subject
  2538.                    gnus-Subject-next-unread-same-subject
  2539.                    gnus-Subject-kill-same-subject
  2540.                    gnus-Subject-kill-same-subject-and-select
  2541.                    ))
  2542.                ;; Ignore characters typed ahead.
  2543.                (not (input-pending-p))
  2544.                )))
  2545.          (message "No more%s articles%s"
  2546.               (if unread " unread" "")
  2547.               (if (and auto-select
  2548.                    (not (eq gnus-auto-select-next 'quietly)))
  2549.               (if group
  2550.                   (format " (Type %s to %s [%d])"
  2551.                       (key-description this-event)
  2552.                       group
  2553.                       (nth 1 (gnus-gethash group
  2554.                                gnus-unread-hashtb)))
  2555.                 (format " (Type %s to exit %s)"
  2556.                     (key-description this-event)
  2557.                     gnus-newsgroup-name
  2558.                     ))
  2559.             ""))
  2560.          ;; Select next unread newsgroup automagically.
  2561.          (cond ((and auto-select
  2562.              (eq gnus-auto-select-next 'quietly))
  2563.             ;; Select quietly.
  2564.             (gnus-Subject-next-group nil))
  2565.            (auto-select
  2566.             ;; Confirm auto selection.
  2567.             (let ((next-event (next-command-event (allocate-event))))
  2568.               (if (equal this-event next-event)
  2569.               (gnus-Subject-next-group nil)
  2570.             (setq unread-command-event next-event))))
  2571.            )
  2572.          ))
  2573.       )))
  2574.  
  2575. (defun gnus-Subject-next-unread-article ()
  2576.   "Select unread article after current one."
  2577.   (interactive)
  2578.   (gnus-Subject-next-article t (and gnus-auto-select-same
  2579.                     (gnus-Subject-subject-string))))
  2580.  
  2581. (defun gnus-Subject-prev-article (unread &optional subject)
  2582.   "Select article before current one.
  2583. If argument UNREAD is non-nil, only unread article is selected."
  2584.   (interactive "P")
  2585.   (let ((header nil))
  2586.     (cond ((gnus-Subject-display-article
  2587.         (gnus-Subject-search-backward unread subject)))
  2588.       ((and subject
  2589.         gnus-auto-select-same
  2590.         (gnus-set-difference gnus-newsgroup-unreads
  2591.                      gnus-newsgroup-marked)
  2592.         (memq this-command
  2593.               '(gnus-Subject-prev-unread-article
  2594.             ;;gnus-Subject-prev-page
  2595.             ;;gnus-Subject-prev-article
  2596.             ;;gnus-Subject-prev-same-subject
  2597.             ;;gnus-Subject-prev-unread-same-subject
  2598.             )))
  2599.        ;; Ignore given SUBJECT, and try again.
  2600.        (gnus-Subject-prev-article unread nil))
  2601.       (unread
  2602.        (message "No more unread articles"))
  2603.       ((and gnus-auto-extend-newsgroup
  2604.         (not subject)        ;Only if subject is not specified.
  2605.         (setq header (gnus-more-header-backward)))
  2606.        ;; Extend to previous article if possible.
  2607.        ;; Basic ideas by himacdonald@watdragon.waterloo.edu
  2608.        (gnus-extend-newsgroup header t)
  2609.        (let ((buffer-read-only nil))
  2610.          (goto-char (point-min))
  2611.          (gnus-Subject-prepare-threads (list header) 0))
  2612.        (gnus-Subject-goto-article gnus-newsgroup-begin))
  2613.       (t
  2614.        (message "No more articles"))
  2615.       )))
  2616.  
  2617. (defun gnus-Subject-prev-unread-article ()
  2618.   "Select unred article before current one."
  2619.   (interactive)
  2620.   (gnus-Subject-prev-article t (and gnus-auto-select-same
  2621.                     (gnus-Subject-subject-string))))
  2622.  
  2623. (defun gnus-Subject-next-page (lines)
  2624.   "Show next page of selected article.
  2625. If end of artile, select next article.
  2626. Argument LINES specifies lines to be scrolled up."
  2627.   (interactive "P")
  2628.   (let ((article (gnus-Subject-article-number))
  2629.     (endp nil))
  2630.     (if (or (null gnus-current-article)
  2631.         (/= article gnus-current-article))
  2632.     ;; Selected subject is different from current article's.
  2633.     (gnus-Subject-display-article article)
  2634.       (gnus-configure-windows 'SelectArticle)
  2635.       (gnus-pop-to-buffer gnus-Subject-buffer)
  2636.       (gnus-eval-in-buffer-window gnus-Article-buffer
  2637.     (setq endp (gnus-Article-next-page lines)))
  2638.       (cond ((and endp lines)
  2639.          (message "End of message"))
  2640.         ((and endp (null lines))
  2641.          (gnus-Subject-next-unread-article)))
  2642.       )))
  2643.  
  2644. (defun gnus-Subject-prev-page (lines)
  2645.   "Show previous page of selected article.
  2646. Argument LINES specifies lines to be scrolled down."
  2647.   (interactive "P")
  2648.   (let ((article (gnus-Subject-article-number)))
  2649.     (if (or (null gnus-current-article)
  2650.         (/= article gnus-current-article))
  2651.     ;; Selected subject is different from current article's.
  2652.     (gnus-Subject-display-article article)
  2653.       (gnus-configure-windows 'SelectArticle)
  2654.       (gnus-pop-to-buffer gnus-Subject-buffer)
  2655.       (gnus-eval-in-buffer-window gnus-Article-buffer
  2656.     (gnus-Article-prev-page lines))
  2657.       )))
  2658.  
  2659. (defun gnus-Subject-scroll-up (lines)
  2660.   "Scroll up (or down) one line current article.
  2661. Argument LINES specifies lines to be scrolled up (or down if negative)."
  2662.   (interactive "p")
  2663.   (gnus-Subject-select-article)
  2664.   (gnus-eval-in-buffer-window gnus-Article-buffer
  2665.     (cond ((> lines 0)
  2666.        (if (gnus-Article-next-page lines)
  2667.            (message "End of message")))
  2668.       ((< lines 0)
  2669.        (gnus-Article-prev-page (- 0 lines))))
  2670.     ))
  2671.  
  2672. (defun gnus-Subject-next-same-subject ()
  2673.   "Select next article which has the same subject as current one."
  2674.   (interactive)
  2675.   (gnus-Subject-next-article nil (gnus-Subject-subject-string)))
  2676.  
  2677. (defun gnus-Subject-prev-same-subject ()
  2678.   "Select previous article which has the same subject as current one."
  2679.   (interactive)
  2680.   (gnus-Subject-prev-article nil (gnus-Subject-subject-string)))
  2681.  
  2682. (defun gnus-Subject-next-unread-same-subject ()
  2683.   "Select next unread article which has the same subject as current one."
  2684.   (interactive)
  2685.   (gnus-Subject-next-article t (gnus-Subject-subject-string)))
  2686.  
  2687. (defun gnus-Subject-prev-unread-same-subject ()
  2688.   "Select previous unread article which has the same subject as current one."
  2689.   (interactive)
  2690.   (gnus-Subject-prev-article t (gnus-Subject-subject-string)))
  2691.  
  2692. (defun gnus-Subject-refer-parent-article (child)
  2693.   "Refer parent article of current article.
  2694. If a prefix argument CHILD is non-nil, go back to the child article
  2695. using internally maintained articles history.
  2696. NOTE: This command may not work with nnspool.el."
  2697.   (interactive "P")
  2698.   (gnus-Subject-select-article t t)    ;Request all headers.
  2699.   (let ((referenced-id nil))        ;Message-id of parent or child article.
  2700.     (if child
  2701.     ;; Go back to child article using history.
  2702.     (gnus-Subject-refer-article nil)
  2703.       (gnus-eval-in-buffer-window gnus-Article-buffer
  2704.     ;; Look for parent Message-ID.
  2705.     ;; We cannot use gnus-current-headers to get references
  2706.     ;; because we may be looking at parent or refered article.
  2707.     (let ((references (gnus-fetch-field "References")))
  2708.       ;; Get the last message-id in the references.
  2709.       (and references
  2710.            (string-match "\\(<[^<>]+>\\)[^>]*\\'" references)
  2711.            (setq referenced-id
  2712.              (substring references
  2713.                 (match-beginning 1) (match-end 1))))
  2714.       ))
  2715.       (if (stringp referenced-id)
  2716.       (gnus-Subject-refer-article referenced-id)
  2717.     (error "No more parents"))
  2718.       )))
  2719.  
  2720. (defun gnus-Subject-refer-article (message-id)
  2721.   "Refer article specified by MESSAGE-ID.
  2722. If the MESSAGE-ID is nil or an empty string, Message-ID is poped from
  2723. internally maintained articles history.
  2724. NOTE: This command may not work with nnspool.el."
  2725.   (interactive "sMessage-ID: ")
  2726.   ;; Make sure that this command depends on the fact that article
  2727.   ;; related information is not updated when an article is retrieved
  2728.   ;; by Message-ID.
  2729.   (gnus-Subject-select-article t t)    ;Request all headers.
  2730.   (if (and (stringp message-id)
  2731.        (> (length message-id) 0))
  2732.       (gnus-eval-in-buffer-window gnus-Article-buffer
  2733.     ;; Construct the correct Message-ID if necessary.
  2734.     ;; Suggested by tale@pawl.rpi.edu.
  2735.     (or (string-match "^<" message-id)
  2736.         (setq message-id (concat "<" message-id)))
  2737.     (or (string-match ">$" message-id)
  2738.         (setq message-id (concat message-id ">")))
  2739.     ;; Push current message-id on history.
  2740.     ;; We cannot use gnus-current-headers to get current
  2741.     ;; message-id because we may be looking at parent or refered
  2742.     ;; article.
  2743.     (let ((current (gnus-fetch-field "Message-ID")))
  2744.       (or (equal current message-id) ;Nothing to do.
  2745.           (equal current (car gnus-current-history))
  2746.           (setq gnus-current-history
  2747.             (cons current gnus-current-history)))
  2748.       ))
  2749.     ;; Pop message-id from history.
  2750.     (setq message-id (car gnus-current-history))
  2751.     (setq gnus-current-history (cdr gnus-current-history)))
  2752.   (if (stringp message-id)
  2753.       ;; Retrieve article by message-id. This may not work with nnspool.
  2754.       (gnus-Article-prepare message-id t)
  2755.     (error "No such references"))
  2756.   )
  2757.  
  2758. (defun gnus-Subject-next-digest (nth)
  2759.   "Move to head of NTH next digested message."
  2760.   (interactive "p")
  2761.   (gnus-Subject-select-article)
  2762.   (gnus-eval-in-buffer-window gnus-Article-buffer
  2763.     (gnus-Article-next-digest (or nth 1))
  2764.     ))
  2765.  
  2766. (defun gnus-Subject-prev-digest (nth)
  2767.   "Move to head of NTH previous digested message."
  2768.   (interactive "p")
  2769.   (gnus-Subject-select-article)
  2770.   (gnus-eval-in-buffer-window gnus-Article-buffer
  2771.     (gnus-Article-prev-digest (or nth 1))
  2772.     ))
  2773.  
  2774. (defun gnus-Subject-first-unread-article ()
  2775.   "Select first unread article. Return non-nil if successfully selected."
  2776.   (interactive)
  2777.   (let ((begin (point)))
  2778.     (goto-char (point-min))
  2779.     (if (re-search-forward "^ [ \t]+[0-9]+:" nil t)
  2780.     (gnus-Subject-display-article (gnus-Subject-article-number))
  2781.       ;; If there is no unread articles, stay there.
  2782.       (goto-char begin)
  2783.       ;;(gnus-Subject-display-article (gnus-Subject-article-number))
  2784.       (message "No more unread articles")
  2785.       nil
  2786.       )
  2787.     ))
  2788.  
  2789. (defun gnus-Subject-isearch-article ()
  2790.   "Do incremental search forward on current article."
  2791.   (interactive)
  2792.   (gnus-Subject-select-article)
  2793.   (gnus-eval-in-buffer-window gnus-Article-buffer
  2794.     (isearch-forward)))
  2795.  
  2796. (defun gnus-Subject-search-article-forward (regexp)
  2797.   "Search for an article containing REGEXP forward.
  2798. gnus-Select-article-hook is not called during the search."
  2799.   (interactive
  2800.    (list (read-string
  2801.       (concat "Search forward (regexp): "
  2802.           (if gnus-last-search-regexp
  2803.               (concat "(default " gnus-last-search-regexp ") "))))))
  2804.   (if (string-equal regexp "")
  2805.       (setq regexp (or gnus-last-search-regexp ""))
  2806.     (setq gnus-last-search-regexp regexp))
  2807.   (if (gnus-Subject-search-article regexp nil)
  2808.       (gnus-eval-in-buffer-window gnus-Article-buffer
  2809.     (recenter 0)
  2810.     ;;(sit-for 1)
  2811.     )
  2812.     (error "Search failed: \"%s\"" regexp)
  2813.     ))
  2814.  
  2815. (defun gnus-Subject-search-article-backward (regexp)
  2816.   "Search for an article containing REGEXP backward.
  2817. gnus-Select-article-hook is not called during the search."
  2818.   (interactive
  2819.    (list (read-string
  2820.       (concat "Search backward (regexp): "
  2821.           (if gnus-last-search-regexp
  2822.               (concat "(default " gnus-last-search-regexp ") "))))))
  2823.   (if (string-equal regexp "")
  2824.       (setq regexp (or gnus-last-search-regexp ""))
  2825.     (setq gnus-last-search-regexp regexp))
  2826.   (if (gnus-Subject-search-article regexp t)
  2827.       (gnus-eval-in-buffer-window gnus-Article-buffer
  2828.     (recenter 0)
  2829.     ;;(sit-for 1)
  2830.     )
  2831.     (error "Search failed: \"%s\"" regexp)
  2832.     ))
  2833.  
  2834. (defun gnus-Subject-search-article (regexp &optional backward)
  2835.   "Search for an article containing REGEXP.
  2836. Optional argument BACKWARD means do search for backward.
  2837. gnus-Select-article-hook is not called during the search."
  2838.   (let ((gnus-Select-article-hook nil)    ;Disable hook.
  2839.     (gnus-Mark-article-hook nil)    ;Inhibit marking as read.
  2840.     (re-search
  2841.      (if backward
  2842.          (function re-search-backward) (function re-search-forward)))
  2843.     (found nil)
  2844.     (last nil))
  2845.     ;; Hidden thread subtrees must be searched for ,too.
  2846.     (gnus-Subject-show-all-threads)
  2847.     ;; First of all, search current article.
  2848.     ;; We don't want to read article again from NNTP server nor reset
  2849.     ;; current point.
  2850.     (gnus-Subject-select-article)
  2851.     (message "Searching article: %d..." gnus-current-article)
  2852.     (setq last gnus-current-article)
  2853.     (gnus-eval-in-buffer-window gnus-Article-buffer
  2854.       (save-restriction
  2855.     (widen)
  2856.     ;; Begin search from current point.
  2857.     (setq found (funcall re-search regexp nil t))))
  2858.     ;; Then search next articles.
  2859.     (while (and (not found)
  2860.         (gnus-Subject-display-article 
  2861.          (gnus-Subject-search-subject backward nil nil)))
  2862.       (message "Searching article: %d..." gnus-current-article)
  2863.       (gnus-eval-in-buffer-window gnus-Article-buffer
  2864.     (save-restriction
  2865.       (widen)
  2866.       (goto-char (if backward (point-max) (point-min)))
  2867.       (setq found (funcall re-search regexp nil t)))
  2868.     ))
  2869.     (message "")
  2870.     ;; Adjust article pointer.
  2871.     (or (eq last gnus-current-article)
  2872.     (setq gnus-last-article last))
  2873.     ;; Return T if found such article.
  2874.     found
  2875.     ))
  2876.  
  2877. (defun gnus-Subject-execute-command (field regexp command &optional backward)
  2878.   "If FIELD of article header matches REGEXP, execute COMMAND string.
  2879. If FIELD is an empty string (or nil), entire article body is searched for.
  2880. If optional (prefix) argument BACKWARD is non-nil, do backward instead."
  2881.   (interactive
  2882.    (list (let ((completion-ignore-case t))
  2883.        (completing-read "Field name: "
  2884.                 '(("Number")("Subject")("From")
  2885.                   ("Lines")("Date")("Id")
  2886.                   ("Xref")("References"))
  2887.                 nil 'require-match))
  2888.      (read-string "Regexp: ")
  2889.      (read-key-sequence "Command: ")
  2890.      current-prefix-arg))
  2891.   ;; Hidden thread subtrees must be searched for ,too.
  2892.   (gnus-Subject-show-all-threads)
  2893.   ;; We don't want to change current point nor window configuration.
  2894.   (save-excursion
  2895.     (save-window-excursion
  2896.       (message "Executing %s..." (key-description command))
  2897.       ;; We'd like to execute COMMAND interactively so as to give arguments.
  2898.       (gnus-execute field regexp
  2899.             (` (lambda ()
  2900.              (call-interactively '(, (key-binding command)))))
  2901.             backward)
  2902.       (message "Executing %s... done" (key-description command)))))
  2903.  
  2904. (defun gnus-Subject-beginning-of-article ()
  2905.   "Go to beginning of article body"
  2906.   (interactive)
  2907.   (gnus-Subject-select-article)
  2908.   (gnus-eval-in-buffer-window gnus-Article-buffer
  2909.     (widen)
  2910.     (beginning-of-buffer)
  2911.     (if gnus-break-pages
  2912.     (gnus-narrow-to-page))
  2913.     ))
  2914.  
  2915. (defun gnus-Subject-end-of-article ()
  2916.   "Go to end of article body"
  2917.   (interactive)
  2918.   (gnus-Subject-select-article)
  2919.   (gnus-eval-in-buffer-window gnus-Article-buffer
  2920.     (widen)
  2921.     (end-of-buffer)
  2922.     (if gnus-break-pages
  2923.     (gnus-narrow-to-page))
  2924.     ))
  2925.  
  2926. (defun gnus-Subject-goto-article (article &optional all-headers)
  2927.   "Read ARTICLE if exists.
  2928. Optional argument ALL-HEADERS means all headers are shown."
  2929.   (interactive
  2930.    (list
  2931.     (string-to-int
  2932.      (completing-read "Article number: "
  2933.               (mapcar
  2934.                (function
  2935.             (lambda (headers)
  2936.               (list
  2937.                (int-to-string (nntp-header-number headers)))))
  2938.                gnus-newsgroup-headers)
  2939.               nil 'require-match))))
  2940.   (if (gnus-Subject-goto-subject article)
  2941.       (gnus-Subject-display-article article all-headers)))
  2942.  
  2943. (defun gnus-Subject-goto-last-article ()
  2944.   "Go to last subject line."
  2945.   (interactive)
  2946.   (if gnus-last-article
  2947.       (gnus-Subject-goto-article gnus-last-article)))
  2948.  
  2949. (defun gnus-Subject-show-article ()
  2950.   "Force to show current article."
  2951.   (interactive)
  2952.   ;; The following is a trick to force to read the current article again.
  2953.   (setq gnus-have-all-headers (not gnus-have-all-headers))
  2954.   (gnus-Subject-select-article (not gnus-have-all-headers) t))
  2955.  
  2956. (defun gnus-Subject-toggle-header (arg)
  2957.   "Show original header if pruned header currently shown, or vice versa.
  2958. With arg, show original header iff arg is positive."
  2959.   (interactive "P")
  2960.   ;; Variable gnus-show-all-headers must be NIL to toggle really.
  2961.   (let ((gnus-show-all-headers nil)
  2962.     (all-headers
  2963.      (if (null arg) (not gnus-have-all-headers)
  2964.        (> (prefix-numeric-value arg) 0))))
  2965.     (gnus-Subject-select-article all-headers t)))
  2966.  
  2967. (defun gnus-Subject-show-all-headers ()
  2968.   "Show original article header."
  2969.   (interactive)
  2970.   (gnus-Subject-select-article t t))
  2971.  
  2972. (defun gnus-Subject-stop-page-breaking ()
  2973.   "Stop page breaking by linefeed temporary (Widen article buffer)."
  2974.   (interactive)
  2975.   (gnus-Subject-select-article)
  2976.   (gnus-eval-in-buffer-window gnus-Article-buffer
  2977.     (widen)
  2978.     ))
  2979.  
  2980. (defun gnus-Subject-kill-same-subject-and-select (unmark)
  2981.   "Mark articles which has the same subject as read, and then select next.
  2982. If argument UNMARK is positive, remove any kinds of marks.
  2983. If argument UNMARK is negative, mark articles as unread instead."
  2984.   (interactive "P")
  2985.   (if unmark
  2986.       (setq unmark (prefix-numeric-value unmark)))
  2987.   (let ((count
  2988.      (gnus-Subject-mark-same-subject
  2989.       (gnus-Subject-subject-string) unmark)))
  2990.     ;; Select next unread article. If auto-select-same mode, should
  2991.     ;; select the first unread article.
  2992.     (gnus-Subject-next-article t (and gnus-auto-select-same
  2993.                       (gnus-Subject-subject-string)))
  2994.     (message "%d articles are marked as %s"
  2995.          count (if unmark "unread" "read"))
  2996.     ))
  2997.  
  2998. (defun gnus-Subject-kill-same-subject (unmark)
  2999.   "Mark articles which has the same subject as read. 
  3000. If argument UNMARK is positive, remove any kinds of marks.
  3001. If argument UNMARK is negative, mark articles as unread instead."
  3002.   (interactive "P")
  3003.   (if unmark
  3004.       (setq unmark (prefix-numeric-value unmark)))
  3005.   (let ((count
  3006.      (gnus-Subject-mark-same-subject
  3007.       (gnus-Subject-subject-string) unmark)))
  3008.     ;; If marked as read, go to next unread subject.
  3009.     (if (null unmark)
  3010.     ;; Go to next unread subject.
  3011.     (gnus-Subject-next-subject 1 t))
  3012.     (message "%d articles are marked as %s"
  3013.          count (if unmark "unread" "read"))
  3014.     ))
  3015.  
  3016. (defun gnus-Subject-mark-same-subject (subject &optional unmark)
  3017.   "Mark articles with same SUBJECT as read, and return marked number.
  3018. If optional argument UNMARK is positive, remove any kinds of marks.
  3019. If optional argument UNMARK is negative, mark articles as unread instead."
  3020.   (let ((count 1))
  3021.     (save-excursion
  3022.       (cond ((null unmark)
  3023.          (gnus-Subject-mark-as-read nil "K"))
  3024.         ((> unmark 0)
  3025.          (gnus-Subject-mark-as-unread nil t))
  3026.         (t
  3027.          (gnus-Subject-mark-as-unread)))
  3028.       (while (and subject
  3029.           (gnus-Subject-search-forward nil subject))
  3030.     (cond ((null unmark)
  3031.            (gnus-Subject-mark-as-read nil "K"))
  3032.           ((> unmark 0)
  3033.            (gnus-Subject-mark-as-unread nil t))
  3034.           (t
  3035.            (gnus-Subject-mark-as-unread)))
  3036.     (setq count (1+ count))
  3037.     ))
  3038.     ;; Hide killed thread subtrees.  Does not work properly always.
  3039.     ;;(and (null unmark)
  3040.     ;;     gnus-thread-hide-killed
  3041.     ;;       (gnus-Subject-hide-thread))
  3042.     ;; Return number of articles marked as read.
  3043.     count
  3044.     ))
  3045.  
  3046. (defun gnus-Subject-mark-as-unread-forward (count)
  3047.   "Mark current article as unread, and then go forward.
  3048. Argument COUNT specifies number of articles marked as unread."
  3049.   (interactive "p")
  3050.   (while (> count 0)
  3051.     (gnus-Subject-mark-as-unread nil nil)
  3052.     (gnus-Subject-next-subject 1 nil)
  3053.     (setq count (1- count))))
  3054.  
  3055. (defun gnus-Subject-mark-as-unread-backward (count)
  3056.   "Mark current article as unread, and then go backward.
  3057. Argument COUNT specifies number of articles marked as unread."
  3058.   (interactive "p")
  3059.   (while (> count 0)
  3060.     (gnus-Subject-mark-as-unread nil nil)
  3061.     (gnus-Subject-prev-subject 1 nil)
  3062.     (setq count (1- count))))
  3063.  
  3064. (defun gnus-Subject-mark-as-unread (&optional article clear-mark)
  3065.   "Mark current article as unread.
  3066. Optional 1st argument ARTICLE specifies article number to be marked as unread.
  3067. Optional 2nd argument CLEAR-MARK remove any kinds of mark."
  3068.   (save-excursion
  3069.     (set-buffer gnus-Subject-buffer)
  3070.     ;; First of all, show hidden thread subtrees.
  3071.     (gnus-Subject-show-thread)
  3072.     (let* ((buffer-read-only nil)
  3073.        (current (gnus-Subject-article-number))
  3074.        (article (or article current)))
  3075.       (gnus-mark-article-as-unread article clear-mark)
  3076.       (if (or (eq article current)
  3077.           (gnus-Subject-goto-subject article))
  3078.       (progn
  3079.         (beginning-of-line)
  3080.         (delete-char 1)
  3081.         (insert (if clear-mark " " "-"))))
  3082.       )))
  3083.  
  3084. (defun gnus-Subject-mark-as-read-forward (count)
  3085.   "Mark current article as read, and then go forward.
  3086. Argument COUNT specifies number of articles marked as read"
  3087.   (interactive "p")
  3088.   (while (> count 0)
  3089.     (gnus-Subject-mark-as-read)
  3090.     (gnus-Subject-next-subject 1 'unread-only)
  3091.     (setq count (1- count))))
  3092.  
  3093. (defun gnus-Subject-mark-as-read-backward (count)
  3094.   "Mark current article as read, and then go backward.
  3095. Argument COUNT specifies number of articles marked as read"
  3096.   (interactive "p")
  3097.   (while (> count 0)
  3098.     (gnus-Subject-mark-as-read)
  3099.     (gnus-Subject-prev-subject 1 'unread-only)
  3100.     (setq count (1- count))))
  3101.  
  3102. (defun gnus-Subject-mark-as-read (&optional article mark)
  3103.   "Mark current article as read.
  3104. Optional 1st argument ARTICLE specifies article number to be marked as read.
  3105. Optional 2nd argument MARK specifies a string inserted at beginning of line.
  3106. Any kind of string (length 1) except for a space and `-' is ok."
  3107.   (save-excursion
  3108.     (set-buffer gnus-Subject-buffer)
  3109.     ;; First of all, show hidden thread subtrees.
  3110.     (gnus-Subject-show-thread)
  3111.     (let* ((buffer-read-only nil)
  3112.        (mark (or mark "D"))        ;Default mark is `D'.
  3113.        (current (gnus-Subject-article-number))
  3114.        (article (or article current)))
  3115.       (gnus-mark-article-as-read article)
  3116.       (if (or (eq article current)
  3117.           (gnus-Subject-goto-subject article))
  3118.       (progn
  3119.         (beginning-of-line)
  3120.         (delete-char 1)
  3121.         (insert mark)))
  3122.       )))
  3123.  
  3124. (defun gnus-Subject-clear-mark-forward (count)
  3125.   "Remove current article's mark, and go forward.
  3126. Argument COUNT specifies number of articles unmarked"
  3127.   (interactive "p")
  3128.   (while (> count 0)
  3129.     (gnus-Subject-mark-as-unread nil t)
  3130.     (gnus-Subject-next-subject 1 nil)
  3131.     (setq count (1- count))))
  3132.  
  3133. (defun gnus-Subject-clear-mark-backward (count)
  3134.   "Remove current article's mark, and go backward.
  3135. Argument COUNT specifies number of articles unmarked"
  3136.   (interactive "p")
  3137.   (while (> count 0)
  3138.     (gnus-Subject-mark-as-unread nil t)
  3139.     (gnus-Subject-prev-subject 1 nil)
  3140.     (setq count (1- count))))
  3141.  
  3142. (defun gnus-Subject-delete-marked-as-read ()
  3143.   "Delete lines which is marked as read."
  3144.   (interactive)
  3145.   (if gnus-newsgroup-unreads
  3146.       (let ((buffer-read-only nil))
  3147.     (save-excursion
  3148.       (goto-char (point-min))
  3149.       (delete-non-matching-lines "^[-@ ]"))
  3150.     ;; Adjust point.
  3151.     (if (eobp)
  3152.         (gnus-Subject-prev-subject 1)
  3153.       (beginning-of-line)
  3154.       (search-forward ":" nil t)))
  3155.     ;; It is not so good idea to make the buffer empty.
  3156.     (message "All articles are marked as read")
  3157.     ))
  3158.  
  3159. (defun gnus-Subject-delete-marked-with (marks)
  3160.   "Delete lines which are marked with MARKS (e.g. \"DK\")."
  3161.   (interactive "sMarks: ")
  3162.   (let ((buffer-read-only nil))
  3163.     (save-excursion
  3164.       (goto-char (point-min))
  3165.       (delete-matching-lines (concat "^[" marks "]")))
  3166.     ;; Adjust point.
  3167.     (or (zerop (buffer-size))
  3168.     (if (eobp)
  3169.         (gnus-Subject-prev-subject 1)
  3170.       (beginning-of-line)
  3171.       (search-forward ":" nil t)))
  3172.     ))
  3173.  
  3174. ;; Thread-based commands.
  3175.  
  3176. (defun gnus-Subject-toggle-threads (arg)
  3177.   "Toggle showing conversation threads.
  3178. With arg, turn showing conversation threads on iff arg is positive."
  3179.   (interactive "P")
  3180.   (let ((current (gnus-Subject-article-number)))
  3181.     (setq gnus-show-threads
  3182.       (if (null arg) (not gnus-show-threads)
  3183.         (> (prefix-numeric-value arg) 0)))
  3184.     (gnus-Subject-prepare)
  3185.     (gnus-Subject-goto-subject current)
  3186.     ))
  3187.  
  3188. (defun gnus-Subject-show-all-threads ()
  3189.   "Show all thread subtrees."
  3190.   (interactive)
  3191.   (if gnus-show-threads
  3192.       (save-excursion
  3193.     (let ((buffer-read-only nil))
  3194.       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
  3195.       ))))
  3196.  
  3197. (defun gnus-Subject-show-thread ()
  3198.   "Show thread subtrees."
  3199.   (interactive)
  3200.   (if gnus-show-threads
  3201.       (save-excursion
  3202.     (let ((buffer-read-only nil))
  3203.       (subst-char-in-region (progn
  3204.                   (beginning-of-line) (point))
  3205.                 (progn
  3206.                   (end-of-line) (point))
  3207.                 ?\^M ?\n t)
  3208.       ))))
  3209.  
  3210. (defun gnus-Subject-hide-all-threads ()
  3211.   "Hide all thread subtrees."
  3212.   (interactive)
  3213.   (if gnus-show-threads
  3214.       (save-excursion
  3215.     ;; Adjust cursor point.
  3216.     (goto-char (point-min))
  3217.     (search-forward ":" nil t)
  3218.     (let ((level (current-column)))
  3219.       (gnus-Subject-hide-thread)
  3220.       (while (gnus-Subject-search-forward)
  3221.         (and (>= level (current-column))
  3222.          (gnus-Subject-hide-thread)))
  3223.       ))))
  3224.  
  3225. (defun gnus-Subject-hide-thread ()
  3226.   "Hide thread subtrees."
  3227.   (interactive)
  3228.   (if gnus-show-threads
  3229.       (save-excursion
  3230.     ;; Adjust cursor point.
  3231.     (beginning-of-line)
  3232.     (search-forward ":" nil t)
  3233.     (let ((buffer-read-only nil)
  3234.           (init (point))
  3235.           (last (point))
  3236.           (level (current-column)))
  3237.       (while (and (gnus-Subject-search-forward)
  3238.               (< level (current-column)))
  3239.         ;; Interested in lower levels.
  3240.         (if (< level (current-column))
  3241.         (progn
  3242.           (setq last (point))
  3243.           ))
  3244.         )
  3245.       (subst-char-in-region init last ?\n ?\^M t)
  3246.       ))))
  3247.  
  3248. (defun gnus-Subject-next-thread (n)
  3249.   "Go to the same level next thread.
  3250. Argument N specifies the number of threads."
  3251.   (interactive "p")
  3252.   ;; Adjust cursor point.
  3253.   (beginning-of-line)
  3254.   (search-forward ":" nil t)
  3255.   (let ((init (point))
  3256.     (last (point))
  3257.     (level (current-column)))
  3258.     (while (and (> n 0)
  3259.         (gnus-Subject-search-forward)
  3260.         (<= level (current-column)))
  3261.       ;; We have to skip lower levels.
  3262.       (if (= level (current-column))
  3263.       (progn
  3264.         (setq last (point))
  3265.         (setq n (1- n))
  3266.         ))
  3267.       )
  3268.     ;; Return non-nil if successfully move to the next.
  3269.     (prog1 (not (= init last))
  3270.       (goto-char last))
  3271.     ))
  3272.  
  3273. (defun gnus-Subject-prev-thread (n)
  3274.   "Go to the same level previous thread.
  3275. Argument N specifies the number of threads."
  3276.   (interactive "p")
  3277.   ;; Adjust cursor point.
  3278.   (beginning-of-line)
  3279.   (search-forward ":" nil t)
  3280.   (let ((init (point))
  3281.     (last (point))
  3282.     (level (current-column)))
  3283.     (while (and (> n 0)
  3284.         (gnus-Subject-search-backward)
  3285.         (<= level (current-column)))
  3286.       ;; We have to skip lower levels.
  3287.       (if (= level (current-column))
  3288.       (progn
  3289.         (setq last (point))
  3290.         (setq n (1- n))
  3291.         ))
  3292.       )
  3293.     ;; Return non-nil if successfully move to the previous.
  3294.     (prog1 (not (= init last))
  3295.       (goto-char last))
  3296.     ))
  3297.  
  3298. (defun gnus-Subject-down-thread (d)
  3299.   "Go downward current thread.
  3300. Argument D specifies the depth goes down."
  3301.   (interactive "p")
  3302.   ;; Adjust cursor point.
  3303.   (beginning-of-line)
  3304.   (search-forward ":" nil t)
  3305.   (let ((last (point))
  3306.     (level (current-column)))
  3307.     (while (and (> d 0)
  3308.         (gnus-Subject-search-forward)
  3309.         (<= level (current-column))) ;<= can be <.  Which do you like?
  3310.       ;; We have to skip the same levels.
  3311.       (if (< level (current-column))
  3312.       (progn
  3313.         (setq last (point))
  3314.         (setq level (current-column))
  3315.         (setq d (1- d))
  3316.         ))
  3317.       )
  3318.     (goto-char last)
  3319.     ))
  3320.  
  3321. (defun gnus-Subject-up-thread (d)
  3322.   "Go upward current thread.
  3323. Argument D specifies the depth goes up."
  3324.   (interactive "p")
  3325.   ;; Adjust cursor point.
  3326.   (beginning-of-line)
  3327.   (search-forward ":" nil t)
  3328.   (let ((last (point))
  3329.     (level (current-column)))
  3330.     (while (and (> d 0)
  3331.         (gnus-Subject-search-backward))
  3332.       ;; We have to skip the same levels.
  3333.       (if (> level (current-column))
  3334.       (progn
  3335.         (setq last (point))
  3336.         (setq level (current-column))
  3337.         (setq d (1- d))
  3338.         ))
  3339.       )
  3340.     (goto-char last)
  3341.     ))
  3342.  
  3343. (defun gnus-Subject-kill-thread (unmark)
  3344.   "Mark articles under current thread as read.
  3345. If argument UNMARK is positive, remove any kinds of marks.
  3346. If argument UNMARK is negative, mark articles as unread instead."
  3347.   (interactive "P")
  3348.   (if unmark
  3349.       (setq unmark (prefix-numeric-value unmark)))
  3350.   ;; Adjust cursor point.
  3351.   (beginning-of-line)
  3352.   (search-forward ":" nil t)
  3353.   (save-excursion
  3354.     (let ((level (current-column)))
  3355.       ;; Mark current article.
  3356.       (cond ((null unmark)
  3357.          (gnus-Subject-mark-as-read nil "K"))
  3358.         ((> unmark 0)
  3359.          (gnus-Subject-mark-as-unread nil t))
  3360.         (t
  3361.          (gnus-Subject-mark-as-unread))
  3362.         )
  3363.       ;; Mark following articles.
  3364.       (while (and (gnus-Subject-search-forward)
  3365.           (< level (current-column)))
  3366.     (cond ((null unmark)
  3367.            (gnus-Subject-mark-as-read nil "K"))
  3368.           ((> unmark 0)
  3369.            (gnus-Subject-mark-as-unread nil t))
  3370.           (t
  3371.            (gnus-Subject-mark-as-unread))
  3372.           ))
  3373.       ))
  3374.   ;; Hide killed subtrees.
  3375.   (and (null unmark)
  3376.        gnus-thread-hide-killed
  3377.        (gnus-Subject-hide-thread))
  3378.   ;; If marked as read, go to next unread subject.
  3379.   (if (null unmark)
  3380.       ;; Go to next unread subject.
  3381.       (gnus-Subject-next-subject 1 t))
  3382.   )
  3383.  
  3384. (defun gnus-Subject-toggle-truncation (arg)
  3385.   "Toggle truncation of subject lines.
  3386. With arg, turn line truncation on iff arg is positive."
  3387.   (interactive "P")
  3388.   (setq truncate-lines
  3389.     (if (null arg) (not truncate-lines)
  3390.       (> (prefix-numeric-value arg) 0)))
  3391.   (redraw-display))
  3392.  
  3393. (defun gnus-Subject-sort-by-number (reverse)
  3394.   "Sort subject display buffer by article number.
  3395. Argument REVERSE means reverse order."
  3396.   (interactive "P")
  3397.   (gnus-Subject-sort-subjects
  3398.    (function
  3399.     (lambda (a b)
  3400.       (< (nntp-header-number a) (nntp-header-number b))))
  3401.    reverse
  3402.    ))
  3403.  
  3404. (defun gnus-Subject-sort-by-author (reverse)
  3405.   "Sort subject display buffer by author name alphabetically.
  3406. If case-fold-search is non-nil, case of letters is ignored.
  3407. Argument REVERSE means reverse order."
  3408.   (interactive "P")
  3409.   (gnus-Subject-sort-subjects
  3410.    (function
  3411.     (lambda (a b)
  3412.       (gnus-string-lessp (nntp-header-from a) (nntp-header-from b))))
  3413.    reverse
  3414.    ))
  3415.  
  3416. (defun gnus-Subject-sort-by-subject (reverse)
  3417.   "Sort subject display buffer by subject alphabetically. `Re:'s are ignored.
  3418. If case-fold-search is non-nil, case of letters is ignored.
  3419. Argument REVERSE means reverse order."
  3420.   (interactive "P")
  3421.   (gnus-Subject-sort-subjects
  3422.    (function
  3423.     (lambda (a b)
  3424.       (gnus-string-lessp
  3425.        (gnus-simplify-subject (nntp-header-subject a) 're-only)
  3426.        (gnus-simplify-subject (nntp-header-subject b) 're-only))))
  3427.    reverse
  3428.    ))
  3429.  
  3430. (defun gnus-Subject-sort-by-date (reverse)
  3431.   "Sort subject display buffer by posted date.
  3432. Argument REVERSE means reverse order."
  3433.   (interactive "P")
  3434.   (gnus-Subject-sort-subjects
  3435.    (function
  3436.     (lambda (a b)
  3437.       (gnus-date-lessp (nntp-header-date a) (nntp-header-date b))))
  3438.    reverse
  3439.    ))
  3440.  
  3441. (defun gnus-Subject-sort-subjects (predicate &optional reverse)
  3442.   "Sort subject display buffer by PREDICATE.
  3443. Optional argument REVERSE means reverse order."
  3444.   (let ((current (gnus-Subject-article-number)))
  3445.     (gnus-sort-headers predicate reverse)
  3446.     (gnus-Subject-prepare)
  3447.     (gnus-Subject-goto-subject current)
  3448.     ))
  3449.  
  3450. (defun gnus-Subject-reselect-current-group (show-all)
  3451.   "Once exit and then reselect the current newsgroup.
  3452. Prefix argument SHOW-ALL means to select all articles."
  3453.   (interactive "P")
  3454.   (let ((current-subject (gnus-Subject-article-number)))
  3455.     (gnus-Subject-exit t)
  3456.     ;; We have to adjust the point of Group mode buffer because the
  3457.     ;; current point was moved to the next unread newsgroup by
  3458.     ;; exiting.
  3459.     (gnus-Subject-jump-to-group gnus-newsgroup-name)
  3460.     (gnus-Group-read-group show-all t)
  3461.     (gnus-Subject-goto-subject current-subject)
  3462.     ))
  3463.  
  3464. (defun gnus-Subject-caesar-message (rotnum)
  3465.   "Caesar rotates all letters of current message by 13/47 places.
  3466. With prefix arg, specifies the number of places to rotate each letter forward.
  3467. Caesar rotates Japanese letters by 47 places in any case."
  3468.   (interactive "P")
  3469.   (gnus-Subject-select-article)
  3470.   (gnus-overload-functions)
  3471.   (gnus-eval-in-buffer-window gnus-Article-buffer
  3472.     (save-restriction
  3473.       (widen)
  3474.       ;; We don't want to jump to the beginning of the message.
  3475.       ;; `save-excursion' does not do its job.
  3476.       (move-to-window-line 0)
  3477.       (let ((last (point)))
  3478.     (news-caesar-buffer-body rotnum)
  3479.     (goto-char last)
  3480.     (recenter 0)
  3481.     ))
  3482.     ))
  3483.  
  3484. (defun gnus-Subject-rmail-digest ()
  3485.   "Run RMAIL on current digest article.
  3486. gnus-Select-digest-hook will be called with no arguments, if that
  3487. value is non-nil. It is possible to modify the article so that Rmail
  3488. can work with it.
  3489. gnus-Rmail-digest-hook will be called with no arguments, if that value
  3490. is non-nil. The hook is intended to customize Rmail mode."
  3491.   (interactive)
  3492.   (gnus-Subject-select-article)
  3493.   (require 'rmail)
  3494.   (let ((artbuf gnus-Article-buffer)
  3495.     (digbuf (get-buffer-create gnus-Digest-buffer))
  3496.     (mail-header-separator ""))
  3497.     (set-buffer digbuf)
  3498.     (buffer-disable-undo (current-buffer))
  3499.     (setq buffer-read-only nil)
  3500.     (erase-buffer)
  3501.     (insert-buffer-substring artbuf)
  3502.     (run-hooks 'gnus-Select-digest-hook)
  3503.     (gnus-convert-article-to-rmail)
  3504.     (goto-char (point-min))
  3505.     ;; Rmail initializations.
  3506.     (rmail-insert-rmail-file-header)
  3507.     (rmail-mode)
  3508.     (rmail-set-message-counters)
  3509.     (rmail-show-message)
  3510.     (condition-case ()
  3511.     (progn
  3512.       (undigestify-rmail-message)
  3513.       (rmail-expunge)        ;Delete original message.
  3514.       ;; File name is meaningless but `save-buffer' requires it.
  3515.       (setq buffer-file-name "GNUS Digest")
  3516.       (setq mode-line-buffer-identification
  3517.         (concat "Digest: "
  3518.             (nntp-header-subject gnus-current-headers)))
  3519.       ;; There is no need to write this buffer to a file.
  3520.       (make-local-variable 'write-file-hooks)
  3521.       (setq write-file-hooks
  3522.         (list (function
  3523.                (lambda ()
  3524.              (set-buffer-modified-p nil)
  3525.              (message "(No changes need to be saved)")
  3526.              'no-need-to-write-this-buffer))))
  3527.       ;; Default file name saving digest messages.
  3528.       (setq rmail-last-rmail-file
  3529.         (funcall gnus-rmail-save-name
  3530.              gnus-newsgroup-name
  3531.              gnus-current-headers
  3532.              gnus-newsgroup-last-rmail
  3533.              ))
  3534.       (setq rmail-last-file
  3535.         (funcall gnus-mail-save-name
  3536.              gnus-newsgroup-name
  3537.              gnus-current-headers
  3538.              gnus-newsgroup-last-mail
  3539.              ))
  3540.       ;; Prevent generating new buffer named ***<N> each time.
  3541.       (setq rmail-summary-buffer
  3542.         (get-buffer-create gnus-Digest-summary-buffer))
  3543.       (run-hooks 'gnus-Rmail-digest-hook)
  3544.       ;; Take all windows safely.
  3545.       (gnus-configure-windows '(1 0 0))
  3546.       (gnus-pop-to-buffer gnus-Group-buffer)
  3547.       ;; Use Subject and Article windows for Digest summary and
  3548.       ;; Digest buffers.
  3549.       (if gnus-digest-show-summary
  3550.           (let ((gnus-Subject-buffer gnus-Digest-summary-buffer)
  3551.             (gnus-Article-buffer gnus-Digest-buffer))
  3552.         (gnus-configure-windows 'SelectArticle)
  3553.         (gnus-pop-to-buffer gnus-Digest-buffer)
  3554.         (rmail-summary)
  3555.         (gnus-pop-to-buffer gnus-Digest-summary-buffer)
  3556.         (message (substitute-command-keys
  3557.               "Type \\[rmail-summary-quit] to return to GNUS")))
  3558.         (let ((gnus-Subject-buffer gnus-Digest-buffer))
  3559.           (gnus-configure-windows 'ExpandSubject)
  3560.           (gnus-pop-to-buffer gnus-Digest-buffer)
  3561.           (message (substitute-command-keys
  3562.             "Type \\[rmail-quit] to return to GNUS")))
  3563.         )
  3564.       ;; Move the buffers to the end of buffer list.
  3565.       (bury-buffer gnus-Article-buffer)
  3566.       (bury-buffer gnus-Group-buffer)
  3567.       (bury-buffer gnus-Digest-summary-buffer)
  3568.       (bury-buffer gnus-Digest-buffer))
  3569.       (error (set-buffer-modified-p nil)
  3570.          (kill-buffer digbuf)
  3571.          ;; This command should not signal an error because the
  3572.          ;; command is called from hooks.
  3573.          (ding) (message "Article is not a digest")))
  3574.     ))
  3575.  
  3576. (defun gnus-Subject-save-article ()
  3577.   "Save this article using default saver function.
  3578. Variable `gnus-default-article-saver' specifies the saver function."
  3579.   (interactive)
  3580.   (gnus-Subject-select-article
  3581.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  3582.   (if gnus-default-article-saver
  3583.       (call-interactively gnus-default-article-saver)
  3584.     (error "No default saver is defined.")))
  3585.  
  3586. (defun gnus-Subject-save-in-rmail (&optional filename)
  3587.   "Append this article to Rmail file.
  3588. Optional argument FILENAME specifies file name.
  3589. Directory to save to is default to `gnus-article-save-directory' which
  3590. is initialized from the SAVEDIR environment variable."
  3591.   (interactive)
  3592.   (gnus-Subject-select-article
  3593.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  3594.   (gnus-eval-in-buffer-window gnus-Article-buffer
  3595.     (save-excursion
  3596.       (save-restriction
  3597.     (widen)
  3598.     (let ((default-name
  3599.         (funcall gnus-rmail-save-name
  3600.              gnus-newsgroup-name
  3601.              gnus-current-headers
  3602.              gnus-newsgroup-last-rmail
  3603.              )))
  3604.       (or filename
  3605.           (setq filename
  3606.             (read-file-name
  3607.              (concat "Save article in Rmail file: (default "
  3608.                  (file-name-nondirectory default-name)
  3609.                  ") ")
  3610.              (file-name-directory default-name)
  3611.              default-name)))
  3612.       (gnus-make-directory (file-name-directory filename))
  3613.       (gnus-output-to-rmail filename)
  3614.       ;; Remember the directory name to save articles.
  3615.       (setq gnus-newsgroup-last-rmail filename)
  3616.       )))
  3617.     ))
  3618.  
  3619. (defun gnus-Subject-save-in-mail (&optional filename)
  3620.   "Append this article to Unix mail file.
  3621. Optional argument FILENAME specifies file name.
  3622. Directory to save to is default to `gnus-article-save-directory' which
  3623. is initialized from the SAVEDIR environment variable."
  3624.   (interactive)
  3625.   (gnus-Subject-select-article
  3626.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  3627.   (gnus-eval-in-buffer-window gnus-Article-buffer
  3628.     (save-excursion
  3629.       (save-restriction
  3630.     (widen)
  3631.     (let ((default-name
  3632.         (funcall gnus-mail-save-name
  3633.              gnus-newsgroup-name
  3634.              gnus-current-headers
  3635.              gnus-newsgroup-last-mail
  3636.              )))
  3637.       (or filename
  3638.           (setq filename
  3639.             (read-file-name
  3640.              (concat "Save article in Unix mail file: (default "
  3641.                  (file-name-nondirectory default-name)
  3642.                  ") ")
  3643.              (file-name-directory default-name)
  3644.              default-name)))
  3645.       (gnus-make-directory (file-name-directory filename))
  3646.       (gnus-rmail-output filename)
  3647.       ;; Remember the directory name to save articles.
  3648.       (setq gnus-newsgroup-last-mail filename)
  3649.       )))
  3650.     ))
  3651.  
  3652. (defun gnus-Subject-save-in-file (&optional filename)
  3653.   "Append this article to file.
  3654. Optional argument FILENAME specifies file name.
  3655. Directory to save to is default to `gnus-article-save-directory' which
  3656. is initialized from the SAVEDIR environment variable."
  3657.   (interactive)
  3658.   (gnus-Subject-select-article
  3659.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  3660.   (gnus-eval-in-buffer-window gnus-Article-buffer
  3661.     (save-excursion
  3662.       (save-restriction
  3663.     (widen)
  3664.     (let ((default-name
  3665.         (funcall gnus-file-save-name
  3666.              gnus-newsgroup-name
  3667.              gnus-current-headers
  3668.              gnus-newsgroup-last-file
  3669.              )))
  3670.       (or filename
  3671.           (setq filename
  3672.             (read-file-name
  3673.              (concat "Save article in file: (default "
  3674.                  (file-name-nondirectory default-name)
  3675.                  ") ")
  3676.              (file-name-directory default-name)
  3677.              default-name)))
  3678.       (gnus-make-directory (file-name-directory filename))
  3679.       (gnus-output-to-file filename)
  3680.       ;; Remember the directory name to save articles.
  3681.       (setq gnus-newsgroup-last-file filename)
  3682.       )))
  3683.     ))
  3684.  
  3685. (defun gnus-Subject-save-in-folder (&optional folder)
  3686.   "Save this article to MH folder (using `rcvstore' in MH library).
  3687. Optional argument FOLDER specifies folder name."
  3688.   (interactive)
  3689.   (gnus-Subject-select-article
  3690.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  3691.   (gnus-eval-in-buffer-window gnus-Article-buffer
  3692.     (save-restriction
  3693.       (widen)
  3694.       ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
  3695.       (mh-find-path)
  3696.       (let ((folder
  3697.          (or folder
  3698.          (mh-prompt-for-folder "Save article in"
  3699.                        (funcall gnus-folder-save-name
  3700.                         gnus-newsgroup-name
  3701.                         gnus-current-headers
  3702.                         gnus-newsgroup-last-folder
  3703.                         )
  3704.                        t
  3705.                        )))
  3706.         (errbuf (get-buffer-create " *GNUS rcvstore*")))
  3707.     (unwind-protect
  3708.         (call-process-region (point-min) (point-max)
  3709.                  (expand-file-name "rcvstore" mh-lib)
  3710.                  nil errbuf nil folder)
  3711.       (set-buffer errbuf)
  3712.       (if (zerop (buffer-size))
  3713.           (message "Article saved in folder: %s" folder)
  3714.         (message "%s" (buffer-string)))
  3715.       (kill-buffer errbuf)
  3716.       (setq gnus-newsgroup-last-folder folder))
  3717.     ))
  3718.     ))
  3719.  
  3720. (defun gnus-Subject-pipe-output ()
  3721.   "Pipe this article to subprocess."
  3722.   (interactive)
  3723.   ;; Ignore `gnus-save-all-headers' since this is not save command.
  3724.   (gnus-Subject-select-article)
  3725.   (gnus-eval-in-buffer-window gnus-Article-buffer
  3726.     (save-restriction
  3727.       (widen)
  3728.       (let ((command (read-string "Shell command on article: "
  3729.                   gnus-last-shell-command)))
  3730.     (if (string-equal command "")
  3731.         (setq command gnus-last-shell-command))
  3732.     (shell-command-on-region (point-min) (point-max) command nil)
  3733.     (setq gnus-last-shell-command command)
  3734.     ))
  3735.     ))
  3736.  
  3737. (defun gnus-Subject-catch-up (all &optional quietly)
  3738.   "Mark all articles not marked as unread in this newsgroup as read.
  3739. If prefix argument ALL is non-nil, all articles are marked as read."
  3740.   (interactive "P")
  3741.   (if (or quietly
  3742.       (y-or-n-p
  3743.        (if all
  3744.            "Do you really want to mark everything as read? "
  3745.          "Delete all articles not marked as unread? ")))
  3746.       (let ((unmarked
  3747.          (gnus-set-difference gnus-newsgroup-unreads
  3748.                   (if (not all) gnus-newsgroup-marked))))
  3749.         (message "")            ;Erase "Yes or No" question.
  3750.     ;; Hidden thread subtrees must be searched for ,too.
  3751.     (gnus-Subject-show-all-threads)
  3752.     (while unmarked
  3753.           (gnus-Subject-mark-as-read (car unmarked) "C")
  3754.       (setq unmarked (cdr unmarked))
  3755.       ))
  3756.     ))
  3757.  
  3758. (defun gnus-Subject-catch-up-all (&optional quietly)
  3759.   "Mark all articles in this newsgroup as read."
  3760.   (interactive)
  3761.   (gnus-Subject-catch-up t quietly))
  3762.  
  3763. (defun gnus-Subject-catch-up-and-exit (all &optional quietly)
  3764.   "Mark all articles not marked as unread in this newsgroup as read, then exit.
  3765. If prefix argument ALL is non-nil, all articles are marked as read."
  3766.   (interactive "P")
  3767.   (if (or quietly
  3768.       (y-or-n-p
  3769.        (if all
  3770.            "Do you really want to mark everything as read? "
  3771.          "Delete all articles not marked as unread? ")))
  3772.       (let ((unmarked
  3773.              (gnus-set-difference gnus-newsgroup-unreads
  3774.                                   (if (not all) gnus-newsgroup-marked))))
  3775.         (message "")            ;Erase "Yes or No" question.
  3776.     (while unmarked
  3777.           (gnus-mark-article-as-read (car unmarked))
  3778.       (setq unmarked (cdr unmarked)))
  3779.     ;; Select next newsgroup or exit.
  3780.     (cond ((eq gnus-auto-select-next 'quietly)
  3781.            ;; Select next newsgroup quietly.
  3782.            (gnus-Subject-next-group nil))
  3783.           (t
  3784.            (gnus-Subject-exit)))
  3785.     )))
  3786.  
  3787. (defun gnus-Subject-catch-up-all-and-exit (&optional quietly)
  3788.   "Mark all articles in this newsgroup as read, and then exit."
  3789.   (interactive)
  3790.   (gnus-Subject-catch-up-and-exit t quietly))
  3791.  
  3792. (defun gnus-Subject-edit-global-kill ()
  3793.   "Edit a global KILL file."
  3794.   (interactive)
  3795.   (setq gnus-current-kill-article (gnus-Subject-article-number))
  3796.   (gnus-Kill-file-edit-file nil)    ;Nil stands for global KILL file.
  3797.   (message
  3798.    (substitute-command-keys
  3799.     "Editing a global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
  3800.  
  3801. (defun gnus-Subject-edit-local-kill ()
  3802.   "Edit a local KILL file applied to the current newsgroup."
  3803.   (interactive)
  3804.   (setq gnus-current-kill-article (gnus-Subject-article-number))
  3805.   (gnus-Kill-file-edit-file gnus-newsgroup-name)
  3806.   (message
  3807.    (substitute-command-keys
  3808.     "Editing a local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
  3809.  
  3810. (defun gnus-Subject-exit (&optional temporary)
  3811.   "Exit reading current newsgroup, and then return to group selection mode.
  3812. gnus-Exit-group-hook is called with no arguments if that value is non-nil."
  3813.   (interactive)
  3814.   (if gnus-digest-mode
  3815.       (gnus-unselect-digest-article)
  3816.     ;; else
  3817.   (let ((updated nil)
  3818.     (gnus-newsgroup-headers gnus-newsgroup-headers)
  3819.     (gnus-newsgroup-unreads gnus-newsgroup-unreads)
  3820.     (gnus-newsgroup-unselected gnus-newsgroup-unselected)
  3821.     (gnus-newsgroup-marked gnus-newsgroup-marked))
  3822.     ;; Important internal variables are saved, so we can reenter
  3823.     ;; Subject Mode buffer even if hook changes them.
  3824.     (run-hooks 'gnus-Exit-group-hook)
  3825.     (gnus-update-unread-articles gnus-newsgroup-name
  3826.                  (append gnus-newsgroup-unselected
  3827.                      gnus-newsgroup-unreads)
  3828.                  gnus-newsgroup-marked)
  3829.     ;; T means ignore unsubscribed newsgroups.
  3830.     (if gnus-use-cross-reference
  3831.     (setq updated
  3832.           (gnus-mark-as-read-by-xref gnus-newsgroup-name
  3833.                      gnus-newsgroup-headers
  3834.                      gnus-newsgroup-unreads
  3835.                      (eq gnus-use-cross-reference t)
  3836.                      )))
  3837.     ;; Do not switch windows but change the buffer to work.
  3838.     (set-buffer gnus-Group-buffer)
  3839.     ;; Update cross referenced group info.
  3840.     (while updated
  3841.       (gnus-Group-update-group (car updated) t) ;Ignore invisible group.
  3842.       (setq updated (cdr updated)))
  3843.     (gnus-Group-update-group gnus-newsgroup-name))
  3844.   ;; Make sure where I was, and go to next newsgroup.
  3845.   (gnus-Group-jump-to-group gnus-newsgroup-name)
  3846.   (gnus-Group-next-unread-group 1)
  3847.   (if temporary
  3848.       ;; If exiting temporary, caller should adjust Group mode
  3849.       ;; buffer point by itself.
  3850.       nil                ;Nothing to do.
  3851.     ;; Return to Group mode buffer.
  3852.     (if (get-buffer gnus-Subject-buffer)
  3853.     (bury-buffer gnus-Subject-buffer))
  3854.     (if (get-buffer gnus-Article-buffer)
  3855.     (bury-buffer gnus-Article-buffer))
  3856.     (gnus-configure-windows 'ExitNewsgroup)
  3857.     (gnus-pop-to-buffer gnus-Group-buffer))))
  3858.  
  3859. (defun gnus-Subject-quit ()
  3860.   "Quit reading current newsgroup without updating read article info."
  3861.   (interactive)
  3862.   (if (y-or-n-p "Do you really wanna quit reading this group? ")
  3863.       (progn
  3864.     (message "")            ;Erase "Yes or No" question.
  3865.     ;; Return to Group selection mode.
  3866.     (if (get-buffer gnus-Subject-buffer)
  3867.         (bury-buffer gnus-Subject-buffer))
  3868.     (if (get-buffer gnus-Article-buffer)
  3869.         (bury-buffer gnus-Article-buffer))
  3870.     (gnus-configure-windows 'ExitNewsgroup)
  3871.     (gnus-pop-to-buffer gnus-Group-buffer)
  3872.     (gnus-Group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
  3873.     (gnus-Group-next-group 1)    ;(gnus-Group-next-unread-group 1)
  3874.     )))
  3875.  
  3876. (defun gnus-Subject-describe-briefly ()
  3877.   "Describe Subject mode commands briefly."
  3878.   (interactive)
  3879.   (message
  3880.    (concat
  3881.     (substitute-command-keys "\\[gnus-Subject-next-page]:Select  ")
  3882.     (substitute-command-keys "\\[gnus-Subject-next-unread-article]:Forward  ")
  3883.     (substitute-command-keys "\\[gnus-Subject-prev-unread-article]:Backward  ")
  3884.     (substitute-command-keys "\\[gnus-Subject-exit]:Exit  ")
  3885.     (substitute-command-keys "\\[gnus-Info-find-node]:Run Info  ")
  3886.     (substitute-command-keys "\\[gnus-Subject-describe-briefly]:This help")
  3887.     )))
  3888.  
  3889.  
  3890. ;;;
  3891. ;;; GNUS Article Mode
  3892. ;;;
  3893.  
  3894. (if gnus-Article-mode-map
  3895.     nil
  3896.   (setq gnus-Article-mode-map (make-keymap))
  3897.   (suppress-keymap gnus-Article-mode-map)
  3898.   (define-key gnus-Article-mode-map " " 'gnus-Article-next-page)
  3899.   (define-key gnus-Article-mode-map "\177" 'gnus-Article-prev-page)
  3900.   (define-key gnus-Article-mode-map "r" 'gnus-Article-refer-article)
  3901.   (define-key gnus-Article-mode-map "o" 'gnus-Article-pop-article)
  3902.   (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects)
  3903.   (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects)
  3904.   (define-key gnus-Article-mode-map "?" 'gnus-Article-describe-briefly)
  3905.   (define-key gnus-Article-mode-map "\C-c\C-i" 'gnus-Info-find-node))
  3906.  
  3907. (defun gnus-Article-mode ()
  3908.   "Major mode for browsing through an article.
  3909. All normal editing commands are turned off.
  3910. Instead, these commands are available:
  3911. \\{gnus-Article-mode-map}
  3912.  
  3913. Various hooks for customization:
  3914.  gnus-Article-mode-hook
  3915.     Entry to this mode calls the value with no arguments, if that
  3916.     value is non-nil.
  3917.  
  3918.  gnus-Article-prepare-hook
  3919.     Called with no arguments after an article is prepared for reading,
  3920.     if that value is non-nil."
  3921.   (interactive)
  3922.   (kill-all-local-variables)
  3923.   ;; Gee.  Why don't you upgrade?
  3924.   (cond ((boundp 'mode-line-modified)
  3925.      (setq mode-line-modified "--- "))
  3926.     ((listp (default-value 'mode-line-format))
  3927.      (setq mode-line-format
  3928.            (cons "--- " (cdr (default-value 'mode-line-format))))))
  3929.   (make-local-variable 'global-mode-string)
  3930.   (setq global-mode-string nil)
  3931.   (setq major-mode 'gnus-Article-mode)
  3932.   (setq mode-name "Article")
  3933.   (gnus-Article-set-mode-line)
  3934.   (use-local-map gnus-Article-mode-map)
  3935.   (make-local-variable 'page-delimiter)
  3936.   (setq page-delimiter gnus-page-delimiter)
  3937.   (make-local-variable 'mail-header-separator)
  3938.   (setq mail-header-separator "")    ;For caesar function.
  3939.   (buffer-disable-undo (current-buffer))
  3940.   (setq buffer-read-only t)        ;Disable modification
  3941.   (run-hooks 'gnus-Article-mode-hook))
  3942.  
  3943. (defun gnus-Article-setup-buffer ()
  3944.   "Initialize Article mode buffer."
  3945.   (or (get-buffer gnus-Article-buffer)
  3946.       (save-excursion
  3947.     (set-buffer (get-buffer-create gnus-Article-buffer))
  3948.     (gnus-Article-mode))
  3949.       ))
  3950.  
  3951. (defvar gnus-digest-mode nil)
  3952.  
  3953. (defun gnus-Article-prepare (article &optional all-headers)
  3954.   "Prepare ARTICLE in Article mode buffer.
  3955. If optional argument ALL-HEADERS is non-nil, all headers are inserted."
  3956.   (save-excursion
  3957.     (set-buffer gnus-Article-buffer)
  3958.     (let ((buffer-read-only nil))
  3959.       (erase-buffer)
  3960.       (if (if gnus-digest-mode
  3961.           (gnus-request-digest-article article)
  3962.         (gnus-request-article article))
  3963.       (progn
  3964.         ;; Prepare article buffer
  3965.         (insert-buffer-substring nntp-server-buffer)
  3966.         (setq gnus-have-all-headers (or all-headers gnus-show-all-headers))
  3967.         (if (and (numberp article)
  3968.              (not (eq article gnus-current-article)))
  3969.         ;; Seems me that a new article is selected.
  3970.         (progn
  3971.           ;; gnus-current-article must be an article number.
  3972.           (setq gnus-last-article gnus-current-article)
  3973.           (setq gnus-current-article article)
  3974. ;;          (setq gnus-current-headers
  3975. ;;            (gnus-find-header-by-number gnus-newsgroup-headers
  3976. ;;                            gnus-current-article))
  3977.           (setq gnus-current-headers
  3978.             (gnus-get-header-by-number gnus-current-article))
  3979.           ;; Clear articles history only when articles are
  3980.           ;; retrieved by article numbers.
  3981.           (setq gnus-current-history nil)
  3982.           (run-hooks 'gnus-Mark-article-hook)
  3983.           ))
  3984.         ;; Hooks for modifying contents of the article. This hook
  3985.         ;; must be called before being narrowed.
  3986.         (run-hooks 'gnus-Article-prepare-hook)
  3987.         ;; Delete unnecessary headers.
  3988.         (or gnus-have-all-headers
  3989.         (gnus-Article-delete-headers))
  3990.         ;; Do page break.
  3991.         (goto-char (point-min))
  3992.         (if gnus-break-pages
  3993.         (gnus-narrow-to-page))
  3994.         ;; Next function must be called after setting
  3995.         ;;  `gnus-current-article' variable and narrowed to page.
  3996.         (gnus-Article-set-mode-line)
  3997.         )
  3998.     (if (numberp article)
  3999.         (gnus-Subject-mark-as-read article))
  4000.     (ding) (message "No such article (may be canceled)"))
  4001.       )))
  4002.  
  4003. (defun gnus-Article-show-all-headers ()
  4004.   "Show all article headers in Article mode buffer."
  4005.   (or gnus-have-all-headers
  4006.       (gnus-Article-prepare gnus-current-article t)))
  4007.  
  4008. ;;(defun gnus-Article-set-mode-line ()
  4009. ;;  "Set Article mode line string."
  4010. ;;  (setq mode-line-buffer-identification
  4011. ;;    (list 17
  4012. ;;          (format "GNUS: %s {%d-%d} %d"
  4013. ;;              gnus-newsgroup-name
  4014. ;;              gnus-newsgroup-begin
  4015. ;;              gnus-newsgroup-end
  4016. ;;              gnus-current-article
  4017. ;;                    )))
  4018. ;;  (set-buffer-modified-p t))
  4019.  
  4020. (defun gnus-Article-set-mode-line ()
  4021.   "Set Article mode line string."
  4022.   (let ((unmarked
  4023.      (- (length gnus-newsgroup-unreads)
  4024.         (length (gnus-intersection
  4025.              gnus-newsgroup-unreads gnus-newsgroup-marked))))
  4026.     (unselected
  4027.      (- (length gnus-newsgroup-unselected)
  4028.         (length (gnus-intersection
  4029.              gnus-newsgroup-unselected gnus-newsgroup-marked)))))
  4030.     (setq mode-line-buffer-identification
  4031.       (list 17
  4032.         (format "GNUS: %s{%d} %s"
  4033.             gnus-newsgroup-name
  4034.             gnus-current-article
  4035.             ;; This is proposed by tale@pawl.rpi.edu.
  4036.             (cond ((and (zerop unmarked)
  4037.                     (zerop unselected))
  4038.                    "      ")
  4039.                   ((zerop unselected)
  4040.                    (format "%d more" unmarked))
  4041.                   (t
  4042.                    (format "%d(+%d) more" unmarked unselected)))
  4043.             ))))
  4044.   (set-buffer-modified-p t))
  4045.  
  4046. (defun gnus-Article-delete-headers ()
  4047.   "Delete unnecessary headers."
  4048.   (save-excursion
  4049.     (save-restriction
  4050.       (goto-char (point-min))
  4051.       (narrow-to-region (point-min)
  4052.             (progn (search-forward "\n\n" nil 'move) (point)))
  4053.       (goto-char (point-min))
  4054.       (and (stringp gnus-ignored-headers)
  4055.        (while (re-search-forward gnus-ignored-headers nil t)
  4056.          (beginning-of-line)
  4057.          (delete-region (point)
  4058.                 (progn (re-search-forward "\n[^ \t]")
  4059.                    (forward-char -1)
  4060.                    (point)))))
  4061.       )))
  4062.  
  4063. ;; Working on article's buffer
  4064.  
  4065. (defun gnus-Article-next-page (lines)
  4066.   "Show next page of current article.
  4067. If end of article, return non-nil. Otherwise return nil.
  4068. Argument LINES specifies lines to be scrolled up."
  4069.   (interactive "P")
  4070.   (move-to-window-line -1)
  4071.   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
  4072.   (if (save-excursion
  4073.     (end-of-line)
  4074.     (and (pos-visible-in-window-p)    ;Not continuation line.
  4075.          (eobp)))
  4076.       ;; Nothing in this page.
  4077.       (if (or (not gnus-break-pages)
  4078.           (save-excursion
  4079.         (save-restriction
  4080.           (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
  4081.       t                ;Nothing more.
  4082.     (gnus-narrow-to-page 1)        ;Go to next page.
  4083.     nil
  4084.     )
  4085.     ;; More in this page.
  4086.     (condition-case ()
  4087.     (scroll-up lines)
  4088.       (end-of-buffer
  4089.        ;; Long lines may cause an end-of-buffer error.
  4090.        (goto-char (point-max))))
  4091.     nil
  4092.     ))
  4093.  
  4094. (defun gnus-Article-prev-page (lines)
  4095.   "Show previous page of current article.
  4096. Argument LINES specifies lines to be scrolled down."
  4097.   (interactive "P")
  4098.   (move-to-window-line 0)
  4099.   (if (and gnus-break-pages
  4100.        (bobp)
  4101.        (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
  4102.       (progn
  4103.     (gnus-narrow-to-page -1) ;Go to previous page.
  4104.     (goto-char (point-max))
  4105.     (recenter -1))
  4106.     (scroll-down lines)))
  4107.  
  4108. (defun gnus-Article-next-digest (nth)
  4109.   "Move to head of NTH next digested message.
  4110. Set mark at end of digested message."
  4111.   ;; Stop page breaking in digest mode.
  4112.   (widen)
  4113.   (end-of-line)
  4114.   ;; Skip NTH - 1 digest.
  4115.   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
  4116.   ;; Digest separator is customizable.
  4117.   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
  4118.   (while (and (> nth 1)
  4119.           (re-search-forward gnus-digest-separator nil 'move))
  4120.     (setq nth (1- nth)))
  4121.   (if (re-search-forward gnus-digest-separator nil t)
  4122.       (let ((begin (point)))
  4123.     ;; Search for end of this message.
  4124.     (end-of-line)
  4125.     (if (re-search-forward gnus-digest-separator nil t)
  4126.         (progn
  4127.           (search-backward "\n\n")    ;This may be incorrect.
  4128.           (forward-line 1))
  4129.       (goto-char (point-max)))
  4130.     (push-mark)            ;Set mark at end of digested message.
  4131.     (goto-char begin)
  4132.     (beginning-of-line)
  4133.     ;; Show From: and Subject: fields.
  4134.     (recenter 1))
  4135.     (message "End of message")
  4136.     ))
  4137.  
  4138. (defun gnus-Article-prev-digest (nth)
  4139.   "Move to head of NTH previous digested message."
  4140.   ;; Stop page breaking in digest mode.
  4141.   (widen)
  4142.   (beginning-of-line)
  4143.   ;; Skip NTH - 1 digest.
  4144.   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
  4145.   ;; Digest separator is customizable.
  4146.   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
  4147.   (while (and (> nth 1)
  4148.           (re-search-backward gnus-digest-separator nil 'move))
  4149.     (setq nth (1- nth)))
  4150.   (if (re-search-backward gnus-digest-separator nil t)
  4151.       (let ((begin (point)))
  4152.     ;; Search for end of this message.
  4153.     (end-of-line)
  4154.     (if (re-search-forward gnus-digest-separator nil t)
  4155.         (progn
  4156.           (search-backward "\n\n")    ;This may be incorrect.
  4157.           (forward-line 1))
  4158.       (goto-char (point-max)))
  4159.     (push-mark)            ;Set mark at end of digested message.
  4160.     (goto-char begin)
  4161.     ;; Show From: and Subject: fields.
  4162.     (recenter 1))
  4163.     (goto-char (point-min))
  4164.     (message "Top of message")
  4165.     ))
  4166.  
  4167. (defun gnus-Article-refer-article ()
  4168.   "Read article specified by message-id around point."
  4169.   (interactive)
  4170.   (save-window-excursion
  4171.     (save-excursion
  4172.       (re-search-forward ">" nil t)    ;Move point to end of "<....>".
  4173.       (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
  4174.       (let ((message-id
  4175.          (buffer-substring (match-beginning 1) (match-end 1))))
  4176.         (set-buffer gnus-Subject-buffer)
  4177.         (gnus-Subject-refer-article message-id))
  4178.     (error "No references around point"))
  4179.       )))
  4180.  
  4181. (defun gnus-Article-pop-article ()
  4182.   "Pop up article history."
  4183.   (interactive)
  4184.   (save-window-excursion
  4185.     (set-buffer gnus-Subject-buffer)
  4186.     (gnus-Subject-refer-article nil)))
  4187.  
  4188. (defun gnus-Article-show-subjects ()
  4189.   "Reconfigure windows to show headers."
  4190.   (interactive)
  4191.   (gnus-configure-windows 'SelectArticle)
  4192.   (gnus-pop-to-buffer gnus-Subject-buffer)
  4193.   (gnus-Subject-goto-subject gnus-current-article))
  4194.  
  4195. (defun gnus-Article-describe-briefly ()
  4196.   "Describe Article mode commands briefly."
  4197.   (interactive)
  4198.   (message
  4199.    (concat
  4200.     (substitute-command-keys "\\[gnus-Article-next-page]:Next page  ")
  4201.     (substitute-command-keys "\\[gnus-Article-prev-page]:Prev page  ")
  4202.     (substitute-command-keys "\\[gnus-Article-show-subjects]:Show headers  ")
  4203.     (substitute-command-keys "\\[gnus-Info-find-node]:Run Info  ")
  4204.     (substitute-command-keys "\\[gnus-Article-describe-briefly]:This help")
  4205.     )))
  4206.  
  4207.  
  4208. ;;;
  4209. ;;; GNUS KILL-File Mode
  4210. ;;;
  4211.  
  4212. (if gnus-Kill-file-mode-map
  4213.     nil
  4214.   (setq gnus-Kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
  4215.   (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-s" 'gnus-Kill-file-kill-by-subject)
  4216.   (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-a" 'gnus-Kill-file-kill-by-author)
  4217.   (define-key gnus-Kill-file-mode-map "\C-c\C-a" 'gnus-Kill-file-apply-buffer)
  4218.   (define-key gnus-Kill-file-mode-map "\C-c\C-e" 'gnus-Kill-file-apply-last-sexp)
  4219.   (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit)
  4220.   (define-key gnus-Kill-file-mode-map "\C-c\C-i" 'gnus-Info-find-node))
  4221.  
  4222. (defun gnus-Kill-file-mode ()
  4223.   "Major mode for editing KILL file.
  4224.  
  4225. In addition to Emacs-Lisp Mode, the following commands are available:
  4226.  
  4227. \\[gnus-Kill-file-kill-by-subject]    Insert KILL command for current subject.
  4228. \\[gnus-Kill-file-kill-by-author]    Insert KILL command for current author.
  4229. \\[gnus-Kill-file-apply-buffer]    Apply current buffer to selected newsgroup.
  4230. \\[gnus-Kill-file-apply-last-sexp]    Apply sexp before point to selected newsgroup.
  4231. \\[gnus-Kill-file-exit]    Save file and exit editing KILL file.
  4232. \\[gnus-Info-find-node]    Read Info about KILL file.
  4233.  
  4234.   A KILL file contains lisp expressions to be applied to a selected
  4235. newsgroup. The purpose is to mark articles as read on the basis of
  4236. some set of regexps. A global KILL file is applied to every newsgroup,
  4237. and a local KILL file is applied to a specified newsgroup. Since a
  4238. global KILL file is applied to every newsgroup, for better performance
  4239. use a local one.
  4240.  
  4241.   A KILL file can contain any kind of Emacs lisp expressions expected
  4242. to be evaluated in the Subject buffer. Writing lisp programs for this
  4243. purpose is not so easy because the internal working of GNUS must be
  4244. well-known. For this reason, GNUS provides a general function which
  4245. does this easily for non-Lisp programmers.
  4246.  
  4247.   The `gnus-kill' function executes commands available in Subject Mode
  4248. by their key sequences. `gnus-kill' should be called with FIELD,
  4249. REGEXP and optional COMMAND and ALL. FIELD is a string representing
  4250. the header field or an empty string. If FIELD is an empty string, the
  4251. entire article body is searched for. REGEXP is a string which is
  4252. compared with FIELD value. COMMAND is a string representing a valid
  4253. key sequence in Subject Mode or Lisp expression. COMMAND is default to
  4254. '(gnus-Subject-mark-as-read nil \"X\"). Make sure that COMMAND is
  4255. executed in the Subject buffer.  If the second optional argument ALL
  4256. is non-nil, the COMMAND is applied to articles which are already
  4257. marked as read or unread.  Articles which are marked are skipped over
  4258. by default.
  4259.  
  4260.   For example, if you want to mark articles of which subjects contain
  4261. the string `AI' as read, a possible KILL file may look like:
  4262.  
  4263.     (gnus-kill \"Subject\" \"AI\")
  4264.  
  4265.   If you want to mark articles with `D' instead of `X', you can use
  4266. the following expression:
  4267.  
  4268.     (gnus-kill \"Subject\" \"AI\" \"d\")
  4269.  
  4270. In this example it is assumed that the command
  4271. `gnus-Subject-mark-as-read-forward' is assigned to `d' in Subject Mode.
  4272.  
  4273.   It is possible to delete unnecessary headers which are marked with
  4274. `X' in a KILL file as follows:
  4275.  
  4276.     (gnus-expunge \"X\")
  4277.  
  4278.   If the Subject buffer is empty after applying KILL files, GNUS will
  4279. exit the selected newsgroup normally.  If headers which are marked
  4280. with `D' are deleted in a KILL file, it is impossible to read articles
  4281. which are marked as read in the previous GNUS sessions.  Marks other
  4282. than `D' should be used for articles which should really be deleted.
  4283.  
  4284. Entry to this mode calls emacs-lisp-mode-hook and
  4285. gnus-Kill-file-mode-hook with no arguments, if that value is non-nil."
  4286.   (interactive)
  4287.   (kill-all-local-variables)
  4288.   (use-local-map gnus-Kill-file-mode-map)
  4289.   (set-syntax-table emacs-lisp-mode-syntax-table)
  4290.   (setq major-mode 'gnus-Kill-file-mode)
  4291.   (setq mode-name "KILL-File")
  4292.   (lisp-mode-variables nil)
  4293.   (run-hooks 'emacs-lisp-mode-hook 'gnus-Kill-file-mode-hook))
  4294.  
  4295. (defun gnus-Kill-file-edit-file (newsgroup)
  4296.   "Begin editing a KILL file of NEWSGROUP.
  4297. If NEWSGROUP is nil, the global KILL file is selected."
  4298.   (interactive "sNewsgroup: ")
  4299.   (let ((file (gnus-newsgroup-kill-file newsgroup)))
  4300.     (gnus-make-directory (file-name-directory file))
  4301.     ;; Save current window configuration if this is first invocation.
  4302.     (or (and (get-file-buffer file)
  4303.          (get-buffer-window (get-file-buffer file)))
  4304.     (setq gnus-winconf-kill-file (current-window-configuration)))
  4305.     ;; Hack windows.
  4306.     (let ((buffer (find-file-noselect file)))
  4307.       (cond ((get-buffer-window buffer)
  4308.          (gnus-pop-to-buffer buffer))
  4309.         ((eq major-mode 'gnus-Group-mode)
  4310.          (gnus-configure-windows '(1 0 0)) ;Take all windows.
  4311.          (gnus-pop-to-buffer gnus-Group-buffer)
  4312.          (let ((gnus-Subject-buffer buffer))
  4313.            (gnus-configure-windows '(1 1 0)) ;Split into two.
  4314.            (gnus-pop-to-buffer buffer)))
  4315.         ((eq major-mode 'gnus-Subject-mode)
  4316.          (gnus-configure-windows 'SelectArticle)
  4317.          (gnus-pop-to-buffer gnus-Article-buffer)
  4318.          (bury-buffer gnus-Article-buffer)
  4319.          (switch-to-buffer buffer))
  4320.         (t                ;No good rules.
  4321.          (find-file-other-window file))
  4322.         ))
  4323.     (gnus-Kill-file-mode)
  4324.     ))
  4325.  
  4326. (defun gnus-Kill-file-kill-by-subject ()
  4327.   "Insert KILL command for current subject."
  4328.   (interactive)
  4329.   (insert
  4330.    (format "(gnus-kill \"Subject\" %s)\n"
  4331.        (prin1-to-string
  4332.         (if gnus-current-kill-article
  4333.         (regexp-quote
  4334.          (nntp-header-subject
  4335.           ;; No need to speed up this command.
  4336.           ;;(gnus-get-header-by-number gnus-current-kill-article)
  4337.           (gnus-find-header-by-number gnus-newsgroup-headers
  4338.                           gnus-current-kill-article)))
  4339.           "")))))
  4340.  
  4341. (defun gnus-Kill-file-kill-by-author ()
  4342.   "Insert KILL command for current author."
  4343.   (interactive)
  4344.   (insert
  4345.    (format "(gnus-kill \"From\" %s)\n"
  4346.        (prin1-to-string
  4347.         (if gnus-current-kill-article
  4348.         (regexp-quote
  4349.          (nntp-header-from
  4350.           ;; No need to speed up this command.
  4351.           ;;(gnus-get-header-by-number gnus-current-kill-article)
  4352.           (gnus-find-header-by-number gnus-newsgroup-headers
  4353.                           gnus-current-kill-article)))
  4354.           "")))))
  4355.  
  4356. (defun gnus-Kill-file-apply-buffer ()
  4357.   "Apply current buffer to current newsgroup."
  4358.   (interactive)
  4359.   (if (and gnus-current-kill-article
  4360.        (get-buffer gnus-Subject-buffer))
  4361.       ;; Assume newsgroup is selected.
  4362.       (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
  4363.     (save-excursion
  4364.       (save-window-excursion
  4365.         (gnus-pop-to-buffer gnus-Subject-buffer)
  4366.         (eval (car (read-from-string string))))))
  4367.     (ding) (message "No newsgroup is selected.")))
  4368.  
  4369. (defun gnus-Kill-file-apply-last-sexp ()
  4370.   "Apply sexp before point in current buffer to current newsgroup."
  4371.   (interactive)
  4372.   (if (and gnus-current-kill-article
  4373.        (get-buffer gnus-Subject-buffer))
  4374.       ;; Assume newsgroup is selected.
  4375.       (let ((string
  4376.          (buffer-substring
  4377.           (save-excursion (forward-sexp -1) (point)) (point))))
  4378.     (save-excursion
  4379.       (save-window-excursion
  4380.         (gnus-pop-to-buffer gnus-Subject-buffer)
  4381.         (eval (car (read-from-string string))))))
  4382.     (ding) (message "No newsgroup is selected.")))
  4383.  
  4384. (defun gnus-Kill-file-exit ()
  4385.   "Save a KILL file, then return to the previous buffer."
  4386.   (interactive)
  4387.   (save-buffer)
  4388.   (let ((killbuf (current-buffer)))
  4389.     ;; We don't want to return to Article buffer.
  4390.     (and (get-buffer gnus-Article-buffer)
  4391.      (bury-buffer (get-buffer gnus-Article-buffer)))
  4392.     ;; Delete the KILL file windows.
  4393.     (delete-windows-on killbuf)
  4394.     ;; Restore last window configuration if available.
  4395.     (and gnus-winconf-kill-file
  4396.      (set-window-configuration gnus-winconf-kill-file))
  4397.     (setq gnus-winconf-kill-file nil)
  4398.     ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
  4399.     (kill-buffer killbuf)))
  4400.  
  4401.  
  4402. ;;;
  4403. ;;; Utility functions
  4404. ;;;
  4405.  
  4406. ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
  4407.  
  4408. (defun gnus-batch-kill ()
  4409.   "Run batched KILL.
  4410. Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
  4411.   (if (not noninteractive)
  4412.       (error "gnus-batch-kill is to be used only with -batch"))
  4413.   (let* ((group nil)
  4414.      (subscribed nil)
  4415.      (newsrc nil)
  4416.      (yes-and-no
  4417.       (gnus-parse-n-options
  4418.        (apply (function concat)
  4419.           (mapcar (function (lambda (g) (concat g " ")))
  4420.               command-line-args-left))))
  4421.      (yes (car yes-and-no))
  4422.      (no  (cdr yes-and-no))
  4423.      ;; Disable verbose message.
  4424.      (gnus-novice-user nil)
  4425.      (gnus-large-newsgroup nil)
  4426.      (nntp-large-newsgroup nil))
  4427.     ;; Eat all arguments.
  4428.     (setq command-line-args-left nil)
  4429.     ;; Startup GNUS.
  4430.     (gnus)
  4431.     ;; Apply kills to specified newsgroups in command line arguments.
  4432.     (setq newsrc (copy-sequence gnus-newsrc-assoc))
  4433.     (while newsrc
  4434.       (setq group (car (car newsrc)))
  4435.       (setq subscribed (nth 1 (car newsrc)))
  4436.       (setq newsrc (cdr newsrc))
  4437.       (if (and subscribed
  4438.            (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
  4439.            (if yes
  4440.            (string-match yes group) t)
  4441.            (or (null no)
  4442.            (not (string-match no group))))
  4443.       (progn
  4444.         (gnus-Subject-read-group group nil t)
  4445.         (if (eq (current-buffer) (get-buffer gnus-Subject-buffer))
  4446.         (gnus-Subject-exit t))
  4447.         ))
  4448.       )
  4449.     ;; Finally, exit Emacs.
  4450.     (set-buffer gnus-Group-buffer)
  4451.     (gnus-Group-exit)
  4452.     ))
  4453.  
  4454. ;; For saving articles
  4455.  
  4456. (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
  4457.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  4458. If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
  4459. Otherwise, it is like ~/News/news/group/num."
  4460.   (let ((default
  4461.       (expand-file-name
  4462.        (concat (if gnus-use-long-file-name
  4463.                (capitalize newsgroup)
  4464.              (gnus-newsgroup-directory-form newsgroup))
  4465.            "/" (int-to-string (nntp-header-number headers)))
  4466.        (or gnus-article-save-directory "~/News"))))
  4467.     (if (and last-file
  4468.          (string-equal (file-name-directory default)
  4469.                (file-name-directory last-file))
  4470.          (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
  4471.     default
  4472.       (or last-file default))))
  4473.  
  4474. (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
  4475.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  4476. If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
  4477. Otherwise, it is like ~/News/news/group/num."
  4478.   (let ((default
  4479.       (expand-file-name
  4480.        (concat (if gnus-use-long-file-name
  4481.                newsgroup
  4482.              (gnus-newsgroup-directory-form newsgroup))
  4483.            "/" (int-to-string (nntp-header-number headers)))
  4484.        (or gnus-article-save-directory "~/News"))))
  4485.     (if (and last-file
  4486.          (string-equal (file-name-directory default)
  4487.                (file-name-directory last-file))
  4488.          (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
  4489.     default
  4490.       (or last-file default))))
  4491.  
  4492. (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
  4493.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  4494. If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
  4495. Otherwise, it is like ~/News/news/group/news."
  4496.   (or last-file
  4497.       (expand-file-name
  4498.        (if gnus-use-long-file-name
  4499.        (capitalize newsgroup)
  4500.      (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
  4501.        (or gnus-article-save-directory "~/News"))))
  4502.  
  4503. (defun gnus-plain-save-name (newsgroup headers &optional last-file)
  4504.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  4505. If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
  4506. Otherwise, it is like ~/News/news/group/news."
  4507.   (or last-file
  4508.       (expand-file-name
  4509.        (if gnus-use-long-file-name
  4510.        newsgroup
  4511.      (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
  4512.        (or gnus-article-save-directory "~/News"))))
  4513.  
  4514. (defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
  4515.   "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
  4516. If variable `gnus-use-long-file-name' is nil, it is +News.group.
  4517. Otherwise, it is like +news/group."
  4518.   (or last-folder
  4519.       (concat "+"
  4520.           (if gnus-use-long-file-name
  4521.           (capitalize newsgroup)
  4522.         (gnus-newsgroup-directory-form newsgroup)))))
  4523.  
  4524. (defun gnus-folder-save-name (newsgroup headers &optional last-folder)
  4525.   "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
  4526. If variable `gnus-use-long-file-name' is nil, it is +news.group.
  4527. Otherwise, it is like +news/group."
  4528.   (or last-folder
  4529.       (concat "+"
  4530.           (if gnus-use-long-file-name
  4531.           newsgroup
  4532.         (gnus-newsgroup-directory-form newsgroup)))))
  4533.  
  4534. ;; For KILL files
  4535.  
  4536. (defun gnus-apply-kill-file ()
  4537.   "Apply KILL file to the current newsgroup."
  4538.   ;; Apply the global KILL file.
  4539.   (load (gnus-newsgroup-kill-file nil) t nil t)
  4540.   ;; And then apply the local KILL file.
  4541.   (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
  4542.  
  4543. (defun gnus-Newsgroup-kill-file (newsgroup)
  4544.   "Return the name of a KILL file of NEWSGROUP.
  4545. If NEWSGROUP is nil, return the global KILL file instead."
  4546.   (cond ((or (null newsgroup)
  4547.          (string-equal newsgroup ""))
  4548.      ;; The global KILL file is placed at top of the directory.
  4549.      (expand-file-name gnus-kill-file-name
  4550.                (or gnus-article-save-directory "~/News")))
  4551.     (gnus-use-long-file-name
  4552.      ;; Append ".KILL" to capitalized newsgroup name.
  4553.      (expand-file-name (concat (capitalize newsgroup)
  4554.                    "." gnus-kill-file-name)
  4555.                (or gnus-article-save-directory "~/News")))
  4556.     (t
  4557.      ;; Place "KILL" under the hierarchical directory.
  4558.      (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
  4559.                    "/" gnus-kill-file-name)
  4560.                (or gnus-article-save-directory "~/News")))
  4561.     ))
  4562.  
  4563. (defun gnus-newsgroup-kill-file (newsgroup)
  4564.   "Return the name of a KILL file of NEWSGROUP.
  4565. If NEWSGROUP is nil, return the global KILL file instead."
  4566.   (cond ((or (null newsgroup)
  4567.          (string-equal newsgroup ""))
  4568.      ;; The global KILL file is placed at top of the directory.
  4569.      (expand-file-name gnus-kill-file-name
  4570.                (or gnus-article-save-directory "~/News")))
  4571.     (gnus-use-long-file-name
  4572.      ;; Append ".KILL" to newsgroup name.
  4573.      (expand-file-name (concat newsgroup "." gnus-kill-file-name)
  4574.                (or gnus-article-save-directory "~/News")))
  4575.     (t
  4576.      ;; Place "KILL" under the hierarchical directory.
  4577.      (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
  4578.                    "/" gnus-kill-file-name)
  4579.                (or gnus-article-save-directory "~/News")))
  4580.     ))
  4581.  
  4582. ;; For subscribing new newsgroup
  4583.  
  4584. (defun gnus-subscribe-randomly (newsgroup)
  4585.   "Subscribe new NEWSGROUP and insert it at the beginning of newsgroups."
  4586.   (gnus-subscribe-newsgroup newsgroup
  4587.                 (car (car gnus-newsrc-assoc))))
  4588.  
  4589. (defun gnus-subscribe-alphabetically (newgroup)
  4590.   "Subscribe new NEWSGROUP and insert it in strict alphabetic order."
  4591.   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
  4592.   (let ((groups gnus-newsrc-assoc)
  4593.     (before nil))
  4594.     (while (and (not before) groups)
  4595.       (if (string< newgroup (car (car groups)))
  4596.       (setq before (car (car groups)))
  4597.     (setq groups (cdr groups))))
  4598.     (gnus-subscribe-newsgroup newgroup before)
  4599.     ))
  4600.  
  4601. (defun gnus-subscribe-hierarchically (newgroup)
  4602.   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
  4603.   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
  4604.   (save-excursion
  4605.     (set-buffer (find-file-noselect gnus-current-startup-file))
  4606.     (let ((groupkey newgroup)
  4607.       (before nil))
  4608.       (while (and (not before) groupkey)
  4609.     (goto-char (point-min))
  4610.     (let ((groupkey-re
  4611.            (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
  4612.       (while (and (re-search-forward groupkey-re nil t)
  4613.               (progn
  4614.             (setq before (buffer-substring
  4615.                       (match-beginning 1) (match-end 1)))
  4616.             (string< before newgroup)))
  4617.         ))
  4618.     ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
  4619.     (setq groupkey
  4620.           (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
  4621.           (substring groupkey (match-beginning 1) (match-end 1)))))
  4622.       (gnus-subscribe-newsgroup newgroup before)
  4623.       )))
  4624.  
  4625. (defun gnus-subscribe-newsgroup (newsgroup &optional next)
  4626.   "Subscribe new NEWSGROUP.
  4627. If optional argument NEXT is non-nil, it is inserted before NEXT."
  4628.   (gnus-insert-newsgroup (list newsgroup t) next)
  4629.   (message "Newsgroup %s is subscribed" newsgroup))
  4630.  
  4631. ;; For directories
  4632.  
  4633. (defun gnus-newsgroup-directory-form (newsgroup)
  4634.   "Make hierarchical directory name from NEWSGROUP name."
  4635.   (let ((newsgroup (substring newsgroup 0)) ;Copy string.
  4636.     (len (length newsgroup))
  4637.     (idx 0))
  4638.     ;; Replace all occurence of `.' with `/'.
  4639.     (while (< idx len)
  4640.       (if (= (aref newsgroup idx) ?.)
  4641.       (aset newsgroup idx ?/))
  4642.       (setq idx (1+ idx)))
  4643.     newsgroup
  4644.     ))
  4645.  
  4646. (defun gnus-make-directory (directory)
  4647.   "Make DIRECTORY recursively."
  4648.   (let ((directory (expand-file-name directory default-directory)))
  4649.     (or (file-exists-p directory)
  4650.     (gnus-make-directory-1 "" directory))
  4651.     ))
  4652.  
  4653. (defun gnus-make-directory-1 (head tail)
  4654.   (cond ((string-match "^/\\([^/]+\\)" tail)
  4655.      (setq head
  4656.            (concat (file-name-as-directory head)
  4657.                (substring tail (match-beginning 1) (match-end 1))))
  4658.      (or (file-exists-p head)
  4659.          (call-process "mkdir" nil nil nil head))
  4660.      (gnus-make-directory-1 head (substring tail (match-end 1))))
  4661.     ((string-equal tail "") t)
  4662.     ))
  4663.  
  4664. (defun gnus-simplify-subject (subject &optional re-only)
  4665.   "Remove `Re:' and words in parentheses.
  4666. If optional argument RE-ONLY is non-nil, strip `Re:' only."
  4667.   (let ((case-fold-search t))        ;Ignore case.
  4668.     ;; Remove `Re:' and `Re^N:'.
  4669.     (if (string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ \t]+\\)+" subject)
  4670.     (setq subject (substring subject (match-end 0))))
  4671.     ;; Remove words in parentheses from end.
  4672.     (or re-only
  4673.     (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
  4674.       (setq subject (substring subject 0 (match-beginning 0)))))
  4675.     ;; Return subject string.
  4676.     subject
  4677.     ))
  4678.  
  4679. (defun gnus-optional-lines-and-from (header)
  4680.   "Return a string like `NNN:AUTHOR' from HEADER."
  4681.   (let ((name-length (length "umerin@photon")))
  4682.     (substring (format "%3d:%s"
  4683.                ;; Lines of the article.
  4684.                ;; Suggested by dana@bellcore.com.
  4685.                (nntp-header-lines header)
  4686.                ;; Its author.
  4687.                (concat (mail-strip-quoted-names
  4688.                 (nntp-header-from header))
  4689.                    (make-string name-length ? )))
  4690.            ;; 4 stands for length of `NNN:'.
  4691.            0 (+ 4 name-length))))
  4692.  
  4693. (defun gnus-optional-lines (header)
  4694.   "Return a string like `NNN' from HEADER."
  4695.   (format "%4d" (nntp-header-lines header)))
  4696.  
  4697. (defun gnus-sort-headers (predicate &optional reverse)
  4698.   "Sort current group headers by PREDICATE safely.
  4699. *Safely* means C-g quitting is disabled during sorting.
  4700. Optional argument REVERSE means reverse order."
  4701.   (let ((inhibit-quit t))
  4702.     (setq gnus-newsgroup-headers
  4703.       (if reverse
  4704.           (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
  4705.         (sort gnus-newsgroup-headers predicate)))
  4706.     ;; Make sure we don't have to call
  4707.     ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
  4708.     ;; tables for the variable gnus-newsgroup-headers since no new
  4709.     ;; entry is added to nor deleted from the variable.
  4710.     ))
  4711.  
  4712. (defun gnus-string-lessp (a b)
  4713.   "Return T if first arg string is less than second in lexicographic order.
  4714. If case-fold-search is non-nil, case of letters is ignored."
  4715.   (if case-fold-search
  4716.       (string-lessp (downcase a) (downcase b))
  4717.     (string-lessp a b)))
  4718.  
  4719. (defun gnus-date-lessp (date1 date2)
  4720.   "Return T if DATE1 is earlyer than DATE2."
  4721.   (string-lessp (gnus-sortable-date date1)
  4722.         (gnus-sortable-date date2)))
  4723.  
  4724. (defun gnus-sortable-date (date)
  4725.   "Make sortable string by string-lessp from DATE.
  4726. Timezone package is used."
  4727.   (let* ((date   (timezone-parse-date date)) ;[Y M D T]
  4728.      (year   (string-to-int (aref date 0)))
  4729.      (month  (string-to-int (aref date 1)))
  4730.      (day    (string-to-int (aref date 2)))
  4731.      (time   (aref date 3)))    ;HH:MM:SS
  4732.     ;; Timezone package is used.  But, we don't have to care about
  4733.     ;; the timezone since article's timezones are always GMT.
  4734.     (timezone-make-sortable-date year month day time)
  4735.     ))
  4736.  
  4737. ;;(defun gnus-sortable-date (date)
  4738. ;;  "Make sortable string by string-lessp from DATE."
  4739. ;;  (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
  4740. ;;         ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
  4741. ;;         ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
  4742. ;;         ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
  4743. ;;    (date (or date "")))
  4744. ;;    ;; Can understand the following styles:
  4745. ;;    ;; (1) 14 Apr 89 03:20:12 GMT
  4746. ;;    ;; (2) Fri, 17 Mar 89 4:01:33 GMT
  4747. ;;    (if (string-match
  4748. ;;     "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
  4749. ;;    (concat
  4750. ;;     ;; Year
  4751. ;;     (substring date (match-beginning 3) (match-end 3))
  4752. ;;     ;; Month
  4753. ;;     (cdr
  4754. ;;      (assoc
  4755. ;;       (upcase (substring date (match-beginning 2) (match-end 2))) month))
  4756. ;;     ;; Day
  4757. ;;     (format "%2d" (string-to-int
  4758. ;;            (substring date
  4759. ;;                   (match-beginning 1) (match-end 1))))
  4760. ;;     ;; Time
  4761. ;;     (substring date (match-beginning 4) (match-end 4)))
  4762. ;;      ;; Cannot understand DATE string.
  4763. ;;      date
  4764. ;;      )
  4765. ;;    ))
  4766.  
  4767. (defun gnus-fetch-field (field)
  4768.   "Return the value of the header FIELD of current article."
  4769.   (save-excursion
  4770.     (save-restriction
  4771.       (widen)
  4772.       (goto-char (point-min))
  4773.       (narrow-to-region (point-min)
  4774.             (progn (search-forward "\n\n" nil 'move) (point)))
  4775.       (mail-fetch-field field))))
  4776.  
  4777. (fset 'gnus-expunge 'gnus-Subject-delete-marked-with)
  4778.  
  4779. (defun gnus-kill (field regexp &optional command all)
  4780.   "If FIELD of an article matches REGEXP, execute COMMAND.
  4781. Optional 1st argument COMMAND is default to
  4782.     (gnus-Subject-mark-as-read nil \"X\").
  4783. If optional 2nd argument ALL is non-nil, articles marked are also applied to.
  4784. If FIELD is an empty string (or nil), entire article body is searched for.
  4785. COMMAND must be a lisp expression or a string representing a key sequence."
  4786.   ;; We don't want to change current point nor window configuration.
  4787.   (save-excursion
  4788.     (save-window-excursion
  4789.       ;; Selected window must be Subject mode buffer to execute
  4790.       ;; keyboard macros correctly. See command_loop_1.
  4791.       (switch-to-buffer gnus-Subject-buffer 'norecord)
  4792.       (goto-char (point-min))        ;From the beginning.
  4793.       (if (null command)
  4794.       (setq command '(gnus-Subject-mark-as-read nil "X")))
  4795.       (gnus-execute field regexp command nil (not all))
  4796.       )))
  4797.  
  4798. (defun gnus-execute (field regexp form &optional backward ignore-marked)
  4799.   "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
  4800. If FIELD is an empty string (or nil), entire article body is searched for.
  4801. If optional 1st argument BACKWARD is non-nil, do backward instead.
  4802. If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
  4803. marked as read or unread are ignored."
  4804.   (let ((function nil)
  4805.     (header nil)
  4806.     (article nil))
  4807.     (if (string-equal field "")
  4808.     (setq field nil))
  4809.     (if (null field)
  4810.     nil
  4811.       (or (stringp field)
  4812.       (setq field (symbol-name field)))
  4813.       ;; Get access function of header filed.
  4814.       (setq function (intern-soft (concat "gnus-header-" (downcase field))))
  4815.       (if (and function (fboundp function))
  4816.       (setq function (symbol-function function))
  4817.     (error "Unknown header field: \"%s\"" field)))
  4818.     ;; Make FORM funcallable.
  4819.     (if (and (listp form) (not (eq (car form) 'lambda)))
  4820.     (setq form (list 'lambda nil form)))
  4821.     ;; Starting from the current article.
  4822.     (or (and ignore-marked
  4823.          ;; Articles marked as read and unread should be ignored.
  4824.          (setq article (gnus-Subject-article-number))
  4825.          (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
  4826.          (memq article gnus-newsgroup-marked) ;Marked as unread.
  4827.          ))
  4828.     (gnus-execute-1 function regexp form))
  4829.     (while (gnus-Subject-search-subject backward ignore-marked nil)
  4830.       (gnus-execute-1 function regexp form))
  4831.     ))
  4832.  
  4833. (defun gnus-execute-1 (function regexp form)
  4834.   (save-excursion
  4835.     ;; The point of Subject mode buffer must be saved during execution.
  4836.     (let ((article (gnus-Subject-article-number)))
  4837.       (if (null article)
  4838.       nil                ;Nothing to do.
  4839.     (if function
  4840.         ;; Compare with header field.
  4841.         (let (;;(header (gnus-find-header-by-number
  4842.           ;;        gnus-newsgroup-headers article))
  4843.           (header (gnus-get-header-by-number article))
  4844.           (value nil))
  4845.           (and header
  4846.            (progn
  4847.              (setq value (funcall function header))
  4848.              ;; Number (Lines:) or symbol must be converted to string.
  4849.              (or (stringp value)
  4850.              (setq value (prin1-to-string value)))
  4851.              (string-match regexp value))
  4852.            (if (stringp form)    ;Keyboard macro.
  4853.                (execute-kbd-macro form)
  4854.              (funcall form))))
  4855.       ;; Search article body.
  4856.       (let ((gnus-current-article nil) ;Save article pointer.
  4857.         (gnus-last-article nil)
  4858.         (gnus-break-pages nil)    ;No need to break pages.
  4859.         (gnus-Mark-article-hook nil)) ;Inhibit marking as read.
  4860.         (message "Searching for article: %d..." article)
  4861.         (gnus-Article-setup-buffer)
  4862.         (gnus-Article-prepare article t)
  4863.         (if (save-excursion
  4864.           (set-buffer gnus-Article-buffer)
  4865.           (goto-char (point-min))
  4866.           (re-search-forward regexp nil t))
  4867.         (if (stringp form)    ;Keyboard macro.
  4868.             (execute-kbd-macro form)
  4869.           (funcall form))))
  4870.       ))
  4871.       )))
  4872.  
  4873. ;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
  4874. ;;; modified by tower@prep Nov 86
  4875. ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
  4876.  
  4877. (defun gnus-caesar-region (&optional n)
  4878.   "Caesar rotation of region by N, default 13, for decrypting netnews.
  4879. ROT47 will be performed for Japanese text in any case."
  4880.   (interactive (if current-prefix-arg    ; Was there a prefix arg?
  4881.            (list (prefix-numeric-value current-prefix-arg))
  4882.          (list nil)))
  4883.   (cond ((not (numberp n)) (setq n 13))
  4884.     ((< n 0) (setq n (- 26 (% (- n) 26))))
  4885.     (t (setq n (% n 26))))        ;canonicalize N
  4886.   (if (not (zerop n))        ; no action needed for a rot of 0
  4887.       (progn
  4888.     (if (or (not (boundp 'caesar-translate-table))
  4889.         (/= (aref caesar-translate-table ?a) (+ ?a n)))
  4890.         (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
  4891.           (message "Building caesar-translate-table...")
  4892.           (setq caesar-translate-table (make-vector 256 0))
  4893.           (while (< i 256)
  4894.         (aset caesar-translate-table i i)
  4895.         (setq i (1+ i)))
  4896.           (setq lower (concat lower lower) upper (upcase lower) i 0)
  4897.           (while (< i 26)
  4898.         (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
  4899.         (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
  4900.         (setq i (1+ i)))
  4901.           ;; ROT47 for Japanese text.
  4902.           ;; Thanks to ichikawa@flab.fujitsu.junet.
  4903.           (setq i 161)
  4904.           (let ((t1 (logior ?O 128))
  4905.             (t2 (logior ?! 128))
  4906.             (t3 (logior ?~ 128)))
  4907.         (while (< i 256)
  4908.           (aset caesar-translate-table i
  4909.             (let ((v (aref caesar-translate-table i)))
  4910.               (if (<= v t1) (if (< v t2) v (+ v 47))
  4911.                 (if (<= v t3) (- v 47) v))))
  4912.           (setq i (1+ i))))
  4913.           (message "Building caesar-translate-table... done")))
  4914.     (let ((from (region-beginning))
  4915.           (to (region-end))
  4916.           (i 0) str len)
  4917.       (setq str (buffer-substring from to))
  4918.       (setq len (length str))
  4919.       (while (< i len)
  4920.         (aset str i (aref caesar-translate-table (aref str i)))
  4921.         (setq i (1+ i)))
  4922.       (goto-char from)
  4923.       (delete-region from to)
  4924.       (insert str)))))
  4925.  
  4926. ;; Functions accessing headers.
  4927. ;; Functions are more convenient than macros in some case.
  4928.  
  4929. (defun gnus-header-number (header)
  4930.   "Return article number in HEADER."
  4931.   (nntp-header-number header))
  4932.  
  4933. (defun gnus-header-subject (header)
  4934.   "Return subject string in HEADER."
  4935.   (nntp-header-subject header))
  4936.  
  4937. (defun gnus-header-from (header)
  4938.   "Return author string in HEADER."
  4939.   (nntp-header-from header))
  4940.  
  4941. (defun gnus-header-xref (header)
  4942.   "Return xref string in HEADER."
  4943.   (nntp-header-xref header))
  4944.  
  4945. (defun gnus-header-lines (header)
  4946.   "Return lines in HEADER."
  4947.   (nntp-header-lines header))
  4948.  
  4949. (defun gnus-header-date (header)
  4950.   "Return date in HEADER."
  4951.   (nntp-header-date header))
  4952.  
  4953. (defun gnus-header-id (header)
  4954.   "Return Id in HEADER."
  4955.   (nntp-header-id header))
  4956.  
  4957. (defun gnus-header-references (header)
  4958.   "Return references in HEADER."
  4959.   (nntp-header-references header))
  4960.  
  4961.  
  4962. ;;;
  4963. ;;; Article savers.
  4964. ;;;
  4965.  
  4966. (defun gnus-rmail-output (filename)
  4967.   ;; most of this snarfed from 'rmail-output.
  4968.   (setq filename (expand-file-name filename))
  4969.   (setq rmail-last-file filename)
  4970.   (let ((rmailbuf (current-buffer))
  4971.     (tembuf (get-buffer-create " rmail-output"))
  4972.     (case-fold-search t))
  4973.     (set-buffer tembuf)
  4974.     (erase-buffer)
  4975.     (insert-buffer-substring rmailbuf)
  4976.     (insert "\n")
  4977.     (goto-char (point-min))
  4978.     (insert "From "
  4979.         (mail-strip-quoted-names (or (mail-fetch-field "from")
  4980.                      (mail-fetch-field "really-from")
  4981.                      (mail-fetch-field "sender")
  4982.                      "unknown"))
  4983.         " " (current-time-string) "\n")
  4984.     ;; ``Quote'' "\nFrom " as "\n>From "
  4985.     ;;  (note that this isn't really quoting, as there is no requirement
  4986.     ;;   that "\n[>]+From " be quoted in the same transparent way.)
  4987.     (while (search-forward "\nFrom " nil t)
  4988.       (forward-char -5)
  4989.       (insert ?>))
  4990.     (append-to-file (point-min) (point-max) filename)
  4991.     (kill-buffer tembuf))
  4992.   nil)
  4993.  
  4994. (defun gnus-output-to-rmail (file-name)
  4995.   "Append the current article to an Rmail file named FILE-NAME."
  4996.   (require 'rmail)
  4997.   ;; Most of these codes are borrowed from rmailout.el.
  4998.   (setq file-name (expand-file-name file-name))
  4999.   (setq rmail-last-rmail-file file-name)
  5000.   (let ((artbuf (current-buffer))
  5001.     (tmpbuf (get-buffer-create " *GNUS-output*")))
  5002.     (save-excursion
  5003.       (or (get-file-buffer file-name)
  5004.       (file-exists-p file-name)
  5005.       (if (yes-or-no-p
  5006.            (concat "\"" file-name "\" does not exist, create it? "))
  5007.           (let ((file-buffer (create-file-buffer file-name)))
  5008.         (save-excursion
  5009.           (set-buffer file-buffer)
  5010.           (rmail-insert-rmail-file-header)
  5011.           (let ((require-final-newline nil))
  5012.             (write-region (point-min) (point-max) file-name t 1)))
  5013.         (kill-buffer file-buffer))
  5014.         (error "Output file does not exist")))
  5015.       (set-buffer tmpbuf)
  5016.       (buffer-disable-undo (current-buffer))
  5017.       (erase-buffer)
  5018.       (insert-buffer-substring artbuf)
  5019.       (gnus-convert-article-to-rmail)
  5020.       ;; Decide whether to append to a file or to an Emacs buffer.
  5021.       (let ((outbuf (get-file-buffer file-name)))
  5022.     (if (not outbuf)
  5023.         (append-to-file (point-min) (point-max) file-name)
  5024.       ;; File has been visited, in buffer OUTBUF.
  5025.       (set-buffer outbuf)
  5026.       (let ((buffer-read-only nil)
  5027.         (msg (and (boundp 'rmail-current-message)
  5028.               rmail-current-message)))
  5029.         ;; If MSG is non-nil, buffer is in RMAIL mode.
  5030.         (if msg
  5031.         (progn (widen)
  5032.                (narrow-to-region (point-max) (point-max))))
  5033.         (insert-buffer-substring tmpbuf)
  5034.         (if msg
  5035.         (progn
  5036.           (goto-char (point-min))
  5037.           (widen)
  5038.           (search-backward "\^_")
  5039.           (narrow-to-region (point) (point-max))
  5040.           (goto-char (1+ (point-min)))
  5041.           (rmail-count-new-messages t)
  5042.           (rmail-show-message msg))))))
  5043.       )
  5044.     (kill-buffer tmpbuf)
  5045.     ))
  5046.  
  5047. (defun gnus-output-to-file (file-name)
  5048.   "Append the current article to a file named FILE-NAME."
  5049.   (setq file-name (expand-file-name file-name))
  5050.   (let ((artbuf (current-buffer))
  5051.     (tmpbuf (get-buffer-create " *GNUS-output*")))
  5052.     (save-excursion
  5053.       (set-buffer tmpbuf)
  5054.       (buffer-disable-undo (current-buffer))
  5055.       (erase-buffer)
  5056.       (insert-buffer-substring artbuf)
  5057.       ;; Append newline at end of the buffer as separator, and then
  5058.       ;; save it to file.
  5059.       (goto-char (point-max))
  5060.       (insert "\n")
  5061.       (append-to-file (point-min) (point-max) file-name))
  5062.     (kill-buffer tmpbuf)
  5063.     ))
  5064.  
  5065. (defun gnus-convert-article-to-rmail ()
  5066.   "Convert article in current buffer to Rmail message format."
  5067.   (let ((buffer-read-only nil))
  5068.     ;; Convert article directly into Babyl format.
  5069.     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
  5070.     (goto-char (point-min))
  5071.     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
  5072.     (while (search-forward "\n\^_" nil t) ;single char
  5073.       (replace-match "\n^_"))        ;2 chars: "^" and "_"
  5074.     (goto-char (point-max))
  5075.     (insert "\^_")))
  5076.  
  5077. ;;(defun gnus-convert-article-to-rmail ()
  5078. ;;  "Convert article in current buffer to Rmail message format."
  5079. ;;  (let ((buffer-read-only nil))
  5080. ;;    ;; Insert special header of Unix mail.
  5081. ;;    (goto-char (point-min))
  5082. ;;    (insert "From "
  5083. ;;        (or (mail-strip-quoted-names (mail-fetch-field "from"))
  5084. ;;        "unknown")
  5085. ;;        " " (current-time-string) "\n")
  5086. ;;    ;; Stop quoting `From' since this seems unnecessary in most cases.
  5087. ;;    ;; ``Quote'' "\nFrom " as "\n>From "
  5088. ;;    ;;(while (search-forward "\nFrom " nil t)
  5089. ;;    ;;  (forward-char -5)
  5090. ;;    ;;  (insert ?>))
  5091. ;;    ;; Convert article to babyl format.
  5092. ;;    (rmail-convert-to-babyl-format)
  5093. ;;    ))
  5094.  
  5095.  
  5096. ;;;
  5097. ;;; Internal functions.
  5098. ;;;
  5099.  
  5100. (defun gnus-start-news-server (&optional confirm)
  5101.   "Open network stream to remote NNTP server.
  5102. If optional argument CONFIRM is non-nil, ask you host that NNTP server
  5103. is running even if it is defined.
  5104. Run gnus-Open-server-hook just before opening news server."
  5105.   (if (gnus-server-opened)
  5106.       ;; Stream is already opened.
  5107.       nil
  5108.     ;; Open NNTP server.
  5109.     (if (or confirm
  5110.         (null gnus-nntp-server))
  5111.     (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
  5112.         ;; Read server name with completion.
  5113.         (setq gnus-nntp-server
  5114.           (completing-read "NNTP server: "
  5115.                    (cons (list gnus-nntp-server)
  5116.                      gnus-secondary-servers)
  5117.                    nil nil gnus-nntp-server))
  5118.       (setq gnus-nntp-server
  5119.         (read-string "NNTP server: " gnus-nntp-server))))
  5120.     ;; If no server name is given, local host is assumed.
  5121.     (if (string-equal gnus-nntp-server "")
  5122.     (setq gnus-nntp-server (system-name)))
  5123.     (cond ((string-match ":" gnus-nntp-server)
  5124.        ;; :DIRECTORY
  5125.        (require 'mhspool)
  5126.        (gnus-define-access-method 'mhspool)
  5127.        (message "Looking up private directory..."))
  5128.       ((and (null gnus-nntp-service)
  5129.             (string-equal gnus-nntp-server (system-name)))
  5130.        (require 'nnspool)
  5131.        (gnus-define-access-method 'nnspool)
  5132.        (message "Looking up local news spool..."))
  5133.       (t
  5134.        (gnus-define-access-method 'nntp)
  5135.        (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
  5136.     (run-hooks 'gnus-Open-server-hook)
  5137.     (cond ((gnus-open-server gnus-nntp-server gnus-nntp-service))
  5138.       (t
  5139.        (error
  5140.         (gnus-nntp-message
  5141.          (format "Cannot open NNTP server on %s" gnus-nntp-server)))))
  5142.     ))
  5143.  
  5144. ;; Dummy functions used only once. Should return nil.
  5145. (defun gnus-server-opened () nil)
  5146. (defun gnus-close-server () nil)
  5147.  
  5148. (defun gnus-nntp-message (&optional message)
  5149.   "Return a message returned from NNTP server.
  5150. If no message is available and optional MESSAGE is given, return it."
  5151.   (let ((status (gnus-status-message))
  5152.     (message (or message "")))
  5153.     (if (and (stringp status)
  5154.          (> (length status) 0))
  5155.     status message)))
  5156.  
  5157. (defun gnus-define-access-method (method &optional access-methods)
  5158.   "Define access functions for the access METHOD.
  5159. Methods defintion is taken from optional argument ACCESS-METHODS or
  5160. the variable gnus-access-methods."
  5161.   (let ((bindings
  5162.      (cdr (assoc method (or access-methods gnus-access-methods)))))
  5163.     (if (null bindings)
  5164.     (error "Unknown access method: %s" method)
  5165.       ;; Should not use symbol-function here since overload does not work.
  5166.       (while bindings
  5167.     (fset (car (car bindings)) (cdr (car bindings)))
  5168.     (setq bindings (cdr bindings)))
  5169.       )))
  5170.  
  5171. (defun gnus-select-newsgroup (group &optional show-all)
  5172.   "Select newsgroup GROUP.
  5173. If optional argument SHOW-ALL is non-nil, all of articles in the group
  5174. are selected."
  5175.   (if (gnus-request-group group)
  5176.       (let ((articles nil))
  5177.     (if (featurep 'gnus-digest)
  5178.         (gnus-digest-reset))
  5179.     (setq gnus-newsgroup-name group)
  5180.     (setq gnus-newsgroup-unreads
  5181.           (gnus-uncompress-sequence
  5182.            (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
  5183.     (cond (show-all
  5184.            ;; Select all active articles.
  5185.            (setq articles
  5186.              (gnus-uncompress-sequence
  5187.               (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
  5188.           (t
  5189.            ;; Select unread articles only.
  5190.            (setq articles gnus-newsgroup-unreads)))
  5191.     ;; Require confirmation if selecting large newsgroup.
  5192.     (setq gnus-newsgroup-unselected nil)
  5193.     (if (not (numberp gnus-large-newsgroup))
  5194.         nil
  5195.       (let ((selected nil)
  5196.         (number (length articles)))
  5197.         (if (> number gnus-large-newsgroup)
  5198.         (progn
  5199.           (condition-case ()
  5200.               (let ((input
  5201.                  (read-string
  5202.                   (format
  5203.                    "How many articles from %s (default %d): "
  5204.                    gnus-newsgroup-name number))))
  5205.             (setq selected
  5206.                   (if (string-equal input "")
  5207.                   number (string-to-int input))))
  5208.             (quit
  5209.              (setq selected 0)))
  5210.           (cond ((and (> selected 0)
  5211.                   (< selected number))
  5212.              ;; Select last N articles.
  5213.              (setq articles (nthcdr (- number selected) articles)))
  5214.             ((and (< selected 0)
  5215.                   (< (- 0 selected) number))
  5216.              ;; Select first N articles.
  5217.              (setq selected (- 0 selected))
  5218.              (setq articles (copy-sequence articles))
  5219.              (setcdr (nthcdr (1- selected) articles) nil))
  5220.             ((zerop selected)
  5221.              (setq articles nil))
  5222.             ;; Otherwise select all.
  5223.             )
  5224.           ;; Get unselected unread articles.
  5225.           (setq gnus-newsgroup-unselected
  5226.             (gnus-set-difference gnus-newsgroup-unreads articles))
  5227.           ))
  5228.         ))
  5229.     ;; Get headers list.
  5230.     (setq gnus-newsgroup-headers (gnus-retrieve-headers articles))
  5231.     ;; UNREADS may contain expired articles, so we have to remove
  5232.     ;;  them from the list.
  5233.     (setq gnus-newsgroup-unreads
  5234.           (gnus-intersection gnus-newsgroup-unreads
  5235.                  (mapcar
  5236.                   (function
  5237.                    (lambda (header)
  5238.                      (nntp-header-number header)))
  5239.                   gnus-newsgroup-headers)))
  5240.     ;; Marked article must be a subset of unread articles.
  5241.     (setq gnus-newsgroup-marked
  5242.           (gnus-intersection (append gnus-newsgroup-unselected
  5243.                      gnus-newsgroup-unreads)
  5244.                  (cdr (assoc group gnus-marked-assoc))))
  5245.     ;; First and last article in this newsgroup.
  5246.     (setq gnus-newsgroup-begin
  5247.           (if gnus-newsgroup-headers
  5248.           (nntp-header-number (car gnus-newsgroup-headers))
  5249.         0
  5250.         ))
  5251.     (setq gnus-newsgroup-end
  5252.           (if gnus-newsgroup-headers
  5253.           (nntp-header-number
  5254.            (gnus-last-element gnus-newsgroup-headers))
  5255.         0
  5256.         ))
  5257.     ;; File name that an article was saved last.
  5258.     (setq gnus-newsgroup-last-rmail nil)
  5259.     (setq gnus-newsgroup-last-mail nil)
  5260.     (setq gnus-newsgroup-last-folder nil)
  5261.     (setq gnus-newsgroup-last-file nil)
  5262.     ;; Reset article pointer etc.
  5263.     (setq gnus-current-article nil)
  5264.     (setq gnus-current-headers nil)
  5265.     (setq gnus-current-history nil)
  5266.     (setq gnus-have-all-headers nil)
  5267.     (setq gnus-last-article nil)
  5268.     ;; Clear old hash tables for the variable gnus-newsgroup-headers.
  5269.     (gnus-clear-hashtables-for-newsgroup-headers)
  5270.     ;; GROUP is successfully selected.
  5271.     t
  5272.     )
  5273.     ))
  5274.  
  5275. ;; Hacking for making header search much faster.
  5276.  
  5277. (defun gnus-get-header-by-number (number)
  5278.   "Return a header specified by a NUMBER.
  5279. If the variable gnus-newsgroup-headers is updated, the hashed table
  5280. gnus-newsgroup-headers-hashtb-by-number must be set to nil to indicate
  5281. rehash is necessary."
  5282.   (or gnus-newsgroup-headers-hashtb-by-number
  5283.       (gnus-make-headers-hashtable-by-number))
  5284.   (gnus-gethash (int-to-string number)
  5285.         gnus-newsgroup-headers-hashtb-by-number))
  5286.  
  5287. (defun gnus-get-header-by-id (id)
  5288.   "Return a header specified by an ID.
  5289. If the variable gnus-newsgroup-headers is updated, the hashed table
  5290. gnus-newsgroup-headers-hashtb-by-id must be set to nil to indicate
  5291. rehash is necessary."
  5292.   (or gnus-newsgroup-headers-hashtb-by-id
  5293.       (gnus-make-headers-hashtable-by-id))
  5294.   (and (stringp id)
  5295.        (gnus-gethash id gnus-newsgroup-headers-hashtb-by-id)))
  5296.  
  5297. (defun gnus-make-headers-hashtable-by-number ()
  5298.   "Make hashtable for the variable gnus-newsgroup-headers by number."
  5299.   (let ((header nil)
  5300.     (headers gnus-newsgroup-headers))
  5301.     (setq gnus-newsgroup-headers-hashtb-by-number (gnus-make-hashtable))
  5302.     (while headers
  5303.       (setq header (car headers))
  5304.       (gnus-sethash (int-to-string (nntp-header-number header))
  5305.             header gnus-newsgroup-headers-hashtb-by-number)
  5306.       (setq headers (cdr headers))
  5307.       )))
  5308.  
  5309. (defun gnus-make-headers-hashtable-by-id ()
  5310.   "Make hashtable for the variable gnus-newsgroup-headers by id."
  5311.   (let ((header nil)
  5312.     (headers gnus-newsgroup-headers))
  5313.     (setq gnus-newsgroup-headers-hashtb-by-id (gnus-make-hashtable))
  5314.     (while headers
  5315.       (setq header (car headers))
  5316.       (gnus-sethash (nntp-header-id header)
  5317.             header gnus-newsgroup-headers-hashtb-by-id)
  5318.       (setq headers (cdr headers))
  5319.       )))
  5320.  
  5321. (defun gnus-clear-hashtables-for-newsgroup-headers ()
  5322.   "Clear hash tables created for the variable gnus-newsgroup-headers."
  5323.   (setq gnus-newsgroup-headers-hashtb-by-id nil)
  5324.   (setq gnus-newsgroup-headers-hashtb-by-number nil))
  5325.  
  5326. (defun gnus-more-header-backward ()
  5327.   "Find new header backward."
  5328.   (let ((first
  5329.      (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
  5330.     (artnum gnus-newsgroup-begin)
  5331.     (header nil))
  5332.     (while (and (not header)
  5333.         (> artnum first))
  5334.       (setq artnum (1- artnum))
  5335.       (setq header (car (gnus-retrieve-headers (list artnum)))))
  5336.     header
  5337.     ))
  5338.  
  5339. (defun gnus-more-header-forward ()
  5340.   "Find new header forward."
  5341.   (let ((last
  5342.      (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
  5343.     (artnum gnus-newsgroup-end)
  5344.     (header nil))
  5345.     (while (and (not header)
  5346.         (< artnum last))
  5347.       (setq artnum (1+ artnum))
  5348.       (setq header (car (gnus-retrieve-headers (list artnum)))))
  5349.     header
  5350.     ))
  5351.  
  5352. (defun gnus-extend-newsgroup (header &optional backward)
  5353.   "Extend newsgroup selection with HEADER.
  5354. Optional argument BACKWARD means extend toward backward."
  5355.   (if header
  5356.       (let ((artnum (nntp-header-number header)))
  5357.     (setq gnus-newsgroup-headers
  5358.           (if backward
  5359.           (cons header gnus-newsgroup-headers)
  5360.         (append gnus-newsgroup-headers (list header))))
  5361.     ;; Clear current hash tables for the variable gnus-newsgroup-headers.
  5362.     (gnus-clear-hashtables-for-newsgroup-headers)
  5363.     ;; We have to update unreads and unselected, but don't have to
  5364.     ;; care about gnus-newsgroup-marked.
  5365.     (if (memq artnum gnus-newsgroup-unselected)
  5366.         (setq gnus-newsgroup-unreads
  5367.           (cons artnum gnus-newsgroup-unreads)))
  5368.     (setq gnus-newsgroup-unselected
  5369.           (delq artnum gnus-newsgroup-unselected))
  5370.     (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
  5371.     (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
  5372.     )))
  5373.  
  5374. (defun gnus-mark-article-as-read (article)
  5375.   "Remember that ARTICLE is marked as read."
  5376.   ;; Remove from unread and marked list.
  5377.   (setq gnus-newsgroup-unreads
  5378.     (delq article gnus-newsgroup-unreads))
  5379.   (setq gnus-newsgroup-marked
  5380.     (delq article gnus-newsgroup-marked)))
  5381.  
  5382. (defun gnus-mark-article-as-unread (article &optional clear-mark)
  5383.   "Remember that ARTICLE is marked as unread.
  5384. Optional argument CLEAR-MARK means ARTICLE should not be remembered
  5385. that it was marked as read once."
  5386.   ;; Add to unread list.
  5387.   (or (memq article gnus-newsgroup-unreads)
  5388.       (setq gnus-newsgroup-unreads
  5389.         (cons article gnus-newsgroup-unreads)))
  5390.   ;; If CLEAR-MARK is non-nil, the article must be removed from marked
  5391.   ;; list.  Otherwise, it must be added to the list.
  5392.   (if clear-mark
  5393.       (setq gnus-newsgroup-marked
  5394.         (delq article gnus-newsgroup-marked))
  5395.     (or (memq article gnus-newsgroup-marked)
  5396.     (setq gnus-newsgroup-marked
  5397.           (cons article gnus-newsgroup-marked)))))
  5398.  
  5399. (defun gnus-clear-system ()
  5400.   "Clear all variables and buffer."
  5401.   ;; Clear GNUS variables.
  5402.   (let ((variables gnus-variable-list))
  5403.     (while variables
  5404.       (set (car variables) nil)
  5405.       (setq variables (cdr variables))))
  5406.   ;; Clear other internal variables.
  5407.   (setq gnus-active-hashtb nil)
  5408.   (setq gnus-octive-hashtb nil)
  5409.   (setq gnus-unread-hashtb nil)
  5410.   (setq gnus-newsgroup-headers nil)
  5411.   (setq gnus-newsgroup-headers-hashtb-by-id nil)
  5412.   (setq gnus-newsgroup-headers-hashtb-by-number nil)
  5413.   ;; Kill the startup file.
  5414.   (and gnus-current-startup-file
  5415.        (get-file-buffer gnus-current-startup-file)
  5416.        (kill-buffer (get-file-buffer gnus-current-startup-file)))
  5417.   (setq gnus-current-startup-file nil)
  5418.   ;; Kill GNUS buffers.
  5419.   (let ((buffers gnus-buffer-list))
  5420.     (while buffers
  5421.       (if (get-buffer (car buffers))
  5422.       (kill-buffer (car buffers)))
  5423.       (setq buffers (cdr buffers))
  5424.       )))
  5425.  
  5426. (defun gnus-configure-windows (action)
  5427.   "Configure GNUS windows according to the next ACTION.
  5428. The ACTION is either a symbol, such as `SelectNewsgroup', or a
  5429. configuration list such as `(1 1 2)'.  If ACTION is not a list,
  5430. configuration list is got from the variable gnus-window-configuration."
  5431.   (let* ((windows
  5432.       (if (listp action)
  5433.           action (car (cdr (assq action gnus-window-configuration)))))
  5434.      (grpwin (get-buffer-window gnus-Group-buffer))
  5435.      (subwin (get-buffer-window gnus-Subject-buffer))
  5436.      (artwin (get-buffer-window gnus-Article-buffer))
  5437.      (winsum nil)
  5438.      (new-height 0)
  5439.      (height nil)
  5440.      (grpheight 0)
  5441.      (subheight 0)
  5442.      (artheight 0))
  5443.     (if (or (null windows)        ;No configuration is specified.
  5444.         (and (eq (null grpwin)
  5445.              (zerop (nth 0 windows)))
  5446.          (eq (null subwin)
  5447.              (zerop (nth 1 windows)))
  5448.          (eq (null artwin)
  5449.              (zerop (nth 2 windows)))))
  5450.     ;; No need to change window configuration.
  5451.     nil
  5452.       (select-window (or grpwin subwin artwin (selected-window)))
  5453.       ;; First of all, compute the height of each window.
  5454.       (cond (gnus-use-full-window
  5455.          ;; Take up the entire screen.
  5456.          (delete-other-windows)
  5457.          (setq height (window-height (selected-window))))
  5458.         (t
  5459.          (setq height (+ (if grpwin (window-height grpwin) 0)
  5460.                  (if subwin (window-height subwin) 0)
  5461.                  (if artwin (window-height artwin) 0)))))
  5462.       ;; The Newsgroup buffer exits always. So, use it to extend the
  5463.       ;; Group window so as to get enough window space.
  5464.       (switch-to-buffer gnus-Group-buffer 'norecord)
  5465.       (and (get-buffer gnus-Subject-buffer)
  5466.        (delete-windows-on gnus-Subject-buffer))
  5467.       (and (get-buffer gnus-Article-buffer)
  5468.        (delete-windows-on gnus-Article-buffer))
  5469.       ;; Compute expected window height.
  5470.       (setq winsum (apply (function +) windows))
  5471.       (if (not (zerop (nth 0 windows)))
  5472.       (setq grpheight (max window-min-height
  5473.                    (/ (* height (nth 0 windows)) winsum))))
  5474.       (if (not (zerop (nth 1 windows)))
  5475.       (setq subheight (max window-min-height
  5476.                    (/ (* height (nth 1 windows)) winsum))))
  5477.       (if (not (zerop (nth 2 windows)))
  5478.       (setq artheight (max window-min-height
  5479.                    (/ (* height (nth 2 windows)) winsum))))
  5480.  
  5481.       (setq new-height (+ grpheight subheight artheight))
  5482.       ;; new-height and height "should" be the same, but they aren't because
  5483.       ;; of integer-roundoff.  So take the remainder and add it to the end
  5484.       ;; of the bottommost window.
  5485.       (or (= new-height height)
  5486.        (cond ((not (zerop artheight))
  5487.           (setq artheight (+ artheight (- height new-height))))
  5488.          ((not (zerop subheight))
  5489.           (setq subheight (+ subheight (- height new-height))))
  5490.          (t ; (not (zerop grpheight))
  5491.           (setq grpheight (+ grpheight (- height new-height))))))
  5492.       (let ((offset (- height (window-height (selected-window)))))
  5493.      (if (> offset 0) (enlarge-window offset)))
  5494.  
  5495.       ;; Then split the window.
  5496.       (and (not (zerop artheight))
  5497.        (or (not (zerop grpheight))
  5498.            (not (zerop subheight)))
  5499.        (split-window nil (+ grpheight subheight)))
  5500.       (and (not (zerop grpheight))
  5501.        (not (zerop subheight))
  5502.        (split-window nil grpheight))
  5503.       ;; Then select buffers in each window.
  5504.       (and (not (zerop grpheight))
  5505.        (progn
  5506.          (switch-to-buffer gnus-Group-buffer 'norecord)
  5507.          (other-window 1)))
  5508.       (and (not (zerop subheight))
  5509.        (progn
  5510.          (switch-to-buffer gnus-Subject-buffer 'norecord)
  5511.          (other-window 1)))
  5512.       (and (not (zerop artheight))
  5513.        (progn
  5514.          ;; If Article buffer does not exist, it will be created
  5515.          ;; and initialized.
  5516.          (gnus-Article-setup-buffer)
  5517.          (switch-to-buffer gnus-Article-buffer 'norecord)))
  5518.       )
  5519.     ))
  5520.  
  5521. (defun gnus-find-header-by-number (headers number)
  5522.   "Return a header which is a element of HEADERS and has NUMBER."
  5523.   (let ((found nil))
  5524.     (while (and headers (not found))
  5525.       ;; We cannot use `=' to accept non-numeric NUMBER.
  5526.       (if (eq number (nntp-header-number (car headers)))
  5527.       (setq found (car headers)))
  5528.       (setq headers (cdr headers)))
  5529.     found
  5530.     ))
  5531.  
  5532. (defun gnus-find-header-by-id (headers id)
  5533.   "Return a header which is a element of HEADERS and has Message-ID."
  5534.   (let ((found nil))
  5535.     (while (and headers (not found))
  5536.       (if (string-equal id (nntp-header-id (car headers)))
  5537.       (setq found (car headers)))
  5538.       (setq headers (cdr headers)))
  5539.     found
  5540.     ))
  5541.  
  5542. (defun gnus-version ()
  5543.   "Version numbers of this version of GNUS."
  5544.   (interactive)
  5545.   (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
  5546.      (message "%s; %s; %s; %s"
  5547.           gnus-version nntp-version nnspool-version mhspool-version))
  5548.     ((boundp 'mhspool-version)
  5549.      (message "%s; %s; %s"
  5550.           gnus-version nntp-version mhspool-version))
  5551.     ((boundp 'nnspool-version)
  5552.      (message "%s; %s; %s"
  5553.           gnus-version nntp-version nnspool-version))
  5554.     (t
  5555.      (message "%s; %s" gnus-version nntp-version))))
  5556.  
  5557. (defun gnus-Info-find-node ()
  5558.   "Find Info documentation of GNUS."
  5559.   (interactive)
  5560.   (require 'info)
  5561.   ;; Enlarge info window if needed.
  5562.   (cond ((eq major-mode 'gnus-Group-mode)
  5563.      (gnus-configure-windows '(1 0 0)) ;Take all windows.
  5564.      (gnus-pop-to-buffer gnus-Group-buffer))
  5565.     ((eq major-mode 'gnus-Subject-mode)
  5566.      (gnus-configure-windows '(0 1 0)) ;Take all windows.
  5567.      (gnus-pop-to-buffer gnus-Subject-buffer)))
  5568.   (let ((Info-directory (expand-file-name gnus-Info-directory nil)))
  5569.     (Info-goto-node (cdr (assq major-mode gnus-Info-nodes)))))
  5570.  
  5571. (defun gnus-overload-functions (&optional overloads)
  5572.   "Overload functions specified by optional argument OVERLOADS.
  5573. If nothing is specified, use the variable gnus-overload-functions."
  5574.   (let ((defs nil)
  5575.     (overloads (or overloads gnus-overload-functions)))
  5576.     (while overloads
  5577.       (setq defs (car overloads))
  5578.       (setq overloads (cdr overloads))
  5579.       ;; Load file before overloading function if necessary.  Make
  5580.       ;; sure we cannot use `requre' always.
  5581.       (and (not (fboundp (car defs)))
  5582.        (car (cdr (cdr defs)))
  5583.        (load (car (cdr (cdr defs))) nil 'nomessage))
  5584.       (fset (car defs) (car (cdr defs)))
  5585.       )))
  5586.  
  5587. (defun gnus-make-threads (newsgroup-headers)
  5588.   "Make conversation threads tree from NEWSGROUP-HEADERS."
  5589.   (let ((headers newsgroup-headers)
  5590.     (h nil)
  5591.     (d nil)
  5592.     (roots nil)
  5593.     (dependencies nil))
  5594.     ;; Make message dependency alist.
  5595.     (while headers
  5596.       (setq h (car headers))
  5597.       (setq headers (cdr headers))
  5598.       ;; Ignore invalid headers.
  5599.       (if (vectorp h)            ;Depends on nntp.el.
  5600.       (progn
  5601.         ;; Ignore broken references, e.g "<123@a.b.c".
  5602.         (setq d (and (nntp-header-references h)
  5603.              (string-match "\\(<[^<>]+>\\)[^>]*$"
  5604.                        (nntp-header-references h))
  5605. ;;             (gnus-find-header-by-id
  5606. ;;              newsgroup-headers
  5607. ;;              (substring (nntp-header-references h)
  5608. ;;                     (match-beginning 1) (match-end 1)))
  5609.              ;; In fact if the variable newsgroup-headers
  5610.              ;; is not 'equal' to the variable
  5611.              ;; gnus-newsgroup-headers, the following
  5612.              ;; function call may return bogus value.
  5613.              (gnus-get-header-by-id
  5614.               (substring (nntp-header-references h)
  5615.                      (match-beginning 1) (match-end 1)))
  5616.              ))
  5617.         ;; Check subject equality.
  5618.         (or gnus-thread-ignore-subject
  5619.         (null d)
  5620.         (string-equal (gnus-simplify-subject
  5621.                    (nntp-header-subject h) 're)
  5622.                   (gnus-simplify-subject
  5623.                    (nntp-header-subject d) 're))
  5624.         ;; H should be a thread root.
  5625.         (setq d nil))
  5626.         ;; H depends on D.
  5627.         (setq dependencies
  5628.           (cons (cons h d) dependencies))
  5629.         ;; H is a thread root.
  5630.         (if (null d)
  5631.         (setq roots (cons h roots)))
  5632.         ))
  5633.       )
  5634.     ;; Make complete threads from the roots.
  5635.     ;; Note: dependencies are in reverse order, but
  5636.     ;; gnus-make-threads-1 processes it in reverse order again.  So,
  5637.     ;; we don't have to worry about it.
  5638.     (mapcar
  5639.      (function
  5640.       (lambda (root)
  5641.     (gnus-make-threads-1 root dependencies))) (nreverse roots))
  5642.     ))
  5643.  
  5644. (defun gnus-make-threads-1 (parent dependencies)
  5645.   (let ((children nil)
  5646.     (d nil)
  5647.     (depends dependencies))
  5648.     ;; Find children.
  5649.     (while depends
  5650.       (setq d (car depends))
  5651.       (setq depends (cdr depends))
  5652.       (and (cdr d)
  5653.        (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
  5654.        (setq children (cons (car d) children))))
  5655.     ;; Go down.
  5656.     (cons parent
  5657.       (mapcar
  5658.        (function
  5659.         (lambda (child)
  5660.           (gnus-make-threads-1 child dependencies))) children))
  5661.     ))
  5662.  
  5663. (defun gnus-narrow-to-page (&optional arg)
  5664.   "Make text outside current page invisible except for page delimiter.
  5665. A numeric arg specifies to move forward or backward by that many pages,
  5666. thus showing a page other than the one point was originally in."
  5667.   (interactive "P")
  5668.   (setq arg (if arg (prefix-numeric-value arg) 0))
  5669.   (save-excursion
  5670.     (forward-page -1)            ;Beginning of current page.
  5671.     (widen)
  5672.     (if (> arg 0)
  5673.     (forward-page arg)
  5674.       (if (< arg 0)
  5675.       (forward-page (1- arg))))
  5676.     ;; Find the end of the page.
  5677.     (forward-page)
  5678.     ;; If we stopped due to end of buffer, stay there.
  5679.     ;; If we stopped after a page delimiter, put end of restriction
  5680.     ;; at the beginning of that line.
  5681.     ;; These are commented out.
  5682.     ;;    (if (save-excursion (beginning-of-line)
  5683.     ;;            (looking-at page-delimiter))
  5684.     ;;    (beginning-of-line))
  5685.     (narrow-to-region (point)
  5686.               (progn
  5687.             ;; Find the top of the page.
  5688.             (forward-page -1)
  5689.             ;; If we found beginning of buffer, stay there.
  5690.             ;; If extra text follows page delimiter on same line,
  5691.             ;; include it.
  5692.             ;; Otherwise, show text starting with following line.
  5693.             (if (and (eolp) (not (bobp)))
  5694.                 (forward-line 1))
  5695.             (point)))
  5696.     ))
  5697.  
  5698. (defun gnus-last-element (list)
  5699.   "Return last element of LIST."
  5700.   (let ((last nil))
  5701.     (while list
  5702.       (if (null (cdr list))
  5703.       (setq last (car list)))
  5704.       (setq list (cdr list)))
  5705.     last
  5706.     ))
  5707.  
  5708. (defun gnus-set-difference (list1 list2)
  5709.   "Return a list of elements of LIST1 that do not appear in LIST2."
  5710.   (let ((list1 (copy-sequence list1)))
  5711.     (while list2
  5712.       (setq list1 (delq (car list2) list1))
  5713.       (setq list2 (cdr list2)))
  5714.     list1
  5715.     ))
  5716.  
  5717. (defun gnus-intersection (list1 list2)
  5718.   "Return a list of elements that appear in both LIST1 and LIST2."
  5719.   (let ((result nil))
  5720.     (while list2
  5721.       (if (memq (car list2) list1)
  5722.       (setq result (cons (car list2) result)))
  5723.       (setq list2 (cdr list2)))
  5724.     result
  5725.     ))
  5726.  
  5727.  
  5728. ;;;
  5729. ;;; Get information about active articles, already read articles, and
  5730. ;;;  still unread articles.
  5731. ;;;
  5732.  
  5733. ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
  5734. ;; (("general" t (1 . 1))
  5735. ;;  ("misc"    t (1 . 10) (12 . 15))
  5736. ;;  ("test"  nil (1 . 99)) ...)
  5737. ;; GNUS internal format of gnus-marked-assoc:
  5738. ;; (("general" 1 2 3)
  5739. ;;  ("misc" 2) ...)
  5740. ;; GNUS internal format of gnus-active-hashtb:
  5741. ;; (("general" t (1 . 1))
  5742. ;;  ("misc"    t (1 . 10))
  5743. ;;  ("test"  nil (1 . 99)) ...)
  5744. ;; GNUS internal format of gnus-unread-hashtb:
  5745. ;; (("general" 1 (1 . 1))
  5746. ;;  ("misc"   14 (1 . 10) (12 . 15))
  5747. ;;  ("test"   99 (1 . 99)) ...)
  5748.  
  5749. (defun gnus-setup-news-info (&optional rawfile)
  5750.   "Setup news information.
  5751. If optional argument RAWFILE is non-nil, force to read raw startup file."
  5752.   (let ((init (not (and gnus-newsrc-assoc
  5753.             gnus-active-hashtb
  5754.             gnus-unread-hashtb
  5755.             (not rawfile)
  5756.             ))))
  5757.     ;; We have to clear some variables to re-initialize news info.
  5758.     (if init
  5759.     (setq gnus-newsrc-assoc nil
  5760.           gnus-active-hashtb nil
  5761.           gnus-unread-hashtb nil))
  5762.     (if init
  5763.     (gnus-read-newsrc-file rawfile))
  5764.     (gnus-read-active-file)
  5765.     (gnus-expire-marked-articles)
  5766.     (gnus-get-unread-articles)
  5767.     ;; Check new newsgroups and subscribe them.
  5768.     (if init
  5769.     (let ((new-newsgroups (gnus-find-new-newsgroups)))
  5770.       (while new-newsgroups
  5771.         (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
  5772.         (setq new-newsgroups (cdr new-newsgroups))
  5773.         )))
  5774.     ))
  5775.  
  5776. (defun gnus-add-newsgroup (newsgroup)
  5777.   "Subscribe new NEWSGROUP safely and put it at top."
  5778.   (and (null (assoc newsgroup gnus-newsrc-assoc)) ;Really new?
  5779.        (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
  5780.        (gnus-insert-newsgroup (or (assoc newsgroup gnus-killed-assoc)
  5781.                   (list newsgroup t))
  5782.                   (car (car gnus-newsrc-assoc)))))
  5783.  
  5784. (defun gnus-find-new-newsgroups ()
  5785.   "Looking for new newsgroups and return names.
  5786. `-n' option of options line in .newsrc file is recognized."
  5787.   (let ((group nil)
  5788.     (new-newsgroups nil))
  5789.     (mapatoms
  5790.      (function
  5791.       (lambda (sym)
  5792.     (setq group (symbol-name sym))
  5793.     ;; Taking account of `-n' option.
  5794.     (and (or (null gnus-newsrc-options-n-no)
  5795.          (not (string-match gnus-newsrc-options-n-no group))
  5796.          (and gnus-newsrc-options-n-yes
  5797.               (string-match gnus-newsrc-options-n-yes group)))
  5798.          (null (assoc group gnus-killed-assoc)) ;Ignore killed.
  5799.          (null (assoc group gnus-newsrc-assoc)) ;Really new.
  5800.          ;; Find new newsgroup.
  5801.          (setq new-newsgroups
  5802.            (cons group new-newsgroups)))
  5803.     ))
  5804.      gnus-active-hashtb)
  5805.     ;; Return new newsgroups.
  5806.     new-newsgroups
  5807.     ))
  5808.  
  5809. (defun gnus-kill-newsgroup (group)
  5810.   "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."
  5811.   (let ((info (assoc group gnus-newsrc-assoc)))
  5812.     (if (null info)
  5813.     nil
  5814.       ;; Delete from gnus-newsrc-assoc
  5815.       (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
  5816.       ;; Add to gnus-killed-assoc.
  5817.       (setq gnus-killed-assoc
  5818.         (cons info
  5819.           (delq (assoc group gnus-killed-assoc) gnus-killed-assoc)))
  5820.       ;; Clear unread hashtable.
  5821.       ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
  5822.       (gnus-sethash group nil gnus-unread-hashtb)
  5823.       ;; Then delete from .newsrc
  5824.       (gnus-update-newsrc-buffer group 'delete)
  5825.       ;; Return the deleted newsrc entry.
  5826.       info
  5827.       )))
  5828.  
  5829. (defun gnus-insert-newsgroup (info &optional next)
  5830.   "Insert newsrc INFO entry before NEXT.
  5831. If optional argument NEXT is nil, appended to the last."
  5832.   (if (null info)
  5833.       (error "Invalid argument: %s" info))
  5834.   (let* ((group (car info))        ;Newsgroup name.
  5835.      (range
  5836.       (gnus-difference-of-range
  5837.        (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
  5838.     ;; Check duplication.
  5839.     (if (assoc group gnus-newsrc-assoc)
  5840.     (error "Duplicated: %s" group))
  5841.     ;; Insert to gnus-newsrc-assoc.
  5842.     (if (string-equal next (car (car gnus-newsrc-assoc)))
  5843.     (setq gnus-newsrc-assoc
  5844.           (cons info gnus-newsrc-assoc))
  5845.       (let ((found nil)
  5846.         (rest gnus-newsrc-assoc)
  5847.         (tail (cons nil gnus-newsrc-assoc)))
  5848.     ;; Seach insertion point.
  5849.     (while (and (not found) rest)
  5850.       (if (string-equal next (car (car rest)))
  5851.           (setq found t)
  5852.         (setq rest (cdr rest))
  5853.         (setq tail (cdr tail))
  5854.         ))
  5855.     ;; Find it.
  5856.     (setcdr tail nil)
  5857.     (setq gnus-newsrc-assoc
  5858.           (append gnus-newsrc-assoc (cons info rest)))
  5859.     ))
  5860.     ;; Delete from gnus-killed-assoc.
  5861.     (setq gnus-killed-assoc
  5862.       (delq (assoc group gnus-killed-assoc) gnus-killed-assoc))
  5863.     ;; Then insert to .newsrc.
  5864.     (gnus-update-newsrc-buffer group nil next)
  5865.     ;; Add to gnus-unread-hashtb.
  5866.     (gnus-sethash group
  5867.           (cons group        ;Newsgroup name.
  5868.             (cons (gnus-number-of-articles range) range))
  5869.           gnus-unread-hashtb)
  5870.     ))
  5871.  
  5872. (defun gnus-check-killed-newsgroups ()
  5873.   "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc."
  5874.   (let ((group nil)
  5875.     (new-killed nil)
  5876.     (old-killed gnus-killed-assoc))
  5877.     (while old-killed
  5878.       (setq group (car (car old-killed)))
  5879.       (and (or (null gnus-newsrc-options-n-no)
  5880.            (not (string-match gnus-newsrc-options-n-no group))
  5881.            (and gnus-newsrc-options-n-yes
  5882.             (string-match gnus-newsrc-options-n-yes group)))
  5883.        (null (assoc group gnus-newsrc-assoc)) ;No duplication.
  5884.        ;; Subscribed in options line and not in gnus-newsrc-assoc.
  5885.        (setq new-killed
  5886.          (cons (car old-killed) new-killed)))
  5887.       (setq old-killed (cdr old-killed))
  5888.       )
  5889.     (setq gnus-killed-assoc (nreverse new-killed))
  5890.     ))
  5891.  
  5892. (defun gnus-check-bogus-newsgroups (&optional confirm)
  5893.   "Delete bogus newsgroups.
  5894. If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
  5895.   (let ((group nil)            ;Newsgroup name temporary used.
  5896.     (old-newsrc gnus-newsrc-assoc)
  5897.     (new-newsrc nil)
  5898.     (bogus nil)            ;List of bogus newsgroups.
  5899.     (old-killed gnus-killed-assoc)
  5900.     (new-killed nil)
  5901.     (old-marked gnus-marked-assoc)
  5902.     (new-marked nil))
  5903.     (message "Checking bogus newsgroups...")
  5904.     ;; Update gnus-newsrc-assoc.
  5905.     (while old-newsrc
  5906.       (setq group (car (car old-newsrc)))
  5907.       (if (or (gnus-gethash group gnus-active-hashtb)
  5908.           (and confirm
  5909.            (not (y-or-n-p
  5910.              (format "Delete bogus newsgroup: %s " group)))))
  5911.       ;; Active newsgroup.
  5912.       (setq new-newsrc (cons (car old-newsrc) new-newsrc))
  5913.     ;; Found a bogus newsgroup.
  5914.     (setq bogus (cons group bogus)))
  5915.       (setq old-newsrc (cdr old-newsrc))
  5916.       )
  5917.     (setq gnus-newsrc-assoc (nreverse new-newsrc))
  5918.     ;; Update gnus-killed-assoc.
  5919.     ;; The killed newsgroups are deleted without any confirmations.
  5920.     (while old-killed
  5921.       (setq group (car (car old-killed)))
  5922.       (and (gnus-gethash group gnus-active-hashtb)
  5923.        (null (assoc group gnus-newsrc-assoc))
  5924.        ;; Active and really killed newsgroup.
  5925.        (setq new-killed (cons (car old-killed) new-killed)))
  5926.       (setq old-killed (cdr old-killed))
  5927.       )
  5928.     (setq gnus-killed-assoc (nreverse new-killed))
  5929.     ;; Remove BOGUS from .newsrc file.
  5930.     (while bogus
  5931.       (gnus-update-newsrc-buffer (car bogus) 'delete)
  5932.       (setq bogus (cdr bogus)))
  5933.     ;; Update gnus-marked-assoc.
  5934.     (while old-marked
  5935.       (setq group (car (car old-marked)))
  5936.       (if (and (cdr (car old-marked))    ;Non-empty?
  5937.            (assoc group gnus-newsrc-assoc))    ;Not bogus?
  5938.       (setq new-marked (cons (car old-marked) new-marked)))
  5939.       (setq old-marked (cdr old-marked)))
  5940.     (setq gnus-marked-assoc new-marked)
  5941.     (message "Checking bogus newsgroups... done")
  5942.     ))
  5943.  
  5944. (defun gnus-get-unread-articles ()
  5945.   "Compute diffs between active and read articles."
  5946.   (let ((read gnus-newsrc-assoc)
  5947.     (group-info nil)
  5948.     (group-name nil)
  5949.     (active nil)
  5950.     (range nil))
  5951.     (message "Checking new news...")
  5952.     (or gnus-unread-hashtb
  5953.     (setq gnus-unread-hashtb (gnus-make-hashtable)))
  5954.     (while read
  5955.       (setq group-info (car read))    ;About one newsgroup
  5956.       (setq group-name (car group-info))
  5957.       (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
  5958.       (if (and gnus-octive-hashtb
  5959.            ;; Is nothing changed?
  5960.            (equal active
  5961.               (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
  5962.            ;; Is this newsgroup in the unread hash table?
  5963.            (gnus-gethash group-name gnus-unread-hashtb)
  5964.            )
  5965.       nil                ;Nothing to do.
  5966.     (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
  5967.     (gnus-sethash group-name
  5968.               (cons group-name    ;Group name
  5969.                 (cons (gnus-number-of-articles range)
  5970.                   range)) ;Range of unread articles
  5971.               gnus-unread-hashtb)
  5972.     )
  5973.       (setq read (cdr read))
  5974.       )
  5975.     (message "Checking new news... done")
  5976.     ))
  5977.  
  5978. (defun gnus-expire-marked-articles ()
  5979.   "Check expired article which is marked as unread."
  5980.   (let ((marked-assoc gnus-marked-assoc)
  5981.     (updated-assoc nil)
  5982.     (marked nil)            ;Current marked info.
  5983.     (articles nil)            ;List of marked articles.
  5984.     (updated nil)            ;List of real marked.
  5985.     (begin nil))
  5986.     (while marked-assoc
  5987.       (setq marked (car marked-assoc))
  5988.       (setq articles (cdr marked))
  5989.       (setq updated nil)
  5990.       (setq begin
  5991.         (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
  5992.       (while (and begin articles)
  5993.     (if (>= (car articles) begin)
  5994.         ;; This article is still active.
  5995.         (setq updated (cons (car articles) updated)))
  5996.     (setq articles (cdr articles)))
  5997.       (if updated
  5998.       (setq updated-assoc
  5999.         (cons (cons (car marked) updated) updated-assoc)))
  6000.       (setq marked-assoc (cdr marked-assoc)))
  6001.     (setq gnus-marked-assoc updated-assoc)
  6002.     ))
  6003.  
  6004. (defun gnus-mark-as-read-by-xref
  6005.   (group headers unreads &optional subscribed-only)
  6006.   "Mark articles as read using cross references and return updated newsgroups.
  6007. Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."
  6008.   (let ((xref-list nil)
  6009.     (header nil)
  6010.     (xrefs nil)            ;One Xref: field info.
  6011.     (xref nil)            ;(NEWSGROUP . ARTICLE)
  6012.     (gname nil)            ;Newsgroup name
  6013.     (article nil))            ;Article number
  6014.     (while headers
  6015.       (setq header (car headers))
  6016.       (if (memq (nntp-header-number header) unreads)
  6017.       ;; This article is not yet marked as read.
  6018.       nil
  6019.     (setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
  6020.     ;; For each cross reference info. in one Xref: field.
  6021.     (while xrefs
  6022.       (setq xref (car xrefs))
  6023.       (setq gname (car xref))    ;Newsgroup name
  6024.       (setq article (cdr xref))    ;Article number
  6025.       (or (string-equal group gname) ;Ignore current newsgroup.
  6026.           ;; Ignore unsubscribed newsgroup if requested.
  6027.           (and subscribed-only
  6028.            (not (nth 1 (assoc gname gnus-newsrc-assoc))))
  6029.           ;; Ignore article marked as unread.
  6030.           (memq article (cdr (assoc gname gnus-marked-assoc)))
  6031.           (let ((group-xref (assoc gname xref-list)))
  6032.         (if group-xref
  6033.             (if (memq article (cdr group-xref))
  6034.             nil        ;Alread marked.
  6035.               (setcdr group-xref (cons article (cdr group-xref))))
  6036.           ;; Create new assoc entry for GROUP.
  6037.           (setq xref-list (cons (list gname article) xref-list)))
  6038.         ))
  6039.       (setq xrefs (cdr xrefs))
  6040.       ))
  6041.       (setq headers (cdr headers)))
  6042.     ;; Mark cross referenced articles as read.
  6043.     (gnus-mark-xrefed-as-read xref-list)
  6044.     ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
  6045.     ;; Return list of updated group name.
  6046.     (mapcar (function car) xref-list)
  6047.     ))
  6048.  
  6049. (defun gnus-parse-xref-field (xref-value)
  6050.   "Parse Xref: field value, and return list of `(group . article-id)'."
  6051.   (let ((xref-list nil)
  6052.     (xref-value (or xref-value "")))
  6053.     ;; Remove server host name.
  6054.     (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
  6055.     (setq xref-value (substring xref-value (match-beginning 1)))
  6056.       (setq xref-value nil))
  6057.     ;; Process each xref info.
  6058.     (while xref-value
  6059.       (if (string-match
  6060.        "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
  6061.       (progn
  6062.         (setq xref-list
  6063.           (cons
  6064.            (cons
  6065.             ;; Group name
  6066.             (substring xref-value (match-beginning 1) (match-end 1))
  6067.             ;; Article-ID
  6068.             (string-to-int
  6069.              (substring xref-value (match-beginning 2) (match-end 2))))
  6070.            xref-list))
  6071.         (setq xref-value (substring xref-value (match-end 2))))
  6072.     (setq xref-value nil)))
  6073.     ;; Return alist.
  6074.     xref-list
  6075.     ))
  6076.  
  6077. (defun gnus-mark-xrefed-as-read (xrefs)
  6078.   "Update unread article information using XREFS alist."
  6079.   (let ((group nil)
  6080.     (idlist nil)
  6081.     (unread nil))
  6082.     (while xrefs
  6083.       (setq group (car (car xrefs)))
  6084.       (setq idlist (cdr (car xrefs)))
  6085.       (setq unread (gnus-uncompress-sequence
  6086.             (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
  6087.       (while idlist
  6088.     (setq unread (delq (car idlist) unread))
  6089.     (setq idlist (cdr idlist)))
  6090.       (gnus-update-unread-articles group unread 'ignore)
  6091.       (setq xrefs (cdr xrefs))
  6092.       )))
  6093.  
  6094. (defun gnus-update-unread-articles (group unread-list marked-list)
  6095.   "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
  6096.   (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
  6097.     (unread (gnus-gethash group gnus-unread-hashtb)))
  6098.     (if (or (null active) (null unread))
  6099.     ;; Ignore unknown newsgroup.
  6100.     nil
  6101.       ;; Update gnus-unread-hashtb.
  6102.       (if unread-list
  6103.       (setcdr (cdr unread)
  6104.           (gnus-compress-sequence unread-list))
  6105.     ;; All of the articles are read.
  6106.     (setcdr (cdr unread) '((0 . 0))))
  6107.       ;; Number of unread articles.
  6108.       (setcar (cdr unread)
  6109.           (gnus-number-of-articles (nthcdr 2 unread)))
  6110.       ;; Update gnus-newsrc-assoc.
  6111.       (if (> (car active) 0)
  6112.       ;; Articles from 1 to N are not active.
  6113.       (setq active (cons 1 (cdr active))))
  6114.       (setcdr (cdr (assoc group gnus-newsrc-assoc))
  6115.           (gnus-difference-of-range active (nthcdr 2 unread)))
  6116.       ;; Update .newsrc buffer.
  6117.       (gnus-update-newsrc-buffer group)
  6118.       ;; Update gnus-marked-assoc.
  6119.       (if (listp marked-list)        ;Includes NIL.
  6120.       (let ((marked (assoc group gnus-marked-assoc)))
  6121.         (cond (marked
  6122.            (setcdr marked marked-list))
  6123.           (marked-list        ;Non-NIL.
  6124.            (setq gnus-marked-assoc
  6125.              (cons (cons group marked-list)
  6126.                    gnus-marked-assoc)))
  6127.           )))
  6128.       )))
  6129.  
  6130. (defun gnus-read-active-file ()
  6131.   "Get active file from NNTP server."
  6132.   (message "Reading active file...")
  6133.   (if (gnus-request-list)        ;Get active file from server
  6134.       (save-excursion
  6135.     (set-buffer nntp-server-buffer)
  6136.     ;; Save OLD active info.
  6137.     (setq gnus-octive-hashtb gnus-active-hashtb)
  6138.     (setq gnus-active-hashtb (gnus-make-hashtable))
  6139.     (gnus-active-to-gnus-format)
  6140.     (message "Reading active file... done"))
  6141.     (error "Cannot read active file from NNTP server.")))
  6142.  
  6143. (defun gnus-active-to-gnus-format ()
  6144.   "Convert active file format to internal format."
  6145.   ;; Delete unnecessary lines.
  6146.   (goto-char (point-min))
  6147.   (delete-matching-lines "^to\\..*$")
  6148.   ;; Store active file in hashtable.
  6149.   (goto-char (point-min))
  6150.   (while
  6151.       (re-search-forward
  6152.        "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
  6153.        nil t)
  6154.     (gnus-sethash
  6155.      (buffer-substring (match-beginning 1) (match-end 1))
  6156.      (list (buffer-substring (match-beginning 1) (match-end 1))
  6157.        (string-equal
  6158.         "y" (buffer-substring (match-beginning 4) (match-end 4)))
  6159.        (cons (string-to-int
  6160.           (buffer-substring (match-beginning 3) (match-end 3)))
  6161.          (string-to-int
  6162.           (buffer-substring (match-beginning 2) (match-end 2)))))
  6163.      gnus-active-hashtb)
  6164.     ))
  6165.  
  6166. (defun gnus-read-newsrc-file (&optional rawfile)
  6167.   "Read startup FILE.
  6168. If optional argument RAWFILE is non-nil, the raw startup file is read."
  6169.   (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
  6170.   ;; Reset variables which may be included in the quick startup file.
  6171.   (let ((variables gnus-variable-list))
  6172.     (while variables
  6173.       (set (car variables) nil)
  6174.       (setq variables (cdr variables))))
  6175.   (let* ((newsrc-file gnus-current-startup-file)
  6176.      (quick-file (concat newsrc-file ".el"))
  6177.      (quick-loaded nil)
  6178.      (newsrc-mod (nth 5 (file-attributes newsrc-file)))
  6179.      (quick-mod (nth 5 (file-attributes quick-file))))
  6180.     (save-excursion
  6181.       ;; Prepare .newsrc buffer.
  6182.       (set-buffer (find-file-noselect newsrc-file))
  6183.       ;; It is not so good idea turning off undo.
  6184.       ;;(buffer-disable-undo (current-buffer))
  6185.       ;; Load quick .newsrc to restore gnus-marked-assoc and
  6186.       ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date.
  6187.       (condition-case nil
  6188.       (setq quick-loaded (load quick-file t t t))
  6189.     (error nil))
  6190.       (cond ((and (not rawfile)        ;Not forced to read the raw file.
  6191.           (or (and (fboundp 'file-newer-than-file-p)
  6192.                (file-newer-than-file-p quick-file newsrc-file))
  6193.               (and newsrc-mod quick-mod
  6194.                ;; .newsrc.el is newer than .newsrc.
  6195.                ;; Some older version does not support function
  6196.                ;; `file-newer-than-file-p'.
  6197.                (or (< (car newsrc-mod) (car quick-mod))
  6198.                    (and (= (car newsrc-mod) (car quick-mod))
  6199.                     (<= (nth 1 newsrc-mod) (nth 1 quick-mod))))
  6200.                ))
  6201.           quick-loaded
  6202.           gnus-newsrc-assoc    ;Really loaded?
  6203.           )
  6204.          ;; We don't have to read the raw startup file.
  6205.          )
  6206.         (t
  6207.          ;; Since .newsrc file is newer than quick file, read it.
  6208.          (message "Reading %s..." newsrc-file)
  6209.          (gnus-newsrc-to-gnus-format)
  6210.          (gnus-check-killed-newsgroups)
  6211.          (message "Reading %s... Done" newsrc-file)))
  6212.       )))
  6213.  
  6214. (defun gnus-make-newsrc-file (file)
  6215.   "Make server dependent file name by catenating FILE and server host name."
  6216.   (let* ((file (expand-file-name file nil))
  6217.      (real-file (concat file "-" gnus-nntp-server)))
  6218.     (if (file-exists-p real-file)
  6219.     real-file file)
  6220.     ))
  6221.  
  6222. (defun gnus-newsrc-to-gnus-format ()
  6223.   "Parse current buffer as .newsrc file."
  6224.   (let ((newsgroup nil)
  6225.     (subscribe nil)
  6226.     (ranges nil)
  6227.     (subrange nil)
  6228.     (read-list nil))
  6229.     ;; We have to re-initialize these variable (except for
  6230.     ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup
  6231.     ;; file may contain bogus values.
  6232.     (setq gnus-newsrc-options nil)
  6233.     (setq gnus-newsrc-options-n-yes nil)
  6234.     (setq gnus-newsrc-options-n-no nil)
  6235.     (setq gnus-newsrc-assoc nil)
  6236.     ;; Save options line to variable.
  6237.     ;; Lines beginning with white spaces are treated as continuation
  6238.     ;; line.  Refer man page of newsrc(5).
  6239.     (goto-char (point-min))
  6240.     (if (re-search-forward
  6241.      "^[ \t]*options[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)[ \t]*$" nil t)
  6242.     (progn
  6243.       ;; Save entire options line.
  6244.       (setq gnus-newsrc-options
  6245.         (buffer-substring (match-beginning 1) (match-end 1)))
  6246.       ;; Compile "-n" option.
  6247.       (if (string-match "\\(^\\|[ \t\n]\\)-n" gnus-newsrc-options)
  6248.           (let ((yes-and-no
  6249.              (gnus-parse-n-options
  6250.               (substring gnus-newsrc-options (match-end 0)))))
  6251.         (setq gnus-newsrc-options-n-yes (car yes-and-no))
  6252.         (setq gnus-newsrc-options-n-no  (cdr yes-and-no))
  6253.         ))
  6254.       ))
  6255.     ;; Parse body of .newsrc file
  6256.     ;; Options line continuation lines must be also considered here.
  6257.     ;; Before supporting continuation lines, " newsgroup ! 1-5" was
  6258.     ;; okay, but now it is invalid.  It should be "newsgroup! 1-5".
  6259.     (goto-char (point-min))
  6260.     ;; Due to overflows in regex.c, change the following regexp:
  6261.     ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$"
  6262.     ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem).
  6263.     (while (re-search-forward
  6264.         "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" nil t)
  6265.       (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
  6266.       ;; Check duplications of newsgroups.
  6267.       ;; Note: Checking the duplications takes very long time.
  6268.       (if (assoc newsgroup gnus-newsrc-assoc)
  6269.       (message "Ignore duplicated newsgroup: %s" newsgroup)
  6270.     (setq subscribe
  6271.           (string-equal
  6272.            ":" (buffer-substring (match-beginning 2) (match-end 2))))
  6273.     (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
  6274.     (setq read-list nil)
  6275.     (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
  6276.       (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
  6277.       (setq ranges (substring ranges (match-end 1)))
  6278.       (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
  6279.          (setq read-list
  6280.                (cons
  6281.             (cons (string-to-int
  6282.                    (substring subrange
  6283.                       (match-beginning 1) (match-end 1)))
  6284.                   (string-to-int
  6285.                    (substring subrange
  6286.                       (match-beginning 2) (match-end 2))))
  6287.             read-list)))
  6288.         ((string-match "^[0-9]+$" subrange)
  6289.          (setq read-list
  6290.                (cons (cons (string-to-int subrange)
  6291.                    (string-to-int subrange))
  6292.                  read-list)))
  6293.         (t
  6294.          (ding) (message "Ignoring bogus lines of %s" newsgroup)
  6295.          (sit-for 0))
  6296.         ))
  6297.     (setq gnus-newsrc-assoc
  6298.           (cons (cons newsgroup (cons subscribe (nreverse read-list)))
  6299.             gnus-newsrc-assoc))
  6300.     ))
  6301.     (setq gnus-newsrc-assoc
  6302.       (nreverse gnus-newsrc-assoc))
  6303.     ))
  6304.  
  6305. (defun gnus-parse-n-options (options)
  6306.   "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
  6307.   (let ((yes nil)
  6308.     (no nil)
  6309.     (yes-or-no nil)            ;`!' or not.
  6310.     (newsgroup nil))
  6311.     ;; Parse each newsgroup description such as "comp.all".  Commas
  6312.     ;; and white spaces can be a newsgroup separator.
  6313.     (while
  6314.     (string-match "^[ \t\n,]*\\(!?\\)\\([^--- \t\n,][^ \t\n,]*\\)" options)
  6315.       (setq yes-or-no
  6316.         (substring options (match-beginning 1) (match-end 1)))
  6317.       (setq newsgroup
  6318.         (regexp-quote
  6319.          (substring options
  6320.             (match-beginning 2) (match-end 2))))
  6321.       (setq options (substring options (match-end 2)))
  6322.       ;; Rewrite "all" to ".+" not ".*".  ".+" requires at least one
  6323.       ;; character.
  6324.       (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
  6325.     (setq newsgroup
  6326.           (concat (substring newsgroup 0 (match-end 1))
  6327.               ".+"
  6328.               (substring newsgroup (match-beginning 2)))))
  6329.       (cond ((string-equal yes-or-no "!")
  6330.          (setq no (cons newsgroup no)))
  6331.         ((string-equal newsgroup ".+")) ;Ignore `all'.
  6332.         (t
  6333.          (setq yes (cons newsgroup yes)))
  6334.         ))
  6335.     ;; Make a cons of regexps from parsing result.
  6336.     (cons (if yes
  6337.           (concat "^\\("
  6338.               (apply (function concat)
  6339.                  (mapcar
  6340.                   (function
  6341.                    (lambda (newsgroup)
  6342.                  (concat newsgroup "\\|")))
  6343.                   (cdr yes)))
  6344.               (car yes) "\\)"))
  6345.       (if no
  6346.           (concat "^\\("
  6347.               (apply (function concat)
  6348.                  (mapcar
  6349.                   (function
  6350.                    (lambda (newsgroup)
  6351.                  (concat newsgroup "\\|")))
  6352.                   (cdr no)))
  6353.               (car no) "\\)")))
  6354.     ))
  6355.  
  6356. (defun gnus-save-newsrc-file ()
  6357.   "Save to .newsrc FILE."
  6358.   ;; Note: We cannot save .newsrc file if all newsgroups are removed
  6359.   ;; from the variable gnus-newsrc-assoc.
  6360.   (and (or gnus-newsrc-assoc gnus-killed-assoc)
  6361.        gnus-current-startup-file
  6362.        (save-excursion
  6363.      ;; A buffer containing .newsrc file may be deleted.
  6364.      (set-buffer (find-file-noselect gnus-current-startup-file))
  6365.      (if (not (buffer-modified-p))
  6366.          (message "(No changes need to be saved)")
  6367.        (message "Saving %s..." gnus-current-startup-file)
  6368.        (let ((make-backup-files t)
  6369.          (version-control nil)
  6370.          (require-final-newline t)) ;Don't ask even if requested.
  6371.          ;; Make backup file of master newsrc.
  6372.          ;; You can stop or change version control of backup file.
  6373.          ;; Suggested by jason@violet.berkeley.edu.
  6374.          (run-hooks 'gnus-Save-newsrc-hook)
  6375.          (save-buffer))
  6376.        ;; Quickly loadable .newsrc.
  6377.        (set-buffer (get-buffer-create " *GNUS-newsrc*"))
  6378.        (buffer-disable-undo (current-buffer))
  6379.        (erase-buffer)
  6380.        (gnus-gnus-to-quick-newsrc-format)
  6381.        (let ((make-backup-files nil)
  6382.          (version-control nil)
  6383.          (require-final-newline t)) ;Don't ask even if requested.
  6384.          (write-file (concat gnus-current-startup-file ".el")))
  6385.        (kill-buffer (current-buffer))
  6386.        (message "Saving %s... Done" gnus-current-startup-file)
  6387.        ))
  6388.     ))
  6389.  
  6390. (defun gnus-update-newsrc-buffer (group &optional delete next)
  6391.   "Incrementally update .newsrc buffer about GROUP.
  6392. If optional 1st argument DELETE is non-nil, delete the group.
  6393. If optional 2nd argument NEXT is non-nil, inserted before it."
  6394.   (save-excursion
  6395.     ;; Taking account of the killed startup file.
  6396.     ;; Suggested by tale@pawl.rpi.edu.
  6397.     (set-buffer (or (get-file-buffer gnus-current-startup-file)
  6398.             (find-file-noselect gnus-current-startup-file)))
  6399.     ;; Options line continuation lines must be also considered here.
  6400.     ;; Before supporting continuation lines, " newsgroup ! 1-5" was
  6401.     ;; okay, but now it is invalid.  It should be "newsgroup! 1-5".
  6402.     (let ((deleted nil)
  6403.       (buffer-read-only nil))    ;May be not modifiable.
  6404.       ;; Delete ALL entries which match for GROUP.
  6405.       (goto-char (point-min))
  6406.       (while (re-search-forward
  6407.           (concat "^" (regexp-quote group) "[:!]") nil t)
  6408.     (beginning-of-line)
  6409.     (delete-region (point) (progn (forward-line 1) (point)))
  6410.     (setq deleted t)        ;Old entry is deleted.
  6411.     )
  6412.       (if delete
  6413.       nil
  6414.     ;; Insert group entry.
  6415.     (let ((newsrc (assoc group gnus-newsrc-assoc)))
  6416.       (if (null newsrc)
  6417.           nil
  6418.         ;; Find insertion point.
  6419.         (cond (deleted nil)        ;Insert here.
  6420.           ((and (stringp next)
  6421.             (progn
  6422.               (goto-char (point-min))
  6423.               (re-search-forward
  6424.                (concat "^" (regexp-quote next) "[:!]") nil t)))
  6425.            (beginning-of-line))
  6426.           (t
  6427.            (goto-char (point-max))
  6428.            (or (bolp)
  6429.                (insert "\n"))))
  6430.         ;; Insert after options line.
  6431.         (if (looking-at "^[ \t]*options\\([ \t]\\|$\\)")
  6432.         (progn
  6433.           (forward-line 1)
  6434.           ;; Skip continuation lines.
  6435.           (while (and (not (eobp))
  6436.                   (looking-at "^[ \t]+"))
  6437.             (forward-line 1))))
  6438.         (insert group        ;Group name
  6439.             (if (nth 1 newsrc) ": " "! ")) ;Subscribed?
  6440.         (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
  6441.         (insert "\n")
  6442.         )))
  6443.       )))
  6444.  
  6445. (defun gnus-gnus-to-quick-newsrc-format ()
  6446.   "Insert GNUS variables such as gnus-newsrc-assoc in lisp format."
  6447.   (insert ";; GNUS internal format of .newsrc.\n")
  6448.   (insert ";; Touch .newsrc instead if you think to remove this file.\n")
  6449.   (let ((variable nil)
  6450.     (variables gnus-variable-list)
  6451.     ;; Temporary rebind to make changes invisible.
  6452.     (gnus-killed-assoc gnus-killed-assoc))
  6453.     ;; Remove duplicated or unsubscribed newsgroups in gnus-killed-assoc.
  6454.     (gnus-check-killed-newsgroups)
  6455.     ;; Then, insert lisp expressions.
  6456.     (while variables
  6457.       (setq variable (car variables))
  6458.       (and (boundp variable)
  6459.        (symbol-value variable)
  6460.        (insert "(setq " (symbol-name variable) " '"
  6461.            (prin1-to-string (symbol-value variable))
  6462.            ")\n"))
  6463.       (setq variables (cdr variables)))
  6464.     ))
  6465.  
  6466. (defun gnus-ranges-to-newsrc-format (ranges)
  6467.   "Insert ranges of read articles."
  6468.   (let ((range nil))            ;Range is a pair of BEGIN and END.
  6469.     (while ranges
  6470.       (setq range (car ranges))
  6471.       (setq ranges (cdr ranges))
  6472.       (cond ((= (car range) (cdr range))
  6473.          (if (= (car range) 0)
  6474.          (setq ranges nil)    ;No unread articles.
  6475.            (insert (int-to-string (car range)))
  6476.            (if ranges (insert ","))
  6477.            ))
  6478.         (t
  6479.          (insert (int-to-string (car range))
  6480.              "-"
  6481.              (int-to-string (cdr range)))
  6482.          (if ranges (insert ","))
  6483.          ))
  6484.       )))
  6485.  
  6486. (defun gnus-compress-sequence (numbers)
  6487.   "Convert list of sorted numbers to ranges."
  6488.   (let* ((numbers (sort (copy-sequence numbers) (function <)))
  6489.      (first (car numbers))
  6490.      (last (car numbers))
  6491.      (result nil))
  6492.     (while numbers
  6493.       (cond ((= last (car numbers)) nil) ;Omit duplicated number
  6494.         ((= (1+ last) (car numbers)) ;Still in sequence
  6495.          (setq last (car numbers)))
  6496.         (t                ;End of one sequence
  6497.          (setq result (cons (cons first last) result))
  6498.          (setq first (car numbers))
  6499.          (setq last  (car numbers)))
  6500.         )
  6501.       (setq numbers (cdr numbers))
  6502.       )
  6503.     (nreverse (cons (cons first last) result))
  6504.     ))
  6505.  
  6506. (defun gnus-uncompress-sequence (ranges)
  6507.   "Expand compressed format of sequence."
  6508.   (let ((first nil)
  6509.     (last  nil)
  6510.     (result nil))
  6511.     (while ranges
  6512.       (setq first (car (car ranges)))
  6513.       (setq last  (cdr (car ranges)))
  6514.       (while (< first last)
  6515.     (setq result (cons first result))
  6516.     (setq first (1+ first)))
  6517.       (setq result (cons first result))
  6518.       (setq ranges (cdr ranges))
  6519.       )
  6520.     (nreverse result)
  6521.     ))
  6522.  
  6523. (defun gnus-number-of-articles (range)
  6524.   "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
  6525.   (let ((count 0))
  6526.     (while range
  6527.       (if (/= (cdr (car range)) 0)
  6528.       ;; If end1 is 0, it must be skipped. Usually no articles in
  6529.       ;;  this group.
  6530.       (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
  6531.       (setq range (cdr range))
  6532.       )
  6533.     count                ;Result
  6534.     ))
  6535.  
  6536. (defun gnus-difference-of-range (src obj)
  6537.   "Compute (SRC - OBJ) on range.
  6538. Range of SRC is expressed as `(beg . end)'.
  6539. Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
  6540.   (let ((beg (car src))
  6541.     (end (cdr src))
  6542.     (range nil))            ;This is result.
  6543.     ;; Src may be nil.
  6544.     (while (and src obj)
  6545.       (let ((beg1 (car (car obj)))
  6546.         (end1 (cdr (car obj))))
  6547.     (cond ((> beg end)
  6548.            (setq obj nil))        ;Terminate loop
  6549.           ((< beg beg1)
  6550.            (setq range (cons (cons beg (min (1- beg1) end)) range))
  6551.            (setq beg (1+ end1)))
  6552.           ((>= beg beg1)
  6553.            (setq beg (max beg (1+ end1))))
  6554.           )
  6555.     (setq obj (cdr obj))        ;Next OBJ
  6556.     ))
  6557.     ;; Src may be nil.
  6558.     (if (and src (<= beg end))
  6559.     (setq range (cons (cons beg end) range)))
  6560.     ;; Result
  6561.     (if range
  6562.     (nreverse range)
  6563.       (list (cons 0 0)))
  6564.     ))
  6565.  
  6566.  
  6567. ;;Local variables:
  6568. ;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
  6569. ;;end:
  6570.  
  6571.