Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
29 (eval '(run-hooks 'gnus-load-hook)) 29 (eval '(run-hooks 'gnus-load-hook))
30 30
31 (require 'mail-utils) 31 (require 'mail-utils)
32 (require 'timezone) 32 (require 'timezone)
33 (require 'nnheader) 33 (require 'nnheader)
34 (require 'message)
35 (require 'nnmail) 34 (require 'nnmail)
36 (require 'backquote) 35 (require 'nnoo)
37 36
38 (eval-when-compile (require 'cl)) 37 (eval-when-compile (require 'cl))
39 38
40 (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/") 39 (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
41 "*Directory variable from which all other Gnus file variables are derived.") 40 "*Directory variable from which all other Gnus file variables are derived.")
147 146
148 It's probably not a very effective to change this variable once you've 147 It's probably not a very effective to change this variable once you've
149 run Gnus once. After doing that, you must edit this server from the 148 run Gnus once. After doing that, you must edit this server from the
150 server buffer.") 149 server buffer.")
151 150
151 (defvar gnus-message-archive-group nil
152 "*Name of the group in which to save the messages you've written.
153 This can either be a string, a list of strings; or an alist
154 of regexps/functions/forms to be evaluated to return a string (or a list
155 of strings). The functions are called with the name of the current
156 group (or nil) as a parameter.
157
158 If you want to save your mail in one group and the news articles you
159 write in another group, you could say something like:
160
161 \(setq gnus-message-archive-group
162 '((if (message-news-p)
163 \"misc-news\"
164 \"misc-mail\")))
165
166 Normally the group names returned by this variable should be
167 unprefixed -- which implictly means \"store on the archive server\".
168 However, you may wish to store the message on some other server. In
169 that case, just return a fully prefixed name of the group --
170 \"nnml+private:mail.misc\", for instance.")
171
152 (defvar gnus-refer-article-method nil 172 (defvar gnus-refer-article-method nil
153 "*Preferred method for fetching an article by Message-ID. 173 "*Preferred method for fetching an article by Message-ID.
154 If you are reading news from the local spool (with nnspool), fetching 174 If you are reading news from the local spool (with nnspool), fetching
155 articles by Message-ID is painfully slow. By setting this method to an 175 articles by Message-ID is painfully slow. By setting this method to an
156 nntp method, you might get acceptable results. 176 nntp method, you might get acceptable results.
202 "*Directory where the group FAQs are stored. 222 "*Directory where the group FAQs are stored.
203 This will most commonly be on a remote machine, and the file will be 223 This will most commonly be on a remote machine, and the file will be
204 fetched by ange-ftp. 224 fetched by ange-ftp.
205 225
206 This variable can also be a list of directories. In that case, the 226 This variable can also be a list of directories. In that case, the
207 first element in the list will be used by default, and the others will 227 first element in the list will be used by default. The others can
208 be used as backup sites. 228 be used when being prompted for a site.
209 229
210 Note that Gnus uses an aol machine as the default directory. If this 230 Note that Gnus uses an aol machine as the default directory. If this
211 feels fundamentally unclean, just think of it as a way to finally get 231 feels fundamentally unclean, just think of it as a way to finally get
212 something of value back from them. 232 something of value back from them.
213 233
484 504
485 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when 505 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
486 comparing subjects.") 506 comparing subjects.")
487 507
488 (defvar gnus-simplify-ignored-prefixes nil 508 (defvar gnus-simplify-ignored-prefixes nil
489 "*Regexp, matches for which are removed from subject lines when simplifying.") 509 "*Regexp, matches for which are removed from subject lines when simplifying fuzzily.")
490 510
491 (defvar gnus-build-sparse-threads nil 511 (defvar gnus-build-sparse-threads nil
492 "*If non-nil, fill in the gaps in threads. 512 "*If non-nil, fill in the gaps in threads.
493 If `some', only fill in the gaps that are needed to tie loose threads 513 If `some', only fill in the gaps that are needed to tie loose threads
494 together. If `more', fill in all leaf nodes that Gnus can find. If 514 together. If `more', fill in all leaf nodes that Gnus can find. If
517 537
518 (defvar gnus-goto-next-group-when-activating t 538 (defvar gnus-goto-next-group-when-activating t
519 "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.") 539 "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
520 540
521 (defvar gnus-check-new-newsgroups t 541 (defvar gnus-check-new-newsgroups t
522 "*Non-nil means that Gnus will add new newsgroups at startup. 542 "*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup.
523 If this variable is `ask-server', Gnus will ask the server for new 543 This normally finds new newsgroups by comparing the active groups the
524 groups since the last time it checked. This means that the killed list 544 servers have already reported with those Gnus already knows, either alive
525 is no longer necessary, so you could set `gnus-save-killed-list' to 545 or killed.
526 nil. 546
527 547 When any of the following are true, gnus-find-new-newsgroups will instead
528 A variant is to have this variable be a list of select methods. Gnus 548 ask the servers (primary, secondary, and archive servers) to list new
529 will then use the `ask-server' method on all these select methods to 549 groups since the last time it checked:
530 query for new groups from all those servers. 550 1. This variable is `ask-server'.
551 2. This variable is a list of select methods (see below).
552 3. `gnus-read-active-file' is nil or `some'.
553 4. A prefix argument is given to gnus-find-new-newsgroups interactively.
554
555 Thus, if this variable is `ask-server' or a list of select methods or
556 `gnus-read-active-file' is nil or `some', then the killed list is no
557 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
558
559 This variable can be a list of select methods which Gnus will query with
560 the `ask-server' method in addition to the primary, secondary, and archive
561 servers.
531 562
532 Eg. 563 Eg.
533 (setq gnus-check-new-newsgroups 564 (setq gnus-check-new-newsgroups
534 '((nntp \"some.server\") (nntp \"other.server\"))) 565 '((nntp \"some.server\") (nntp \"other.server\")))
535 566
862 (article 1.0))) 893 (article 1.0)))
863 (t 894 (t
864 '(vertical 1.0 895 '(vertical 1.0
865 (summary 0.25 point) 896 (summary 0.25 point)
866 (if gnus-carpal '(summary-carpal 4)) 897 (if gnus-carpal '(summary-carpal 4))
867 (if gnus-use-trees '(tree 0.25))
868 (article 1.0))))) 898 (article 1.0)))))
869 (server 899 (server
870 (vertical 1.0 900 (vertical 1.0
871 (server 1.0 point) 901 (server 1.0 point)
872 (if gnus-carpal '(server-carpal 2)))) 902 (if gnus-carpal '(server-carpal 2))))
1011 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet 1041 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
1012 "*Function used for sorting the group buffer. 1042 "*Function used for sorting the group buffer.
1013 This function will be called with group info entries as the arguments 1043 This function will be called with group info entries as the arguments
1014 for the groups to be sorted. Pre-made functions include 1044 for the groups to be sorted. Pre-made functions include
1015 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread', 1045 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
1016 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and 1046 `gnus-group-sort-by-level', `gnus-group-sort-by-score',
1017 `gnus-group-sort-by-rank'. 1047 `gnus-group-sort-by-method', and `gnus-group-sort-by-rank'.
1018 1048
1019 This variable can also be a list of sorting functions. In that case, 1049 This variable can also be a list of sorting functions. In that case,
1020 the most significant sort function should be the last function in the 1050 the most significant sort function should be the last function in the
1021 list.") 1051 list.")
1022 1052
1065 (defvar gnus-empty-thread-mark ? 1095 (defvar gnus-empty-thread-mark ?
1066 "*There is no thread under the article.") 1096 "*There is no thread under the article.")
1067 (defvar gnus-not-empty-thread-mark ?= 1097 (defvar gnus-not-empty-thread-mark ?=
1068 "*There is a thread under the article.") 1098 "*There is a thread under the article.")
1069 1099
1100 (defvar gnus-shell-command-separator ";"
1101 "String used to separate to shell commands.")
1102
1070 (defvar gnus-view-pseudo-asynchronously nil 1103 (defvar gnus-view-pseudo-asynchronously nil
1071 "*If non-nil, Gnus will view pseudo-articles asynchronously.") 1104 "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1072 1105
1073 (defvar gnus-view-pseudos nil 1106 (defvar gnus-view-pseudos nil
1074 "*If `automatic', pseudo-articles will be viewed automatically. 1107 "*If `automatic', pseudo-articles will be viewed automatically.
1081 list of parameters to that command.") 1114 list of parameters to that command.")
1082 1115
1083 (defvar gnus-insert-pseudo-articles t 1116 (defvar gnus-insert-pseudo-articles t
1084 "*If non-nil, insert pseudo-articles when decoding articles.") 1117 "*If non-nil, insert pseudo-articles when decoding articles.")
1085 1118
1086 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n" 1119 (defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
1087 "*Format of group lines. 1120 "*Format of group lines.
1088 It works along the same lines as a normal formatting string, 1121 It works along the same lines as a normal formatting string,
1089 with some simple extensions. 1122 with some simple extensions.
1090 1123
1091 %M Only marked articles (character, \"*\" or \" \") 1124 %M Only marked articles (character, \"*\" or \" \")
1129 a bit of extra memory will be used. %D will also worsen performance. 1162 a bit of extra memory will be used. %D will also worsen performance.
1130 Also note that if you change the format specification to include any 1163 Also note that if you change the format specification to include any
1131 of these specs, you must probably re-start Gnus to see them go into 1164 of these specs, you must probably re-start Gnus to see them go into
1132 effect.") 1165 effect.")
1133 1166
1134 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" 1167 (defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
1135 "*The format specification of the lines in the summary buffer. 1168 "*The format specification of the lines in the summary buffer.
1136 1169
1137 It works along the same lines as a normal formatting string, 1170 It works along the same lines as a normal formatting string,
1138 with some simple extensions. 1171 with some simple extensions.
1139 1172
1218 1251
1219 (defvar gnus-article-mode-line-format "Gnus: %%b %S" 1252 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1220 "*The format specification for the article mode line. 1253 "*The format specification for the article mode line.
1221 See `gnus-summary-mode-line-format' for a closer description.") 1254 See `gnus-summary-mode-line-format' for a closer description.")
1222 1255
1223 (defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}" 1256 (defvar gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
1224 "*The format specification for the group mode line. 1257 "*The format specification for the group mode line.
1225 It works along the same lines as a normal formatting string, 1258 It works along the same lines as a normal formatting string,
1226 with some simple extensions: 1259 with some simple extensions:
1227 1260
1228 %S The native news server. 1261 %S The native news server.
1244 ("nnsoup" post-mail address) 1277 ("nnsoup" post-mail address)
1245 ("nndraft" post-mail) 1278 ("nndraft" post-mail)
1246 ("nnfolder" mail respool address)) 1279 ("nnfolder" mail respool address))
1247 "An alist of valid select methods. 1280 "An alist of valid select methods.
1248 The first element of each list lists should be a string with the name 1281 The first element of each list lists should be a string with the name
1249 of the select method. The other elements may be be the category of 1282 of the select method. The other elements may be the category of
1250 this method (ie. `post', `mail', `none' or whatever) or other 1283 this method (ie. `post', `mail', `none' or whatever) or other
1251 properties that this method has (like being respoolable). 1284 properties that this method has (like being respoolable).
1252 If you implement a new select method, all you should have to change is 1285 If you implement a new select method, all you should have to change is
1253 this variable. I think.") 1286 this variable. I think.")
1254 1287
1312 1345
1313 (defvar gnus-auto-subscribed-groups 1346 (defvar gnus-auto-subscribed-groups
1314 "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" 1347 "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1315 "*All new groups that match this regexp will be subscribed automatically. 1348 "*All new groups that match this regexp will be subscribed automatically.
1316 Note that this variable only deals with new groups. It has no effect 1349 Note that this variable only deals with new groups. It has no effect
1317 whatsoever on old groups.") 1350 whatsoever on old groups.
1351
1352 New groups that match this regexp will not be handled by
1353 `gnus-subscribe-newsgroup-method'. Instead, they will
1354 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
1318 1355
1319 (defvar gnus-options-subscribe nil 1356 (defvar gnus-options-subscribe nil
1320 "*All new groups matching this regexp will be subscribed unconditionally. 1357 "*All new groups matching this regexp will be subscribed unconditionally.
1321 Note that this variable deals only with new newsgroups. This variable 1358 Note that this variable deals only with new newsgroups. This variable
1322 does not affect old newsgroups.") 1359 does not affect old newsgroups.
1360
1361 New groups that match this regexp will not be handled by
1362 `gnus-subscribe-newsgroup-method'. Instead, they will
1363 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
1323 1364
1324 (defvar gnus-options-not-subscribe nil 1365 (defvar gnus-options-not-subscribe nil
1325 "*All new groups matching this regexp will be ignored. 1366 "*All new groups matching this regexp will be ignored.
1326 Note that this variable deals only with new newsgroups. This variable 1367 Note that this variable deals only with new newsgroups. This variable
1327 does not affect old (already subscribed) newsgroups.") 1368 does not affect old (already subscribed) newsgroups.")
1366 It calls `gnus-summary-expire-articles' by default.") 1407 It calls `gnus-summary-expire-articles' by default.")
1367 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) 1408 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1368 1409
1369 (defvar gnus-summary-exit-hook nil 1410 (defvar gnus-summary-exit-hook nil
1370 "*A hook called on exit from the summary buffer.") 1411 "*A hook called on exit from the summary buffer.")
1412
1413 (defvar gnus-check-bogus-groups-hook nil
1414 "A hook run after removing bogus groups.")
1371 1415
1372 (defvar gnus-group-catchup-group-hook nil 1416 (defvar gnus-group-catchup-group-hook nil
1373 "*A hook run when catching up a group from the group buffer.") 1417 "*A hook run when catching up a group from the group buffer.")
1374 1418
1375 (defvar gnus-group-update-group-hook nil 1419 (defvar gnus-group-update-group-hook nil
1609 (defvar gnus-current-copy-group nil) 1653 (defvar gnus-current-copy-group nil)
1610 (defvar gnus-current-crosspost-group nil) 1654 (defvar gnus-current-crosspost-group nil)
1611 1655
1612 (defvar gnus-newsgroup-dependencies nil) 1656 (defvar gnus-newsgroup-dependencies nil)
1613 (defvar gnus-newsgroup-async nil) 1657 (defvar gnus-newsgroup-async nil)
1614 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") 1658 (defvar gnus-group-edit-buffer nil)
1615 1659
1616 (defvar gnus-newsgroup-adaptive nil) 1660 (defvar gnus-newsgroup-adaptive nil)
1617 1661
1618 (defvar gnus-summary-display-table nil) 1662 (defvar gnus-summary-display-table nil)
1619 (defvar gnus-summary-display-article-function nil) 1663 (defvar gnus-summary-display-article-function nil)
1728 1772
1729 (defconst gnus-maintainer 1773 (defconst gnus-maintainer
1730 "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" 1774 "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1731 "The mail address of the Gnus maintainers.") 1775 "The mail address of the Gnus maintainers.")
1732 1776
1733 (defconst gnus-version-number "5.2.25" 1777 (defconst gnus-version-number "5.2.40"
1734 "Version number for this version of Gnus.") 1778 "Version number for this version of Gnus.")
1735 1779
1736 (defconst gnus-version (format "Gnus v%s" gnus-version-number) 1780 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
1737 "Version string for this version of Gnus.") 1781 "Version string for this version of Gnus.")
1738 1782
1948 (gnus-summary-mark-below . global) 1992 (gnus-summary-mark-below . global)
1949 gnus-newsgroup-active gnus-scores-exclude-files 1993 gnus-newsgroup-active gnus-scores-exclude-files
1950 gnus-newsgroup-history gnus-newsgroup-ancient 1994 gnus-newsgroup-history gnus-newsgroup-ancient
1951 gnus-newsgroup-sparse 1995 gnus-newsgroup-sparse
1952 (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) 1996 (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1953 gnus-newsgroup-adaptive-score-file 1997 gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
1954 (gnus-newsgroup-expunged-tally . 0) 1998 (gnus-newsgroup-expunged-tally . 0)
1955 gnus-cache-removable-articles gnus-newsgroup-cached 1999 gnus-cache-removable-articles gnus-newsgroup-cached
1956 gnus-newsgroup-data gnus-newsgroup-data-reverse 2000 gnus-newsgroup-data gnus-newsgroup-data-reverse
1957 gnus-newsgroup-limit gnus-newsgroup-limits) 2001 gnus-newsgroup-limit gnus-newsgroup-limits)
1958 "Variables that are buffer-local to the summary buffers.") 2002 "Variables that are buffer-local to the summary buffers.")
2011 rmail-show-message) 2055 rmail-show-message)
2012 ("gnus-soup" :interactive t 2056 ("gnus-soup" :interactive t
2013 gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article 2057 gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
2014 gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) 2058 gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
2015 ("nnsoup" nnsoup-pack-replies) 2059 ("nnsoup" nnsoup-pack-replies)
2016 ("gnus-scomo" :interactive t gnus-score-mode) 2060 ("score-mode" :interactive t gnus-score-mode)
2017 ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder 2061 ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
2018 gnus-Folder-save-name gnus-folder-save-name) 2062 gnus-Folder-save-name gnus-folder-save-name)
2019 ("gnus-mh" :interactive t gnus-summary-save-in-folder) 2063 ("gnus-mh" :interactive t gnus-summary-save-in-folder)
2020 ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar 2064 ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
2021 gnus-server-make-menu-bar gnus-article-make-menu-bar 2065 gnus-server-make-menu-bar gnus-article-make-menu-bar
2084 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view 2128 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2085 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view 2129 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2086 gnus-uu-decode-binhex-view) 2130 gnus-uu-decode-binhex-view)
2087 ("gnus-msg" (gnus-summary-send-map keymap) 2131 ("gnus-msg" (gnus-summary-send-map keymap)
2088 gnus-mail-yank-original gnus-mail-send-and-exit 2132 gnus-mail-yank-original gnus-mail-send-and-exit
2089 gnus-article-mail gnus-new-mail gnus-mail-reply) 2133 gnus-article-mail gnus-new-mail gnus-mail-reply
2134 gnus-copy-article-buffer)
2090 ("gnus-msg" :interactive t 2135 ("gnus-msg" :interactive t
2091 gnus-group-post-news gnus-group-mail gnus-summary-post-news 2136 gnus-group-post-news gnus-group-mail gnus-summary-post-news
2092 gnus-summary-followup gnus-summary-followup-with-original 2137 gnus-summary-followup gnus-summary-followup-with-original
2093 gnus-summary-cancel-article gnus-summary-supersede-article 2138 gnus-summary-cancel-article gnus-summary-supersede-article
2094 gnus-post-news gnus-inews-news 2139 gnus-post-news gnus-inews-news
2095 gnus-summary-reply gnus-summary-reply-with-original 2140 gnus-summary-reply gnus-summary-reply-with-original
2096 gnus-summary-mail-forward gnus-summary-mail-other-window 2141 gnus-summary-mail-forward gnus-summary-mail-other-window
2097 gnus-bug) 2142 gnus-bug)
2098 ("gnus-picon" :interactive t gnus-article-display-picons 2143 ("gnus-picon" :interactive t gnus-article-display-picons
2099 gnus-group-display-picons gnus-picons-article-display-x-face) 2144 gnus-group-display-picons gnus-picons-article-display-x-face
2145 gnus-picons-display-x-face)
2100 ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 2146 ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
2101 gnus-grouplens-mode) 2147 gnus-grouplens-mode)
2102 ("smiley" :interactive t gnus-smiley-display) 2148 ("smiley" :interactive t gnus-smiley-display)
2103 ("gnus-vm" gnus-vm-mail-setup) 2149 ("gnus-vm" gnus-vm-mail-setup)
2104 ("gnus-vm" :interactive t gnus-summary-save-in-vm 2150 ("gnus-vm" :interactive t gnus-summary-save-in-vm
3011 (string< before newgroup))))) 3057 (string< before newgroup)))))
3012 ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) 3058 ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
3013 (setq groupkey 3059 (setq groupkey
3014 (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) 3060 (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
3015 (substring groupkey (match-beginning 1) (match-end 1))))) 3061 (substring groupkey (match-beginning 1) (match-end 1)))))
3016 (gnus-subscribe-newsgroup newgroup before)))) 3062 (gnus-subscribe-newsgroup newgroup before))
3063 (kill-buffer (current-buffer))))
3017 3064
3018 (defun gnus-subscribe-interactively (group) 3065 (defun gnus-subscribe-interactively (group)
3019 "Subscribe the new GROUP interactively. 3066 "Subscribe the new GROUP interactively.
3020 It is inserted in hierarchical newsgroup order if subscribed. If not, 3067 It is inserted in hierarchical newsgroup order if subscribed. If not,
3021 it is killed." 3068 it is killed."
3033 3080
3034 (defun gnus-subscribe-newsgroup (newsgroup &optional next) 3081 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
3035 "Subscribe new NEWSGROUP. 3082 "Subscribe new NEWSGROUP.
3036 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made 3083 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
3037 the first newsgroup." 3084 the first newsgroup."
3038 ;; We subscribe the group by changing its level to `subscribed'. 3085 (save-excursion
3039 (gnus-group-change-level 3086 (goto-char (point-min))
3040 newsgroup gnus-level-default-subscribed 3087 ;; We subscribe the group by changing its level to `subscribed'.
3041 gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) 3088 (gnus-group-change-level
3042 (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)) 3089 newsgroup gnus-level-default-subscribed
3090 gnus-level-killed (gnus-gethash (or next "dummy.group")
3091 gnus-newsrc-hashtb))
3092 (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))
3043 3093
3044 ;; For directories 3094 ;; For directories
3045 3095
3046 (defun gnus-newsgroup-directory-form (newsgroup) 3096 (defun gnus-newsgroup-directory-form (newsgroup)
3047 "Make hierarchical directory name from NEWSGROUP name." 3097 "Make hierarchical directory name from NEWSGROUP name."
3065 ;; with dots. 3115 ;; with dots.
3066 (nnheader-replace-chars-in-string group ?/ ?.)) 3116 (nnheader-replace-chars-in-string group ?/ ?.))
3067 3117
3068 (defun gnus-make-directory (dir) 3118 (defun gnus-make-directory (dir)
3069 "Make DIRECTORY recursively." 3119 "Make DIRECTORY recursively."
3120 (unless dir
3121 (error "No directory to make"))
3070 ;; Why don't we use `(make-directory dir 'parents)'? That's just one 3122 ;; Why don't we use `(make-directory dir 'parents)'? That's just one
3071 ;; of the many mysteries of the universe. 3123 ;; of the many mysteries of the universe.
3072 (let* ((dir (expand-file-name dir default-directory)) 3124 (let* ((dir (expand-file-name dir default-directory))
3073 dirs err) 3125 dirs err)
3074 (if (string-match "/$" dir) 3126 (if (string-match "/$" dir)
3210 gnus-newsgroup-headers nil 3262 gnus-newsgroup-headers nil
3211 gnus-newsgroup-name nil 3263 gnus-newsgroup-name nil
3212 gnus-server-alist nil 3264 gnus-server-alist nil
3213 gnus-group-list-mode nil 3265 gnus-group-list-mode nil
3214 gnus-opened-servers nil 3266 gnus-opened-servers nil
3267 gnus-group-mark-positions nil
3268 gnus-newsgroup-data nil
3269 gnus-newsgroup-unreads nil
3270 nnoo-state-alist nil
3215 gnus-current-select-method nil) 3271 gnus-current-select-method nil)
3216 (gnus-shutdown 'gnus) 3272 (gnus-shutdown 'gnus)
3217 ;; Kill the startup file. 3273 ;; Kill the startup file.
3218 (and gnus-current-startup-file 3274 (and gnus-current-startup-file
3219 (get-file-buffer gnus-current-startup-file) 3275 (get-file-buffer gnus-current-startup-file)
3799 ;; shown - the return value has to be the same as the return value 3855 ;; shown - the return value has to be the same as the return value
3800 ;; from `message'. 3856 ;; from `message'.
3801 (apply 'format args))) 3857 (apply 'format args)))
3802 3858
3803 (defun gnus-error (level &rest args) 3859 (defun gnus-error (level &rest args)
3804 "Beep an error if `gnus-verbose' is on LEVEL or less." 3860 "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
3805 (when (<= (floor level) gnus-verbose) 3861 (when (<= (floor level) gnus-verbose)
3806 (apply 'message args) 3862 (apply 'message args)
3807 (ding) 3863 (ding)
3808 (let (duration) 3864 (let (duration)
3809 (when (and (floatp level) 3865 (when (and (floatp level)
4185 "\C-c\C-x" gnus-group-expire-articles 4241 "\C-c\C-x" gnus-group-expire-articles
4186 "\C-c\M-\C-x" gnus-group-expire-all-groups 4242 "\C-c\M-\C-x" gnus-group-expire-all-groups
4187 "V" gnus-version 4243 "V" gnus-version
4188 "s" gnus-group-save-newsrc 4244 "s" gnus-group-save-newsrc
4189 "z" gnus-group-suspend 4245 "z" gnus-group-suspend
4190 "Z" gnus-group-clear-dribble 4246 ; "Z" gnus-group-clear-dribble
4191 "q" gnus-group-exit 4247 "q" gnus-group-exit
4192 "Q" gnus-group-quit 4248 "Q" gnus-group-quit
4193 "?" gnus-group-describe-briefly 4249 "?" gnus-group-describe-briefly
4194 "\C-c\C-i" gnus-info-find-node 4250 "\C-c\C-i" gnus-info-find-node
4195 "\M-e" gnus-group-edit-group-method 4251 "\M-e" gnus-group-edit-group-method
4463 `(lambda () ,(caddr entry))) 4519 `(lambda () ,(caddr entry)))
4464 (byte-compile 'gnus-tmp-func) 4520 (byte-compile 'gnus-tmp-func)
4465 (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) 4521 (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4466 4522
4467 (push (cons 'version emacs-version) gnus-format-specs) 4523 (push (cons 'version emacs-version) gnus-format-specs)
4468 4524 ;; Mark the .newsrc.eld file as "dirty".
4525 (gnus-dribble-enter " ")
4469 (gnus-message 7 "Compiling user specs...done")))) 4526 (gnus-message 7 "Compiling user specs...done"))))
4470 4527
4471 (defun gnus-indent-rigidly (start end arg) 4528 (defun gnus-indent-rigidly (start end arg)
4472 "Indent rigidly using only spaces and no tabs." 4529 "Indent rigidly using only spaces and no tabs."
4473 (save-excursion 4530 (save-excursion
4749 (when (eq backend (caaar opened)) 4806 (when (eq backend (caaar opened))
4750 (push (caar opened) out)) 4807 (push (caar opened) out))
4751 (pop opened)) 4808 (pop opened))
4752 out)) 4809 out))
4753 4810
4811 (defun gnus-archive-server-wanted-p ()
4812 "Say whether the user wants to use the archive server."
4813 (cond
4814 ((or (not gnus-message-archive-method)
4815 (not gnus-message-archive-group))
4816 nil)
4817 ((and gnus-message-archive-method gnus-message-archive-group)
4818 t)
4819 (t
4820 (let ((active (cadr (assq 'nnfolder-active-file
4821 gnus-message-archive-method))))
4822 (and active
4823 (file-exists-p active))))))
4824
4754 (defun gnus-group-prefixed-name (group method) 4825 (defun gnus-group-prefixed-name (group method)
4755 "Return the whole name from GROUP and METHOD." 4826 "Return the whole name from GROUP and METHOD."
4756 (and (stringp method) (setq method (gnus-server-to-method method))) 4827 (and (stringp method) (setq method (gnus-server-to-method method)))
4757 (concat (format "%s" (car method)) 4828 (if (not method)
4758 (if (and 4829 group
4759 (or (assoc (format "%s" (car method)) 4830 (concat (format "%s" (car method))
4760 (gnus-methods-using 'address)) 4831 (if (and
4761 (gnus-server-equal method gnus-message-archive-method)) 4832 (or (assoc (format "%s" (car method))
4762 (nth 1 method) 4833 (gnus-methods-using 'address))
4763 (not (string= (nth 1 method) ""))) 4834 (gnus-server-equal method gnus-message-archive-method))
4764 (concat "+" (nth 1 method))) 4835 (nth 1 method)
4765 ":" group)) 4836 (not (string= (nth 1 method) "")))
4837 (concat "+" (nth 1 method)))
4838 ":" group)))
4766 4839
4767 (defun gnus-group-real-prefix (group) 4840 (defun gnus-group-real-prefix (group)
4768 "Return the prefix of the current group name." 4841 "Return the prefix of the current group name."
4769 (if (string-match "^[^:]+:" group) 4842 (if (string-match "^[^:]+:" group)
4770 (substring group 0 (match-end 0)) 4843 (substring group 0 (match-end 0))
5358 (entry (car entry)) 5431 (entry (car entry))
5359 ((setq active (gnus-active group)) 5432 ((setq active (gnus-active group))
5360 (- (1+ (cdr active)) (car active))))) 5433 (- (1+ (cdr active)) (car active)))))
5361 (gnus-summary-read-group 5434 (gnus-summary-read-group
5362 group (or all (and (numberp number) 5435 group (or all (and (numberp number)
5363 (zerop (+ number (length (cdr (assq 'tick marked))) 5436 (zerop (+ number (gnus-range-length
5364 (length (cdr (assq 'dormant marked))))))) 5437 (cdr (assq 'tick marked)))
5438 (gnus-range-length
5439 (cdr (assq 'dormant marked)))))))
5365 no-article))) 5440 no-article)))
5366 5441
5367 (defun gnus-group-select-group (&optional all) 5442 (defun gnus-group-select-group (&optional all)
5368 "Select this newsgroup. 5443 "Select this newsgroup.
5369 No article is selected automatically. 5444 No article is selected automatically.
5441 (if b 5516 (if b
5442 ;; Either go to the line in the group buffer... 5517 ;; Either go to the line in the group buffer...
5443 (goto-char b) 5518 (goto-char b)
5444 ;; ... or insert the line. 5519 ;; ... or insert the line.
5445 (or 5520 (or
5521 t ;; Don't activate group.
5446 (gnus-active group) 5522 (gnus-active group)
5447 (gnus-activate-group group) 5523 (gnus-activate-group group)
5448 (error "%s error: %s" group (gnus-status-message group))) 5524 (error "%s error: %s" group (gnus-status-message group)))
5449 5525
5450 (gnus-group-update-group group) 5526 (gnus-group-update-group group)
5455 (gnus-group-position-point))) 5531 (gnus-group-position-point)))
5456 5532
5457 (defun gnus-group-goto-group (group) 5533 (defun gnus-group-goto-group (group)
5458 "Goto to newsgroup GROUP." 5534 "Goto to newsgroup GROUP."
5459 (when group 5535 (when group
5460 (let ((b (text-property-any (point-min) (point-max) 5536 ;; It's quite likely that we are on the right line, so
5461 'gnus-group (gnus-intern-safe 5537 ;; we check the current line first.
5462 group gnus-active-hashtb)))) 5538 (beginning-of-line)
5463 (and b (goto-char b))))) 5539 (if (eq (get-text-property (point) 'gnus-group)
5464 5540 (gnus-intern-safe group gnus-active-hashtb))
5465 (defun gnus-group-next-group (n) 5541 (point)
5542 ;; Search through the entire buffer.
5543 (let ((b (text-property-any
5544 (point-min) (point-max)
5545 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5546 (when b
5547 (goto-char b))))))
5548
5549 (defun gnus-group-next-group (n &optional silent)
5466 "Go to next N'th newsgroup. 5550 "Go to next N'th newsgroup.
5467 If N is negative, search backward instead. 5551 If N is negative, search backward instead.
5468 Returns the difference between N and the number of skips actually 5552 Returns the difference between N and the number of skips actually
5469 done." 5553 done."
5470 (interactive "p") 5554 (interactive "p")
5471 (gnus-group-next-unread-group n t)) 5555 (gnus-group-next-unread-group n t nil silent))
5472 5556
5473 (defun gnus-group-next-unread-group (n &optional all level) 5557 (defun gnus-group-next-unread-group (n &optional all level silent)
5474 "Go to next N'th unread newsgroup. 5558 "Go to next N'th unread newsgroup.
5475 If N is negative, search backward instead. 5559 If N is negative, search backward instead.
5476 If ALL is non-nil, choose any newsgroup, unread or not. 5560 If ALL is non-nil, choose any newsgroup, unread or not.
5477 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no 5561 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5478 such group can be found, the next group with a level higher than 5562 such group can be found, the next group with a level higher than
5484 (n (abs n))) 5568 (n (abs n)))
5485 (while (and (> n 0) 5569 (while (and (> n 0)
5486 (gnus-group-search-forward 5570 (gnus-group-search-forward
5487 backward (or (not gnus-group-goto-unread) all) level)) 5571 backward (or (not gnus-group-goto-unread) all) level))
5488 (setq n (1- n))) 5572 (setq n (1- n)))
5489 (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") 5573 (when (and (/= 0 n)
5490 (if level " on this level or higher" ""))) 5574 (not silent))
5575 (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5576 (if level " on this level or higher" "")))
5491 n)) 5577 n))
5492 5578
5493 (defun gnus-group-prev-group (n) 5579 (defun gnus-group-prev-group (n)
5494 "Go to previous N'th newsgroup. 5580 "Go to previous N'th newsgroup.
5495 Returns the difference between N and the number of skips actually 5581 Returns the difference between N and the number of skips actually
5574 (read-string "Group name: ") 5660 (read-string "Group name: ")
5575 (let ((method 5661 (let ((method
5576 (completing-read 5662 (completing-read
5577 "Method: " (append gnus-valid-select-methods gnus-server-alist) 5663 "Method: " (append gnus-valid-select-methods gnus-server-alist)
5578 nil t nil 'gnus-method-history))) 5664 nil t nil 'gnus-method-history)))
5579 (cond ((assoc method gnus-valid-select-methods) 5665 (cond
5580 (list method 5666 ((equal method "")
5581 (if (memq 'prompt-address 5667 (setq method gnus-select-method))
5582 (assoc method gnus-valid-select-methods)) 5668 ((assoc method gnus-valid-select-methods)
5583 (read-string "Address: ") 5669 (list method
5584 ""))) 5670 (if (memq 'prompt-address
5585 ((assoc method gnus-server-alist) 5671 (assoc method gnus-valid-select-methods))
5586 (list method)) 5672 (read-string "Address: ")
5587 (t 5673 "")))
5588 (list method "")))))) 5674 ((assoc method gnus-server-alist)
5589 5675 (list method))
5590 (let* ((meth (and method (if address (list (intern method) address) 5676 (t
5591 method))) 5677 (list method ""))))))
5678
5679 (let* ((meth (when (and method
5680 (not (gnus-server-equal method gnus-select-method)))
5681 (if address (list (intern method) address)
5682 method)))
5592 (nname (if method (gnus-group-prefixed-name name meth) name)) 5683 (nname (if method (gnus-group-prefixed-name name meth) name))
5593 backend info) 5684 backend info)
5594 (when (gnus-gethash nname gnus-newsrc-hashtb) 5685 (when (gnus-gethash nname gnus-newsrc-hashtb)
5595 (error "Group %s already exists" nname)) 5686 (error "Group %s already exists" nname))
5596 ;; Subscribe to the new group. 5687 ;; Subscribe to the new group.
5667 (and (string-match "^[ \t]*$" new-name) 5758 (and (string-match "^[ \t]*$" new-name)
5668 (error "Not a valid group name")) 5759 (error "Not a valid group name"))
5669 5760
5670 ;; We find the proper prefixed name. 5761 ;; We find the proper prefixed name.
5671 (setq new-name 5762 (setq new-name
5672 (gnus-group-prefixed-name 5763 (if (equal (gnus-group-real-name new-name) new-name)
5673 (gnus-group-real-name new-name) 5764 ;; Native group.
5674 (gnus-info-method (gnus-get-info group)))) 5765 new-name
5766 ;; Foreign group.
5767 (gnus-group-prefixed-name
5768 (gnus-group-real-name new-name)
5769 (gnus-info-method (gnus-get-info group)))))
5675 5770
5676 (gnus-message 6 "Renaming group %s to %s..." group new-name) 5771 (gnus-message 6 "Renaming group %s to %s..." group new-name)
5677 (prog1 5772 (prog1
5678 (if (not (gnus-request-rename-group group new-name)) 5773 (if (not (gnus-request-rename-group group new-name))
5679 (gnus-error 3 "Couldn't rename group %s to %s" group new-name) 5774 (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
5700 (winconf (current-window-configuration)) 5795 (winconf (current-window-configuration))
5701 info) 5796 info)
5702 (or group (error "No group on current line")) 5797 (or group (error "No group on current line"))
5703 (or (setq info (gnus-get-info group)) 5798 (or (setq info (gnus-get-info group))
5704 (error "Killed group; can't be edited")) 5799 (error "Killed group; can't be edited"))
5705 (set-buffer (get-buffer-create gnus-group-edit-buffer)) 5800 (set-buffer (setq gnus-group-edit-buffer
5801 (get-buffer-create
5802 (format "*Gnus edit %s*" group))))
5706 (gnus-configure-windows 'edit-group) 5803 (gnus-configure-windows 'edit-group)
5707 (gnus-add-current-to-buffer-list) 5804 (gnus-add-current-to-buffer-list)
5708 (emacs-lisp-mode) 5805 (emacs-lisp-mode)
5709 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. 5806 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5710 (use-local-map (copy-keymap emacs-lisp-mode-map)) 5807 (use-local-map (copy-keymap emacs-lisp-mode-map))
5739 (interactive (list (gnus-group-group-name))) 5836 (interactive (list (gnus-group-group-name)))
5740 (gnus-group-edit-group group 'params)) 5837 (gnus-group-edit-group group 'params))
5741 5838
5742 (defun gnus-group-edit-group-done (part group) 5839 (defun gnus-group-edit-group-done (part group)
5743 "Get info from buffer, update variables and jump to the group buffer." 5840 "Get info from buffer, update variables and jump to the group buffer."
5744 (set-buffer (get-buffer-create gnus-group-edit-buffer)) 5841 (when (and gnus-group-edit-buffer
5745 (goto-char (point-min)) 5842 (buffer-name gnus-group-edit-buffer))
5746 (let* ((form (read (current-buffer))) 5843 (set-buffer gnus-group-edit-buffer)
5747 (winconf gnus-prev-winconf) 5844 (goto-char (point-min))
5748 (method (cond ((eq part 'info) (nth 4 form)) 5845 (let* ((form (read (current-buffer)))
5749 ((eq part 'method) form) 5846 (winconf gnus-prev-winconf)
5847 (method (cond ((eq part 'info) (nth 4 form))
5848 ((eq part 'method) form)
5849 (t nil)))
5850 (info (cond ((eq part 'info) form)
5851 ((eq part 'method) (gnus-get-info group))
5750 (t nil))) 5852 (t nil)))
5751 (info (cond ((eq part 'info) form) 5853 (new-group (if info
5752 ((eq part 'method) (gnus-get-info group)) 5854 (if (or (not method)
5753 (t nil))) 5855 (gnus-server-equal
5754 (new-group (if info 5856 gnus-select-method method))
5755 (if (or (not method) 5857 (gnus-group-real-name (car info))
5756 (gnus-server-equal 5858 (gnus-group-prefixed-name
5757 gnus-select-method method)) 5859 (gnus-group-real-name (car info)) method))
5758 (gnus-group-real-name (car info)) 5860 nil)))
5759 (gnus-group-prefixed-name 5861 (when (and new-group
5760 (gnus-group-real-name (car info)) method)) 5862 (not (equal new-group group)))
5761 nil))) 5863 (when (gnus-group-goto-group group)
5762 (when (and new-group 5864 (gnus-group-kill-group 1))
5763 (not (equal new-group group))) 5865 (gnus-activate-group new-group))
5764 (when (gnus-group-goto-group group) 5866 ;; Set the info.
5765 (gnus-group-kill-group 1)) 5867 (if (and info new-group)
5766 (gnus-activate-group new-group)) 5868 (progn
5767 ;; Set the info. 5869 (setq info (gnus-copy-sequence info))
5768 (if (and info new-group) 5870 (setcar info new-group)
5769 (progn 5871 (unless (gnus-server-equal method "native")
5770 (setq info (gnus-copy-sequence info)) 5872 (unless (nthcdr 3 info)
5771 (setcar info new-group) 5873 (nconc info (list nil nil)))
5772 (unless (gnus-server-equal method "native") 5874 (unless (nthcdr 4 info)
5773 (unless (nthcdr 3 info) 5875 (nconc info (list nil)))
5774 (nconc info (list nil nil))) 5876 (gnus-info-set-method info method))
5775 (unless (nthcdr 4 info) 5877 (gnus-group-set-info info))
5776 (nconc info (list nil))) 5878 (gnus-group-set-info form (or new-group group) part))
5777 (gnus-info-set-method info method)) 5879 (kill-buffer (current-buffer))
5778 (gnus-group-set-info info)) 5880 (and winconf (set-window-configuration winconf))
5779 (gnus-group-set-info form (or new-group group) part)) 5881 (set-buffer gnus-group-buffer)
5780 (kill-buffer (current-buffer)) 5882 (gnus-group-update-group (or new-group group))
5781 (and winconf (set-window-configuration winconf)) 5883 (gnus-group-position-point))))
5782 (set-buffer gnus-group-buffer)
5783 (gnus-group-update-group (or new-group group))
5784 (gnus-group-position-point)))
5785 5884
5786 (defun gnus-group-make-help-group () 5885 (defun gnus-group-make-help-group ()
5787 "Create the Gnus documentation group." 5886 "Create the Gnus documentation group."
5788 (interactive) 5887 (interactive)
5789 (let ((path load-path) 5888 (let ((path load-path)
5843 "Create the (ding) Gnus archive group of the most recent articles. 5942 "Create the (ding) Gnus archive group of the most recent articles.
5844 Given a prefix, create a full group." 5943 Given a prefix, create a full group."
5845 (interactive "P") 5944 (interactive "P")
5846 (let ((group (gnus-group-prefixed-name 5945 (let ((group (gnus-group-prefixed-name
5847 (if all "ding.archives" "ding.recent") '(nndir "")))) 5946 (if all "ding.archives" "ding.recent") '(nndir ""))))
5848 (and (gnus-gethash group gnus-newsrc-hashtb) 5947 (when (gnus-gethash group gnus-newsrc-hashtb)
5849 (error "Archive group already exists")) 5948 (error "Archive group already exists"))
5850 (gnus-group-make-group 5949 (gnus-group-make-group
5851 (gnus-group-real-name group) 5950 (gnus-group-real-name group)
5852 (list 'nndir (if all "hpc" "edu") 5951 (list 'nndir (if all "hpc" "edu")
5853 (list 'nndir-directory 5952 (list 'nndir-directory
5854 (if all gnus-group-archive-directory 5953 (if all gnus-group-archive-directory
5855 gnus-group-recent-archive-directory)))))) 5954 gnus-group-recent-archive-directory))))
5955 (gnus-group-add-parameter group (cons 'to-address "ding@ifi.uio.no"))))
5856 5956
5857 (defun gnus-group-make-directory-group (dir) 5957 (defun gnus-group-make-directory-group (dir)
5858 "Create an nndir group. 5958 "Create an nndir group.
5859 The user will be prompted for a directory. The contents of this 5959 The user will be prompted for a directory. The contents of this
5860 directory will be used as a newsgroup. The directory should contain 5960 directory will be used as a newsgroup. The directory should contain
5873 ext) 5973 ext)
5874 '(nndir ""))) 5974 '(nndir "")))
5875 (setq ext (format "<%d>" (setq i (1+ i))))) 5975 (setq ext (format "<%d>" (setq i (1+ i)))))
5876 (gnus-group-make-group 5976 (gnus-group-make-group
5877 (gnus-group-real-name group) 5977 (gnus-group-real-name group)
5878 (list 'nndir group (list 'nndir-directory dir))))) 5978 (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
5879 5979
5880 (defun gnus-group-make-kiboze-group (group address scores) 5980 (defun gnus-group-make-kiboze-group (group address scores)
5881 "Create an nnkiboze group. 5981 "Create an nnkiboze group.
5882 The user will be prompted for a name, a regexp to match groups, and 5982 The user will be prompted for a name, a regexp to match groups, and
5883 score file entries for articles to include in the group." 5983 score file entries for articles to include in the group."
5939 (gnus-group-position-point))) 6039 (gnus-group-position-point)))
5940 6040
5941 (defun gnus-group-enter-directory (dir) 6041 (defun gnus-group-enter-directory (dir)
5942 "Enter an ephemeral nneething group." 6042 "Enter an ephemeral nneething group."
5943 (interactive "DDirectory to read: ") 6043 (interactive "DDirectory to read: ")
5944 (let* ((method (list 'nneething dir)) 6044 (let* ((method (list 'nneething dir '(nneething-read-only t)))
5945 (leaf (gnus-group-prefixed-name 6045 (leaf (gnus-group-prefixed-name
5946 (file-name-nondirectory (directory-file-name dir)) 6046 (file-name-nondirectory (directory-file-name dir))
5947 method)) 6047 method))
5948 (name (gnus-generate-new-group-name leaf))) 6048 (name (gnus-generate-new-group-name leaf)))
5949 (let ((nneething-read-only t)) 6049 (unless (gnus-group-read-ephemeral-group
5950 (or (gnus-group-read-ephemeral-group 6050 name method t
5951 name method t 6051 (cons (current-buffer)
5952 (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 6052 (if (eq major-mode 'gnus-summary-mode)
5953 'summary 'group))) 6053 'summary 'group)))
5954 (error "Couldn't enter %s" dir))))) 6054 (error "Couldn't enter %s" dir))))
5955 6055
5956 ;; Group sorting commands 6056 ;; Group sorting commands
5957 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. 6057 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5958 6058
5959 (defun gnus-group-sort-groups (func &optional reverse) 6059 (defun gnus-group-sort-groups (func &optional reverse)
6402 "Do you really want to kill all groups on level %d? " 6502 "Do you really want to kill all groups on level %d? "
6403 level)))) 6503 level))))
6404 (let* ((prev gnus-newsrc-alist) 6504 (let* ((prev gnus-newsrc-alist)
6405 (alist (cdr prev))) 6505 (alist (cdr prev)))
6406 (while alist 6506 (while alist
6407 (if (= (gnus-info-level level) level) 6507 (if (= (gnus-info-level (car alist)) level)
6408 (setcdr prev (cdr alist)) 6508 (progn
6509 (push (gnus-info-group (car alist)) gnus-killed-list)
6510 (setcdr prev (cdr alist)))
6409 (setq prev alist)) 6511 (setq prev alist))
6410 (setq alist (cdr alist))) 6512 (setq alist (cdr alist)))
6411 (gnus-make-hashtable-from-newsrc-alist) 6513 (gnus-make-hashtable-from-newsrc-alist)
6412 (gnus-group-list-groups))) 6514 (gnus-group-list-groups)))
6413 (t 6515 (t
6524 (gnus-get-unread-articles-in-group 6626 (gnus-get-unread-articles-in-group
6525 (gnus-get-info group) (gnus-active group) t) 6627 (gnus-get-info group) (gnus-active group) t)
6526 (unless (gnus-virtual-group-p group) 6628 (unless (gnus-virtual-group-p group)
6527 (gnus-close-group group)) 6629 (gnus-close-group group))
6528 (gnus-group-update-group group)) 6630 (gnus-group-update-group group))
6529 (gnus-error 3 "%s error: %s" group (gnus-status-message group)))) 6631 (if (eq (gnus-server-status (gnus-find-method-for-group group))
6632 'denied)
6633 (gnus-error 3 "Server denied access")
6634 (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
6530 (when beg (goto-char beg)) 6635 (when beg (goto-char beg))
6531 (when gnus-goto-next-group-when-activating 6636 (when gnus-goto-next-group-when-activating
6532 (gnus-group-next-unread-group 1 t)) 6637 (gnus-group-next-unread-group 1 t))
6533 (gnus-summary-position-point) 6638 (gnus-summary-position-point)
6534 ret)) 6639 ret))
6556 (find-file file)))) 6661 (find-file file))))
6557 6662
6558 (defun gnus-group-describe-group (force &optional group) 6663 (defun gnus-group-describe-group (force &optional group)
6559 "Display a description of the current newsgroup." 6664 "Display a description of the current newsgroup."
6560 (interactive (list current-prefix-arg (gnus-group-group-name))) 6665 (interactive (list current-prefix-arg (gnus-group-group-name)))
6561 (when (and force 6666 (let* ((method (gnus-find-method-for-group group))
6562 gnus-description-hashtb) 6667 (mname (gnus-group-prefixed-name "" method))
6563 (gnus-sethash group nil gnus-description-hashtb)) 6668 desc)
6564 (let ((method (gnus-find-method-for-group group)) 6669 (when (and force
6565 desc) 6670 gnus-description-hashtb)
6671 (gnus-sethash mname nil gnus-description-hashtb))
6566 (or group (error "No group name given")) 6672 (or group (error "No group name given"))
6567 (and (or (and gnus-description-hashtb 6673 (and (or (and gnus-description-hashtb
6568 ;; We check whether this group's method has been 6674 ;; We check whether this group's method has been
6569 ;; queried for a description file. 6675 ;; queried for a description file.
6570 (gnus-gethash 6676 (gnus-gethash mname gnus-description-hashtb))
6571 (gnus-group-prefixed-name "" method)
6572 gnus-description-hashtb))
6573 (setq desc (gnus-group-get-description group)) 6677 (setq desc (gnus-group-get-description group))
6574 (gnus-read-descriptions-file method)) 6678 (gnus-read-descriptions-file method))
6575 (gnus-message 1 6679 (gnus-message 1
6576 (or desc (gnus-gethash group gnus-description-hashtb) 6680 (or desc (gnus-gethash group gnus-description-hashtb)
6577 "No description available"))))) 6681 "No description available")))))
6598 'gnus-level (1+ gnus-level-subscribed)))) 6702 'gnus-level (1+ gnus-level-subscribed))))
6599 gnus-description-hashtb) 6703 gnus-description-hashtb)
6600 (goto-char (point-min)) 6704 (goto-char (point-min))
6601 (gnus-group-position-point))) 6705 (gnus-group-position-point)))
6602 6706
6603 ;; Suggested by by Daniel Quinlan <quinlan@best.com>. 6707 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
6604 (defun gnus-group-apropos (regexp &optional search-description) 6708 (defun gnus-group-apropos (regexp &optional search-description)
6605 "List all newsgroups that have names that match a regexp." 6709 "List all newsgroups that have names that match a regexp."
6606 (interactive "sGnus apropos (regexp): ") 6710 (interactive "sGnus apropos (regexp): ")
6607 (let ((prev "") 6711 (let ((prev "")
6608 (obuf (current-buffer)) 6712 (obuf (current-buffer))
7106 "h" gnus-article-hide-headers 7210 "h" gnus-article-hide-headers
7107 "b" gnus-article-hide-boring-headers 7211 "b" gnus-article-hide-boring-headers
7108 "s" gnus-article-hide-signature 7212 "s" gnus-article-hide-signature
7109 "c" gnus-article-hide-citation 7213 "c" gnus-article-hide-citation
7110 "p" gnus-article-hide-pgp 7214 "p" gnus-article-hide-pgp
7215 "P" gnus-article-hide-pem
7111 "\C-c" gnus-article-hide-citation-maybe) 7216 "\C-c" gnus-article-hide-citation-maybe)
7112 7217
7113 (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) 7218 (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
7114 "a" gnus-article-highlight 7219 "a" gnus-article-highlight
7115 "h" gnus-article-highlight-headers 7220 "h" gnus-article-highlight-headers
7197 (setq buffer-display-table gnus-summary-display-table) 7302 (setq buffer-display-table gnus-summary-display-table)
7198 (setq gnus-newsgroup-name group) 7303 (setq gnus-newsgroup-name group)
7199 (make-local-variable 'gnus-summary-line-format) 7304 (make-local-variable 'gnus-summary-line-format)
7200 (make-local-variable 'gnus-summary-line-format-spec) 7305 (make-local-variable 'gnus-summary-line-format-spec)
7201 (make-local-variable 'gnus-summary-mark-positions) 7306 (make-local-variable 'gnus-summary-mark-positions)
7307 (gnus-make-local-hook 'post-command-hook)
7308 (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
7202 (run-hooks 'gnus-summary-mode-hook)) 7309 (run-hooks 'gnus-summary-mode-hook))
7203 7310
7204 (defun gnus-summary-make-local-variables () 7311 (defun gnus-summary-make-local-variables ()
7205 "Make all the local summary buffer variables." 7312 "Make all the local summary buffer variables."
7206 (let ((locals gnus-summary-local-variables) 7313 (let ((locals gnus-summary-local-variables)
7550 (data gnus-newsgroup-data) 7657 (data gnus-newsgroup-data)
7551 (summary gnus-summary-buffer) 7658 (summary gnus-summary-buffer)
7552 (article-buffer gnus-article-buffer) 7659 (article-buffer gnus-article-buffer)
7553 (original gnus-original-article-buffer) 7660 (original gnus-original-article-buffer)
7554 (gac gnus-article-current) 7661 (gac gnus-article-current)
7662 (reffed gnus-reffed-article-number)
7555 (score-file gnus-current-score-file)) 7663 (score-file gnus-current-score-file))
7556 (save-excursion 7664 (save-excursion
7557 (set-buffer gnus-group-buffer) 7665 (set-buffer gnus-group-buffer)
7558 (setq gnus-newsgroup-name name) 7666 (setq gnus-newsgroup-name name)
7559 (setq gnus-newsgroup-marked marked) 7667 (setq gnus-newsgroup-marked marked)
7562 (setq gnus-newsgroup-data data) 7670 (setq gnus-newsgroup-data data)
7563 (setq gnus-article-current gac) 7671 (setq gnus-article-current gac)
7564 (setq gnus-summary-buffer summary) 7672 (setq gnus-summary-buffer summary)
7565 (setq gnus-article-buffer article-buffer) 7673 (setq gnus-article-buffer article-buffer)
7566 (setq gnus-original-article-buffer original) 7674 (setq gnus-original-article-buffer original)
7675 (setq gnus-reffed-article-number reffed)
7567 (setq gnus-current-score-file score-file))))) 7676 (setq gnus-current-score-file score-file)))))
7568 7677
7569 (defun gnus-summary-last-article-p (&optional article) 7678 (defun gnus-summary-last-article-p (&optional article)
7570 "Return whether ARTICLE is the last article in the buffer." 7679 "Return whether ARTICLE is the last article in the buffer."
7571 (if (not (setq article (or article (gnus-summary-article-number)))) 7680 (if (not (setq article (or article (gnus-summary-article-number))))
7813 (when (and (zerop (buffer-size)) 7922 (when (and (zerop (buffer-size))
7814 (not no-display)) 7923 (not no-display))
7815 (cond (gnus-newsgroup-dormant 7924 (cond (gnus-newsgroup-dormant
7816 (gnus-summary-limit-include-dormant)) 7925 (gnus-summary-limit-include-dormant))
7817 ((and gnus-newsgroup-scored show-all) 7926 ((and gnus-newsgroup-scored show-all)
7818 (gnus-summary-limit-include-expunged)))) 7927 (gnus-summary-limit-include-expunged t))))
7819 ;; Function `gnus-apply-kill-file' must be called in this hook. 7928 ;; Function `gnus-apply-kill-file' must be called in this hook.
7820 (run-hooks 'gnus-apply-kill-hook) 7929 (run-hooks 'gnus-apply-kill-hook)
7821 (if (and (zerop (buffer-size)) 7930 (if (and (zerop (buffer-size))
7822 (not no-display)) 7931 (not no-display))
7823 (progn 7932 (progn
8243 (let ((threads gnus-newsgroup-threads) 8352 (let ((threads gnus-newsgroup-threads)
8244 sub) 8353 sub)
8245 (while threads 8354 (while threads
8246 (setq sub (car threads)) 8355 (setq sub (car threads))
8247 (if (stringp (car sub)) 8356 (if (stringp (car sub))
8248 ;; This is a gathered threads, so we look at the roots 8357 ;; This is a gathered thread, so we look at the roots
8249 ;; below it to find whether this article in in this 8358 ;; below it to find whether this article is in this
8250 ;; gathered root. 8359 ;; gathered root.
8251 (progn 8360 (progn
8252 (setq sub (cdr sub)) 8361 (setq sub (cdr sub))
8253 (while sub 8362 (while sub
8254 (when (member (caar sub) headers) 8363 (when (member (caar sub) headers)
8424 8533
8425 (defun gnus-thread-total-score-1 (root) 8534 (defun gnus-thread-total-score-1 (root)
8426 ;; This function find the total score of the thread below ROOT. 8535 ;; This function find the total score of the thread below ROOT.
8427 (setq root (car root)) 8536 (setq root (car root))
8428 (apply gnus-thread-score-function 8537 (apply gnus-thread-score-function
8429 (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored)) 8538 (or (append
8430 gnus-summary-default-score 0) 8539 (mapcar 'gnus-thread-total-score
8431 (mapcar 'gnus-thread-total-score 8540 (cdr (gnus-gethash (mail-header-id root)
8432 (cdr (gnus-gethash (mail-header-id root) 8541 gnus-newsgroup-dependencies)))
8433 gnus-newsgroup-dependencies))))) 8542 (if (> (mail-header-number root) 0)
8543 (list (or (cdr (assq (mail-header-number root)
8544 gnus-newsgroup-scored))
8545 gnus-summary-default-score 0))))
8546 (list gnus-summary-default-score)
8547 '(0))))
8434 8548
8435 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. 8549 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
8436 (defvar gnus-tmp-prev-subject nil) 8550 (defvar gnus-tmp-prev-subject nil)
8437 (defvar gnus-tmp-false-parent nil) 8551 (defvar gnus-tmp-false-parent nil)
8438 (defvar gnus-tmp-root-expunged nil) 8552 (defvar gnus-tmp-root-expunged nil)
8839 (setq gnus-newsgroup-begin 8953 (setq gnus-newsgroup-begin
8840 (mail-header-number (car gnus-newsgroup-headers)) 8954 (mail-header-number (car gnus-newsgroup-headers))
8841 gnus-newsgroup-end 8955 gnus-newsgroup-end
8842 (mail-header-number 8956 (mail-header-number
8843 (gnus-last-element gnus-newsgroup-headers)))) 8957 (gnus-last-element gnus-newsgroup-headers))))
8844 (setq gnus-reffed-article-number -1)
8845 ;; GROUP is successfully selected. 8958 ;; GROUP is successfully selected.
8846 (or gnus-newsgroup-headers t))))) 8959 (or gnus-newsgroup-headers t)))))
8847 8960
8848 (defun gnus-articles-to-read (group read-all) 8961 (defun gnus-articles-to-read (group read-all)
8849 ;; Find out what articles the user wants to read. 8962 ;; Find out what articles the user wants to read.
8934 (let* ((marked-lists (gnus-info-marks info)) 9047 (let* ((marked-lists (gnus-info-marks info))
8935 (active (gnus-active (gnus-info-group info))) 9048 (active (gnus-active (gnus-info-group info)))
8936 (min (car active)) 9049 (min (car active))
8937 (max (cdr active)) 9050 (max (cdr active))
8938 (types gnus-article-mark-lists) 9051 (types gnus-article-mark-lists)
8939 (uncompressed '(score bookmark)) 9052 (uncompressed '(score bookmark killed))
8940 marks var articles article mark) 9053 marks var articles article mark)
8941 9054
8942 (while marked-lists 9055 (while marked-lists
8943 (setq marks (pop marked-lists)) 9056 (setq marks (pop marked-lists))
8944 (set (setq var (intern (format "gnus-newsgroup-%s" 9057 (set (setq var (intern (format "gnus-newsgroup-%s"
8950 (setq articles (symbol-value var)) 9063 (setq articles (symbol-value var))
8951 9064
8952 ;; All articles have to be subsets of the active articles. 9065 ;; All articles have to be subsets of the active articles.
8953 (cond 9066 (cond
8954 ;; Adjust "simple" lists. 9067 ;; Adjust "simple" lists.
8955 ((memq mark '(tick dormant expirable reply killed save)) 9068 ((memq mark '(tick dormant expirable reply save))
8956 (while articles 9069 (while articles
8957 (when (or (< (setq article (pop articles)) min) (> article max)) 9070 (when (or (< (setq article (pop articles)) min) (> article max))
8958 (set var (delq article (symbol-value var)))))) 9071 (set var (delq article (symbol-value var))))))
8959 ;; Adjust assocs. 9072 ;; Adjust assocs.
8960 ((memq mark '(score bookmark)) 9073 ((memq mark uncompressed)
8961 (while articles 9074 (while articles
8962 (when (or (not (consp (setq article (pop articles)))) 9075 (when (or (not (consp (setq article (pop articles))))
8963 (< (car article) min) 9076 (< (car article) min)
8964 (> (car article) max)) 9077 (> (car article) max))
8965 (set var (delq article (symbol-value var)))))))))) 9078 (set var (delq article (symbol-value var))))))))))
9161 (entry (gnus-gethash group gnus-newsrc-hashtb)) 9274 (entry (gnus-gethash group gnus-newsrc-hashtb))
9162 (info (nth 2 entry)) 9275 (info (nth 2 entry))
9163 (active (gnus-active group)) 9276 (active (gnus-active group))
9164 range) 9277 range)
9165 ;; First peel off all illegal article numbers. 9278 ;; First peel off all illegal article numbers.
9166 (if active 9279 (when active
9167 (let ((ids articles) 9280 (let ((ids articles)
9168 id first) 9281 id first)
9169 (while ids 9282 (while (setq id (pop ids))
9170 (setq id (car ids)) 9283 (when (and first (> id (cdr active)))
9171 (if (and first (> id (cdr active))) 9284 ;; We'll end up in this situation in one particular
9172 (progn 9285 ;; obscure situation. If you re-scan a group and get
9173 ;; We'll end up in this situation in one particular 9286 ;; a new article that is cross-posted to a different
9174 ;; obscure situation. If you re-scan a group and get 9287 ;; group that has not been re-scanned, you might get
9175 ;; a new article that is cross-posted to a different 9288 ;; crossposted article that has a higher number than
9176 ;; group that has not been re-scanned, you might get 9289 ;; Gnus believes possible. So we re-activate this
9177 ;; crossposted article that has a higher number than 9290 ;; group as well. This might mean doing the
9178 ;; Gnus believes possible. So we re-activate this 9291 ;; crossposting thingy will *increase* the number
9179 ;; group as well. This might mean doing the 9292 ;; of articles in some groups. Tsk, tsk.
9180 ;; crossposting thingy will *increase* the number 9293 (setq active (or (gnus-activate-group group) active)))
9181 ;; of articles in some groups. Tsk, tsk. 9294 (when (or (> id (cdr active))
9182 (setq active (or (gnus-activate-group group) active))))
9183 (if (or (> id (cdr active))
9184 (< id (car active))) 9295 (< id (car active)))
9185 (setq articles (delq id articles))) 9296 (setq articles (delq id articles))))))
9186 (setq ids (cdr ids)))))
9187 ;; If the read list is nil, we init it. 9297 ;; If the read list is nil, we init it.
9188 (and active 9298 (and active
9189 (null (gnus-info-read info)) 9299 (null (gnus-info-read info))
9190 (> (car active) 1) 9300 (> (car active) 1)
9191 (gnus-info-set-read info (cons 1 (1- (car active))))) 9301 (gnus-info-set-read info (cons 1 (1- (car active)))))
10398 (eq (gnus-summary-article-mark) gnus-canceled-mark))) 10508 (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10399 (gnus-summary-position-point)) 10509 (gnus-summary-position-point))
10400 ;; If not, we try the first unread, if that is wanted. 10510 ;; If not, we try the first unread, if that is wanted.
10401 ((and subject 10511 ((and subject
10402 gnus-auto-select-same 10512 gnus-auto-select-same
10403 (or (gnus-summary-first-unread-article) 10513 (gnus-summary-first-unread-article))
10404 (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10405 (gnus-summary-position-point) 10514 (gnus-summary-position-point)
10406 (gnus-message 6 "Wrapped")) 10515 (gnus-message 6 "Wrapped"))
10407 ;; Try to get next/previous article not displayed in this group. 10516 ;; Try to get next/previous article not displayed in this group.
10408 ((and gnus-auto-extend-newsgroup 10517 ((and gnus-auto-extend-newsgroup
10409 (not unread) (not subject)) 10518 (not unread) (not subject))
10870 (cons gnus-newsgroup-limit gnus-newsgroup-limits))) 10979 (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10871 ;; Set the limit. 10980 ;; Set the limit.
10872 (setq gnus-newsgroup-limit articles) 10981 (setq gnus-newsgroup-limit articles)
10873 (let ((total (length gnus-newsgroup-data)) 10982 (let ((total (length gnus-newsgroup-data))
10874 (data (gnus-data-find-list (gnus-summary-article-number))) 10983 (data (gnus-data-find-list (gnus-summary-article-number)))
10984 (gnus-summary-mark-below nil) ; Inhibit this.
10875 found) 10985 found)
10876 ;; This will do all the work of generating the new summary buffer 10986 ;; This will do all the work of generating the new summary buffer
10877 ;; according to the new limit. 10987 ;; according to the new limit.
10878 (gnus-summary-prepare) 10988 (gnus-summary-prepare)
10879 ;; Hide any threads, possibly. 10989 ;; Hide any threads, possibly.
11184 (interactive "P") 11294 (interactive "P")
11185 (gnus-set-global-variables) 11295 (gnus-set-global-variables)
11186 (gnus-summary-select-article) 11296 (gnus-summary-select-article)
11187 (gnus-configure-windows 'article) 11297 (gnus-configure-windows 'article)
11188 (gnus-eval-in-buffer-window gnus-article-buffer 11298 (gnus-eval-in-buffer-window gnus-article-buffer
11189 (goto-char (point-min)) 11299 ;;(goto-char (point-min))
11190 (isearch-forward regexp-p))) 11300 (isearch-forward regexp-p)))
11191 11301
11192 (defun gnus-summary-search-article-forward (regexp &optional backward) 11302 (defun gnus-summary-search-article-forward (regexp &optional backward)
11193 "Search for an article containing REGEXP forward. 11303 "Search for an article containing REGEXP forward.
11194 If BACKWARD, search backward instead." 11304 If BACKWARD, search backward instead."
11838 (defun gnus-summary-edit-article-done () 11948 (defun gnus-summary-edit-article-done ()
11839 "Make edits to the current article permanent." 11949 "Make edits to the current article permanent."
11840 (interactive) 11950 (interactive)
11841 (if (gnus-group-read-only-p) 11951 (if (gnus-group-read-only-p)
11842 (progn 11952 (progn
11843 (gnus-summary-edit-article-postpone) 11953 (let ((beep (not (eq major-mode 'text-mode))))
11844 (gnus-error 11954 (gnus-summary-edit-article-postpone)
11845 1 "The current newsgroup does not support article editing.")) 11955 (when beep
11956 (gnus-error
11957 3 "The current newsgroup does not support article editing."))))
11846 (let ((buf (format "%s" (buffer-string)))) 11958 (let ((buf (format "%s" (buffer-string))))
11847 (erase-buffer) 11959 (erase-buffer)
11848 (insert buf) 11960 (insert buf)
11849 (if (not (gnus-request-replace-article 11961 (if (not (gnus-request-replace-article
11850 (cdr gnus-article-current) (car gnus-article-current) 11962 (cdr gnus-article-current) (car gnus-article-current)
12440 t) 12552 t)
12441 (gnus-summary-find-next))))) 12553 (gnus-summary-find-next)))))
12442 12554
12443 ;; Suggested by Daniel Quinlan <quinlan@best.com>. 12555 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
12444 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) 12556 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
12445 (defun gnus-summary-limit-include-expunged () 12557 (defun gnus-summary-limit-include-expunged (&optional no-error)
12446 "Display all the hidden articles that were expunged for low scores." 12558 "Display all the hidden articles that were expunged for low scores."
12447 (interactive) 12559 (interactive)
12448 (gnus-set-global-variables) 12560 (gnus-set-global-variables)
12449 (let ((buffer-read-only nil)) 12561 (let ((buffer-read-only nil))
12450 (let ((scored gnus-newsgroup-scored) 12562 (let ((scored gnus-newsgroup-scored)
12453 (or (gnus-summary-goto-subject (caar scored)) 12565 (or (gnus-summary-goto-subject (caar scored))
12454 (and (setq h (gnus-summary-article-header (caar scored))) 12566 (and (setq h (gnus-summary-article-header (caar scored)))
12455 (< (cdar scored) gnus-summary-expunge-below) 12567 (< (cdar scored) gnus-summary-expunge-below)
12456 (setq headers (cons h headers)))) 12568 (setq headers (cons h headers))))
12457 (setq scored (cdr scored))) 12569 (setq scored (cdr scored)))
12458 (or headers (error "No expunged articles hidden.")) 12570 (if (not headers)
12459 (goto-char (point-min)) 12571 (when (not no-error)
12460 (gnus-summary-prepare-unthreaded (nreverse headers))) 12572 (error "No expunged articles hidden."))
12461 (goto-char (point-min)) 12573 (goto-char (point-min))
12462 (gnus-summary-position-point))) 12574 (gnus-summary-prepare-unthreaded (nreverse headers))
12575 (goto-char (point-min))
12576 (gnus-summary-position-point)
12577 t))))
12463 12578
12464 (defun gnus-summary-catchup (&optional all quietly to-here not-mark) 12579 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
12465 "Mark all articles not marked as unread in this newsgroup as read. 12580 "Mark all articles not marked as unread in this newsgroup as read.
12466 If prefix argument ALL is non-nil, all articles are marked as read. 12581 If prefix argument ALL is non-nil, all articles are marked as read.
12467 If QUIETLY is non-nil, no questions will be asked. 12582 If QUIETLY is non-nil, no questions will be asked.
12657 (setq gnus-show-threads 12772 (setq gnus-show-threads
12658 (if (null arg) (not gnus-show-threads) 12773 (if (null arg) (not gnus-show-threads)
12659 (> (prefix-numeric-value arg) 0))) 12774 (> (prefix-numeric-value arg) 0)))
12660 (gnus-summary-prepare) 12775 (gnus-summary-prepare)
12661 (gnus-summary-goto-subject current) 12776 (gnus-summary-goto-subject current)
12777 (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
12662 (gnus-summary-position-point))) 12778 (gnus-summary-position-point)))
12663 12779
12664 (defun gnus-summary-show-all-threads () 12780 (defun gnus-summary-show-all-threads ()
12665 "Show all threads." 12781 "Show all threads."
12666 (interactive) 12782 (interactive)
13193 (read-file-name 13309 (read-file-name
13194 (concat prompt " (`M-p' for defaults) ") 13310 (concat prompt " (`M-p' for defaults) ")
13195 gnus-article-save-directory 13311 gnus-article-save-directory
13196 (car split-name)))) 13312 (car split-name))))
13197 (car (push result file-name-history))))))) 13313 (car (push result file-name-history)))))))
13314 ;; Create the directory.
13315 (unless (equal (directory-file-name file) file)
13316 (make-directory (file-name-directory file) t))
13198 ;; If we have read a directory, we append the default file name. 13317 ;; If we have read a directory, we append the default file name.
13199 (when (file-directory-p file) 13318 (when (file-directory-p file)
13200 (setq file (concat (file-name-as-directory file) 13319 (setq file (concat (file-name-as-directory file)
13201 (file-name-nondirectory default-name)))) 13320 (file-name-nondirectory default-name))))
13202 ;; Possibly translate some charaters. 13321 ;; Possibly translate some characters.
13203 (nnheader-translate-file-chars file))) 13322 (nnheader-translate-file-chars file)))
13204 13323
13205 (defun gnus-article-archive-name (group) 13324 (defun gnus-article-archive-name (group)
13206 "Return the first instance of an \"Archive-name\" in the current buffer." 13325 "Return the first instance of an \"Archive-name\" in the current buffer."
13207 (let ((case-fold-search t)) 13326 (let ((case-fold-search t))
13208 (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) 13327 (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
13209 (match-string 1)))) 13328 (nnheader-concat gnus-article-save-directory
13329 (match-string 1)))))
13210 13330
13211 (defun gnus-summary-save-in-rmail (&optional filename) 13331 (defun gnus-summary-save-in-rmail (&optional filename)
13212 "Append this article to Rmail file. 13332 "Append this article to Rmail file.
13213 Optional argument FILENAME specifies file name. 13333 Optional argument FILENAME specifies file name.
13214 Directory to save to is default to `gnus-article-save-directory'." 13334 Directory to save to is default to `gnus-article-save-directory'."
13479 "\r" gnus-article-press-button 13599 "\r" gnus-article-press-button
13480 "\t" gnus-article-next-button 13600 "\t" gnus-article-next-button
13481 "\M-\t" gnus-article-prev-button 13601 "\M-\t" gnus-article-prev-button
13482 "<" beginning-of-buffer 13602 "<" beginning-of-buffer
13483 ">" end-of-buffer 13603 ">" end-of-buffer
13604 "\C-c\C-i" gnus-info-find-node
13484 "\C-c\C-b" gnus-bug) 13605 "\C-c\C-b" gnus-bug)
13485 13606
13486 (substitute-key-definition 13607 (substitute-key-definition
13487 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) 13608 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
13488 13609
13541 ;; Init original article buffer. 13662 ;; Init original article buffer.
13542 (save-excursion 13663 (save-excursion
13543 (set-buffer (get-buffer-create gnus-original-article-buffer)) 13664 (set-buffer (get-buffer-create gnus-original-article-buffer))
13544 (buffer-disable-undo (current-buffer)) 13665 (buffer-disable-undo (current-buffer))
13545 (setq major-mode 'gnus-original-article-mode) 13666 (setq major-mode 'gnus-original-article-mode)
13667 (gnus-add-current-to-buffer-list)
13546 (make-local-variable 'gnus-original-article)) 13668 (make-local-variable 'gnus-original-article))
13547 (if (get-buffer name) 13669 (if (get-buffer name)
13548 (save-excursion 13670 (save-excursion
13549 (set-buffer name) 13671 (set-buffer name)
13550 (buffer-disable-undo (current-buffer)) 13672 (buffer-disable-undo (current-buffer))
14192 (save-restriction 14314 (save-restriction
14193 (narrow-to-region 14315 (narrow-to-region
14194 (goto-char (point-min)) 14316 (goto-char (point-min))
14195 (or (search-forward "\n\n" nil t) (point-max))) 14317 (or (search-forward "\n\n" nil t) (point-max)))
14196 14318
14319 (goto-char (point-min))
14197 (while (re-search-forward 14320 (while (re-search-forward
14198 "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) 14321 "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
14199 (setq string (match-string 1)) 14322 (setq string (match-string 1))
14200 (narrow-to-region (match-beginning 0) (match-end 0)) 14323 (narrow-to-region (match-beginning 0) (match-end 0))
14201 (delete-region (point-min) (point-max)) 14324 (delete-region (point-min) (point-max))
14275 (narrow-to-region beg end) 14398 (narrow-to-region beg end)
14276 (goto-char (point-min)) 14399 (goto-char (point-min))
14277 (while (re-search-forward "^- " nil t) 14400 (while (re-search-forward "^- " nil t)
14278 (gnus-hide-text (match-beginning 0) (match-end 0) props)) 14401 (gnus-hide-text (match-beginning 0) (match-end 0) props))
14279 (widen)))))) 14402 (widen))))))
14403
14404 (defun gnus-article-hide-pem (&optional arg)
14405 "Toggle hiding of any PEM headers and signatures in the current article.
14406 If given a negative prefix, always show; if given a positive prefix,
14407 always hide."
14408 (interactive (gnus-hidden-arg))
14409 (unless (gnus-article-check-hidden-text 'pem arg)
14410 (save-excursion
14411 (set-buffer gnus-article-buffer)
14412 (let ((props (nconc (list 'gnus-type 'pem) gnus-hidden-properties))
14413 buffer-read-only end)
14414 (widen)
14415 (goto-char (point-min))
14416 ;; hide the horrendously ugly "header".
14417 (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
14418 nil
14419 t)
14420 (setq end (1+ (match-beginning 0)))
14421 (gnus-hide-text
14422 end
14423 (if (search-forward "\n\n" nil t)
14424 (match-end 0)
14425 (point-max))
14426 props))
14427 ;; hide the trailer as well
14428 (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
14429 nil
14430 t)
14431 (gnus-hide-text (match-beginning 0) (match-end 0) props))))))
14280 14432
14281 (defun gnus-article-hide-signature (&optional arg) 14433 (defun gnus-article-hide-signature (&optional arg)
14282 "Hide the signature in the current article. 14434 "Hide the signature in the current article.
14283 If given a negative prefix, always show; if given a positive prefix, 14435 If given a negative prefix, always show; if given a positive prefix,
14284 always hide." 14436 always hide."
14727 14879
14728 (defun gnus-article-describe-briefly () 14880 (defun gnus-article-describe-briefly ()
14729 "Describe article mode commands briefly." 14881 "Describe article mode commands briefly."
14730 (interactive) 14882 (interactive)
14731 (gnus-message 6 14883 (gnus-message 6
14732 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) 14884 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
14733 14885
14734 (defun gnus-article-summary-command () 14886 (defun gnus-article-summary-command ()
14735 "Execute the last keystroke in the summary buffer." 14887 "Execute the last keystroke in the summary buffer."
14736 (interactive) 14888 (interactive)
14737 (let ((obuf (current-buffer)) 14889 (let ((obuf (current-buffer))
14757 (interactive "P") 14909 (interactive "P")
14758 (let ((nosaves 14910 (let ((nosaves
14759 '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" 14911 '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
14760 "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" 14912 "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
14761 "=" "^" "\M-^" "|")) 14913 "=" "^" "\M-^" "|"))
14914 (nosave-but-article
14915 '("A\r"))
14762 keys) 14916 keys)
14763 (save-excursion 14917 (save-excursion
14764 (set-buffer gnus-summary-buffer) 14918 (set-buffer gnus-summary-buffer)
14765 (push (or key last-command-event) unread-command-events) 14919 (push (or key last-command-event) unread-command-events)
14766 (setq keys (read-key-sequence nil))) 14920 (setq keys (read-key-sequence nil)))
14767 (message "") 14921 (message "")
14768 14922
14769 (if (member keys nosaves) 14923 (if (or (member keys nosaves)
14924 (member keys nosave-but-article))
14770 (let (func) 14925 (let (func)
14771 (pop-to-buffer gnus-summary-buffer 'norecord) 14926 (save-window-excursion
14772 (if (setq func (lookup-key (current-local-map) keys)) 14927 (pop-to-buffer gnus-summary-buffer 'norecord)
14773 (call-interactively func) 14928 (setq func (lookup-key (current-local-map) keys)))
14774 (ding))) 14929 (if (not func)
14930 (ding)
14931 (set-buffer gnus-summary-buffer)
14932 (call-interactively func))
14933 (when (member keys nosave-but-article)
14934 (pop-to-buffer gnus-article-buffer 'norecord)))
14775 (let ((obuf (current-buffer)) 14935 (let ((obuf (current-buffer))
14776 (owin (current-window-configuration)) 14936 (owin (current-window-configuration))
14777 (opoint (point)) 14937 (opoint (point))
14778 func in-buffer) 14938 func in-buffer)
14779 (if not-restore-window 14939 (if not-restore-window
14904 (buffer-name gnus-dribble-buffer)) 15064 (buffer-name gnus-dribble-buffer))
14905 (let ((obuf (current-buffer))) 15065 (let ((obuf (current-buffer)))
14906 (set-buffer gnus-dribble-buffer) 15066 (set-buffer gnus-dribble-buffer)
14907 (insert string "\n") 15067 (insert string "\n")
14908 (set-window-point (get-buffer-window (current-buffer)) (point-max)) 15068 (set-window-point (get-buffer-window (current-buffer)) (point-max))
15069 (bury-buffer gnus-dribble-buffer)
14909 (set-buffer obuf)))) 15070 (set-buffer obuf))))
14910 15071
14911 (defun gnus-dribble-read-file () 15072 (defun gnus-dribble-read-file ()
14912 "Read the dribble file from disk." 15073 "Read the dribble file from disk."
14913 (let ((dribble-file (gnus-dribble-file-name))) 15074 (let ((dribble-file (gnus-dribble-file-name)))
15363 (if (equal (car method) "native") gnus-select-method 15524 (if (equal (car method) "native") gnus-select-method
15364 (cdr (assoc (car method) gnus-server-alist)))))) 15525 (cdr (assoc (car method) gnus-server-alist))))))
15365 (setcar (cdr entry) (concat (nth 1 entry) "+" group)) 15526 (setcar (cdr entry) (concat (nth 1 entry) "+" group))
15366 (nconc entry (cdr method)))) 15527 (nconc entry (cdr method))))
15367 15528
15529 (defun gnus-server-status (method)
15530 "Return the status of METHOD."
15531 (nth 1 (assoc method gnus-opened-servers)))
15532
15368 (defun gnus-group-name-to-method (group) 15533 (defun gnus-group-name-to-method (group)
15369 "Return a select method suitable for GROUP." 15534 "Return a select method suitable for GROUP."
15370 (if (string-match ":" group) 15535 (if (string-match ":" group)
15371 (let ((server (substring group 0 (match-beginning 0)))) 15536 (let ((server (substring group 0 (match-beginning 0))))
15372 (if (string-match "\\+" server) 15537 (if (string-match "\\+" server)
15433 gnus-active-hashtb nil) 15598 gnus-active-hashtb nil)
15434 ;; Read the newsrc file and create `gnus-newsrc-hashtb'. 15599 ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
15435 (gnus-read-newsrc-file rawfile)) 15600 (gnus-read-newsrc-file rawfile))
15436 15601
15437 (when (and (not (assoc "archive" gnus-server-alist)) 15602 (when (and (not (assoc "archive" gnus-server-alist))
15438 gnus-message-archive-method) 15603 (gnus-archive-server-wanted-p))
15439 (push (cons "archive" gnus-message-archive-method) 15604 (push (cons "archive" gnus-message-archive-method)
15440 gnus-server-alist)) 15605 gnus-server-alist))
15441 15606
15442 ;; If we don't read the complete active file, we fill in the 15607 ;; If we don't read the complete active file, we fill in the
15443 ;; hashtb here. 15608 ;; hashtb here.
15583 15748
15584 (defun gnus-ask-server-for-new-groups () 15749 (defun gnus-ask-server-for-new-groups ()
15585 (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) 15750 (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
15586 (methods (cons gnus-select-method 15751 (methods (cons gnus-select-method
15587 (nconc 15752 (nconc
15588 (when gnus-message-archive-method 15753 (when (gnus-archive-server-wanted-p)
15589 (list "archive")) 15754 (list "archive"))
15590 (append 15755 (append
15591 (and (consp gnus-check-new-newsgroups) 15756 (and (consp gnus-check-new-newsgroups)
15592 gnus-check-new-newsgroups) 15757 gnus-check-new-newsgroups)
15593 gnus-secondary-select-methods)))) 15758 gnus-secondary-select-methods))))
15846 (when (setq entry (gnus-gethash (setq group (pop bogus)) 16011 (when (setq entry (gnus-gethash (setq group (pop bogus))
15847 gnus-newsrc-hashtb)) 16012 gnus-newsrc-hashtb))
15848 (gnus-group-change-level entry gnus-level-killed) 16013 (gnus-group-change-level entry gnus-level-killed)
15849 (setq gnus-killed-list (delete group gnus-killed-list)))) 16014 (setq gnus-killed-list (delete group gnus-killed-list))))
15850 ;; Then we remove all bogus groups from the list of killed and 16015 ;; Then we remove all bogus groups from the list of killed and
15851 ;; zombie groups. They are are removed without confirmation. 16016 ;; zombie groups. They are removed without confirmation.
15852 (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) 16017 (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
15853 killed) 16018 killed)
15854 (while dead-lists 16019 (while dead-lists
15855 (setq killed (symbol-value (car dead-lists))) 16020 (setq killed (symbol-value (car dead-lists)))
15856 (while killed 16021 (while killed
15858 ;; The group is bogus. 16023 ;; The group is bogus.
15859 ;; !!!Slow as hell. 16024 ;; !!!Slow as hell.
15860 (set (car dead-lists) 16025 (set (car dead-lists)
15861 (delete group (symbol-value (car dead-lists)))))) 16026 (delete group (symbol-value (car dead-lists))))))
15862 (setq dead-lists (cdr dead-lists)))) 16027 (setq dead-lists (cdr dead-lists))))
16028 (run-hooks 'gnus-check-bogus-groups-hook)
15863 (gnus-message 5 "Checking bogus newsgroups...done")))) 16029 (gnus-message 5 "Checking bogus newsgroups...done"))))
15864 16030
15865 (defun gnus-check-duplicate-killed-groups () 16031 (defun gnus-check-duplicate-killed-groups ()
15866 "Remove duplicates from the list of killed groups." 16032 "Remove duplicates from the list of killed groups."
15867 (interactive) 16033 (interactive)
15872 (setq killed (cdr killed))))) 16038 (setq killed (cdr killed)))))
15873 16039
15874 ;; We want to inline a function from gnus-cache, so we cheat here: 16040 ;; We want to inline a function from gnus-cache, so we cheat here:
15875 (eval-when-compile 16041 (eval-when-compile
15876 (provide 'gnus) 16042 (provide 'gnus)
16043 (setq gnus-directory (or (getenv "SAVEDIR") "~/News/"))
15877 (require 'gnus-cache)) 16044 (require 'gnus-cache))
15878 16045
15879 (defun gnus-get-unread-articles-in-group (info active &optional update) 16046 (defun gnus-get-unread-articles-in-group (info active &optional update)
15880 (when active 16047 (when active
15881 ;; Allow the backend to update the info in the group. 16048 ;; Allow the backend to update the info in the group.
16146 (gnus-sethash (car killed) nil hashtb) 16313 (gnus-sethash (car killed) nil hashtb)
16147 (setq killed (cdr killed))) 16314 (setq killed (cdr killed)))
16148 (setq lists (cdr lists))))) 16315 (setq lists (cdr lists)))))
16149 16316
16150 (defun gnus-get-killed-groups () 16317 (defun gnus-get-killed-groups ()
16151 "Go through the active hashtb and all all unknown groups as killed." 16318 "Go through the active hashtb and mark all unknown groups as killed."
16152 ;; First make sure active file has been read. 16319 ;; First make sure active file has been read.
16153 (unless (gnus-read-active-file-p) 16320 (unless (gnus-read-active-file-p)
16154 (let ((gnus-read-active-file t)) 16321 (let ((gnus-read-active-file t))
16155 (gnus-read-active-file))) 16322 (gnus-read-active-file)))
16156 (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) 16323 (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
16182 (cons gnus-select-method gnus-secondary-select-methods) 16349 (cons gnus-select-method gnus-secondary-select-methods)
16183 ;; The native server is down, so we just do the 16350 ;; The native server is down, so we just do the
16184 ;; secondary ones. 16351 ;; secondary ones.
16185 gnus-secondary-select-methods) 16352 gnus-secondary-select-methods)
16186 ;; Also read from the archive server. 16353 ;; Also read from the archive server.
16187 (when gnus-message-archive-method 16354 (when (gnus-archive-server-wanted-p)
16188 (list "archive")))) 16355 (list "archive"))))
16189 list-type) 16356 list-type)
16190 (setq gnus-have-read-active-file nil) 16357 (setq gnus-have-read-active-file nil)
16191 (save-excursion 16358 (save-excursion
16192 (set-buffer nntp-server-buffer) 16359 (set-buffer nntp-server-buffer)
16994 ;;; 17161 ;;;
16995 17162
16996 (defun gnus-read-all-descriptions-files () 17163 (defun gnus-read-all-descriptions-files ()
16997 (let ((methods (cons gnus-select-method 17164 (let ((methods (cons gnus-select-method
16998 (nconc 17165 (nconc
16999 (when gnus-message-archive-method 17166 (when (gnus-archive-server-wanted-p)
17000 (list "archive")) 17167 (list "archive"))
17001 gnus-secondary-select-methods)))) 17168 gnus-secondary-select-methods))))
17002 (while methods 17169 (while methods
17003 (gnus-read-descriptions-file (car methods)) 17170 (gnus-read-descriptions-file (car methods))
17004 (setq methods (cdr methods))) 17171 (setq methods (cdr methods)))