| blob | d0729dcefbd52eae3352d1d13b02e73d2b6c8206 |
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
3 ;; 1997, 1998, 2000, 2001 Free Software Foundation, Inc.
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news, mail
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
26 ;;; Commentary:
28 ;;; Code:
36 "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
41 "Group character set issues."
47 "Cache interface."
51 "Starting your favorite newsreader."
55 "Server options at startup."
58 ;; These belong to gnus-group.el.
60 "Group buffers."
65 "Foreign groups."
70 "Automatic subscription of new groups."
74 "Group levels."
79 "Selecting a Group."
84 "Showing slices of the group list."
89 "Sorting the group buffer."
95 "Various group options."
99 ;; These belong to gnus-sum.el.
101 "Summary buffers."
106 "Leaving summary buffers."
111 "Marks used in summary buffers."
116 "Ordering articles according to replies."
121 "Formatting of the summary buffer."
126 "Choosing Articles."
131 "Summary movement commands."
136 "Mail group commands."
141 "Sorting the summary buffer."
146 "Highlighting and menus in the summary buffer."
152 "Various summary buffer options."
157 "Pick mode in the summary buffer."
163 "Tree display of threads in the summary buffer."
168 ;; Belongs to gnus-uu.el
170 "Viewing extracted files."
174 ;; Belongs to gnus-score.el
176 "Score and kill file handling."
180 "Kill files."
184 "Adaptive score files."
188 "Default values for score files."
192 "Expiring score rules."
196 "Decaying score rules."
200 "Score and kill file names."
205 "Various scoring and killing options."
208 ;; Other
210 "Options controling the visual fluff."
215 "Offline support for Gnus."
219 "Files used by Gnus."
223 "Auto save file."
228 "Storing Gnus state."
232 "Options related to newsservers and other servers used by Gnus."
236 "Composing replies and followups in Gnus."
240 "Meta variables controling major portions of Gnus.
241 In general, modifying these variables does not take affect until Gnus
242 is restarted, and sometimes reloaded."
246 "Other Gnus options."
251 "Variables for controlling the Gnus MIME interface."
255 "Exiting gnus."
266 "If non-nil, the startup message will not be displayed.
267 This variable is used before `.gnus.el' is loaded, so it should
268 be set in `.emacs' instead."
273 "If non-nil, play the Gnus jingle at startup."
301 0 5
310 gnus-mode-line-image-cache)
312 str)
314 line)))
322 ;; We define these group faces here to avoid the display
323 ;; update forced when creating new faces.
333 ()))
344 ()))
355 ()))
366 ()))
377 ()))
383 ())
386 ())
388 ()))
399 ()))
405 ())
408 ())
410 ()))
421 ()))
427 ())
430 ())
432 ()))
443 ()))
449 ())
452 ())
454 ()))
465 ()))
476 ()))
542 ()))
567 ;; Summary mode faces.
608 ()))
641 ()))
656 ()))
693 ()))
697 ;;;
698 ;;; Gnus buffers
699 ;;;
704 "Do the same as `get-buffer-create', but store the created buffer."
709 "Add the current buffer to the list of Gnus buffers."
713 "Return a list of live Gnus buffers."
722 gnus-buffers)
724 ;;; Splash screen.
739 ()))
754 "Indent rigidly using only spaces and no tabs."
760 ;; We translate tabs into spaces -- not everybody uses
761 ;; an 8-character tab.
769 "Insert startup message in current buffer."
770 ;; Insert the message.
779 ;; Account for the pbm's blackground.
783 ;; Account for the xbm's blackground.
794 t))))
798 _ ___ _ _
799 _ ___ __ ___ __ _ ___
800 __ _ ___ __ ___
801 _ ___ _
802 _ _ __ _
803 ___ __ _
804 __ _
805 _ _ _
806 _ _ _
807 _ _ _
808 __ ___
809 _ _ _ _
810 _ _
811 _ _
812 _ _
813 _
814 __
816 "
818 ;; And then hack it.
827 ;; Fontify some.
841 ;;; Do the rest.
848 All other Gnus path variables are initialized from this variable."
854 "*Directory variable from which all other Gnus file variables are derived.
856 Note that Gnus is mostly loaded when the `.gnus.el' file is read.
857 This means that other directory variables that are initialized from
858 this variable won't be set properly if you set this variable in `.gnus.el'.
859 Set this variable in `.emacs' instead."
864 "*Default directory for all Gnus buffers."
867 directory))
869 ;; Site dependent variables. These variables should be defined in
870 ;; paths.el.
873 "Specify a default NNTP server.
874 This variable should be defined in paths.el, and should never be set
875 by the user.
876 If you want to change servers, you should use `gnus-select-method'.
879 ;; Don't touch this variable.
882 This is an obsolete variable, which is scarcely used. If you use an
883 nntp server for your newsgroup and want to change the port number
884 used to 899, you would say something along these lines:
889 "A file with only the name of the nntp server in it."
894 ;; This function is used to check both the environment variable
895 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
896 ;; an nntp server name default.
906 nil
907 name)
918 gnus-default-nntp-server)
922 nil
925 "Default method for selecting a newsgroup.
926 This variable should be a list, where the first element is how the
927 news is to be fetched, the second is the address.
929 For instance, if you want to get your news via NNTP from
934 If you want to use your local spool, say:
936 \(setq gnus-select-method (list 'nnspool (system-name)))
938 If you use this variable, you must set `gnus-nntp-server' to nil.
940 There is a lot more to know about select methods and virtual servers -
941 see the manual for details."
947 ;; Don't require it at top level to avoid circularity.
950 "archive"
956 "*Method used for archiving messages you've sent.
957 This should be a mail method.
959 It's probably not very effective to change this variable once you've
960 run Gnus once. After doing that, you must edit this server from the
961 server buffer."
967 "*Name of the group in which to save the messages you've written.
968 This can either be a string; a list of strings; or an alist
969 of regexps/functions/forms to be evaluated to return a string (or a list
970 of strings). The functions are called with the name of the current
971 group (or nil) as a parameter.
973 If you want to save your mail in one group and the news articles you
974 write in another group, you could say something like:
976 \(setq gnus-message-archive-group
977 '((if (message-news-p)
981 Normally the group names returned by this variable should be
983 However, you may wish to store the message on some other server. In
984 that case, just return a fully prefixed name of the group --
988 function
989 sexp
990 string))
993 "List of NNTP servers that the user can choose between interactively.
994 To make Gnus query you for a server, you have to give `gnus' a
995 non-numeric prefix - `C-u M-x gnus', in short."
1000 "*The name of the host running the NNTP server.
1001 This variable is semi-obsolete. Use the `gnus-select-method'
1002 variable instead."
1005 string))
1008 "A list of secondary methods that will be used for reading news.
1009 This is a list where each element is a complete select method (see
1010 `gnus-select-method').
1012 If, for instance, you want to read your mail with the nnml backend,
1013 you could set this variable:
1021 "Default default new newsgroups the first time Gnus is run.
1025 "Local domain name without a host name.
1026 The DOMAINNAME environment variable is used instead if it is defined.
1027 If the `system-name' function returns the full Internet name, there is
1028 no need to set this variable."
1031 string))
1034 "String with a description of what organization (if any) the user belongs to.
1037 ;; Customization variables
1040 "Preferred method for fetching an article by Message-ID.
1041 If you are reading news from the local spool (with nnspool), fetching
1042 articles by Message-ID is painfully slow. By setting this method to an
1043 nntp method, you might get acceptable results.
1045 The value of this variable must be a valid select method as discussed
1046 in the documentation of `gnus-select-method'.
1048 It can also be a list of select methods, as well as the special symbol
1049 `current', which means to use the current select method. If it is a
1050 list, Gnus will try all the methods in the list until it finds a match."
1054 gnus-select-method
1062 gnus-select-method))))
1066 "/ftp@sunsite.auc.dk:/pub/usenet/"
1067 "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
1068 "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
1069 "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
1070 "/ftp@rtfm.mit.edu:/pub/usenet/"
1071 "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
1072 "/ftp@ftp.sunet.se:/pub/usenet/"
1073 "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
1074 "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
1076 "*Directory where the group FAQs are stored.
1077 This will most commonly be on a remote machine, and the file will be
1078 fetched by ange-ftp.
1080 This variable can also be a list of directories. In that case, the
1081 first element in the list will be used by default. The others can
1082 be used when being prompted for a site.
1084 Note that Gnus uses an aol machine as the default directory. If this
1085 feels fundamentally unclean, just think of it as a way to finally get
1086 something of value back from them.
1088 If the default site is too slow, try one of these:
1090 North America: mirrors.aol.com /pub/rtfm/usenet
1091 ftp.seas.gwu.edu /pub/rtfm
1092 rtfm.mit.edu /pub/usenet
1093 Europe: ftp.uni-paderborn.de /pub/FAQ
1094 src.doc.ic.ac.uk /usenet/news-FAQS
1095 ftp.sunet.se /pub/usenet
1096 sunsite.auc.dk /pub/usenet
1097 Asia: nctuccca.edu.tw /USENET/FAQ
1098 hwarang.postech.ac.kr /pub/usenet
1099 ftp.hk.super.net /mirror/faqs"
1105 "*Non-nil means that cross referenced articles will be marked as read.
1106 If nil, ignore cross references. If t, mark articles as read in
1107 subscribed newsgroups. If neither t nor nil, mark as read in all
1108 newsgroups."
1116 "*Process mark."
1122 "*The number of articles which indicates a large newsgroup.
1123 If the number of articles in a newsgroup is greater than this value,
1124 confirmation is required for selecting the newsgroup."
1129 "*Non-nil means that the default name of a file to save articles in is the group name.
1130 If it's nil, the directory form of the group name is used instead.
1132 If this variable is a list, and the list contains the element
1133 `not-score', long file names will not be used for score files; if it
1134 contains the element `not-save', long file names will not be used for
1135 saving; and if it contains the element `not-kill', long file names
1136 will not be used for kill files.
1138 Note that the default for this variable varies according to what system
1139 type you're using. On `usg-unix-v' and `xenix' this variable defaults
1140 to nil while on all other systems it defaults to t."
1151 "*If non-nil, save group scoring info."
1157 "*If non-nil, allow undoing in Gnus group mode buffers."
1162 "*If non-nil, use some adaptive scoring scheme.
1163 If a list, then the values `word' and `line' are meaningful. The
1164 former will perform adaption on individual words in the subject
1165 header while `line' will perform adaption on several headers."
1171 "*If nil, Gnus will ignore the article cache.
1172 If `passive', it will allow entering (and reading) articles
1173 explicitly entered into the cache. If anything else, use the
1174 cache to the full extent of the law."
1182 "*If non-nil, display a thread tree buffer."
1187 "*If non-nil, use GroupLens ratings."
1192 "*If non-nil, Gnus will keep read articles for later re-retrieval.
1193 If it is a number N, then Gnus will only keep the last N articles
1194 read. If it is neither nil nor a number, Gnus will keep all read
1195 articles. This is not a good idea."
1198 integer
1203 "*If non-nil, Gnus will read NoCeM cancel messages."
1208 "*If non-nil, Gnus will mark duplicate copies of the same article as read."
1213 "*If non-nil, enable scoring."
1218 "*If non-nil, display picons in a frame of their own."
1224 "*A hook called when preparing to exit from the summary buffer.
1225 It calls `gnus-summary-expire-articles' by default."
1230 "*Non-nil means that you are a usenet novice.
1231 If non-nil, verbose messages may be displayed and confirmations may be
1232 required."
1237 "*Non-nil means that you will never be asked for confirmation about anything.
1238 That doesn't mean *anything* anything; particularly destructive
1239 commands will still require prompting."
1244 "*If non-nil, require your confirmation when catching up a group."
1249 "*If non-nil, require your confirmation when exiting Gnus."
1254 "*Function for extracting address components from a From header.
1255 Two pre-defined function exist: `gnus-extract-address-components',
1256 which is the default, quite fast, and too simplistic solution, and
1257 `mail-extract-address-components', which works much better, but is
1258 slower."
1265 "*If non-nil, display clickable icons."
1270 "String used to separate to shell commands."
1297 "*An alist of valid select methods.
1298 The first element of each list lists should be a string with the name
1299 of the select method. The other elements may be the category of
1300 this method (i. e., `post', `mail', `none' or whatever) or other
1301 properties that this method has (like being respoolable).
1302 If you implement a new select method, all you should have to change is
1303 this variable. I think."
1318 "Recomputes the select-method widget based on the value of
1319 `gnus-valid-select-methods'."
1321 "Widget for entering a select method."
1328 gnus-valid-select-methods)
1332 :inline t
1334 variable
1336 ))
1341 "List of buffers that should update their mode lines.
1342 The list may contain the symbols `group', `article', `tree' and
1343 `summary'. If the corresponding symbol is present, Gnus will keep
1344 that mode line updated with information that may be pertinent.
1345 If this variable is nil, screen refresh may be quicker."
1352 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1354 "*Max length of mode-line non-string contents.
1355 If this is nil, Gnus will take space as is needed, leaving the rest
1356 of the modeline intact. Note that the default of nil is unlikely
1357 to be desirable; see the manual for further details."
1360 integer))
1363 "*Groups in which to automatically mark read articles as expirable.
1364 If non-nil, this should be a regexp that should match all groups in
1365 which to perform auto-expiry. This only makes sense for mail groups."
1368 regexp))
1371 "*Groups in which to perform expiry of all read articles.
1372 Use with extreme caution. All groups that match this regexp will be
1373 expiring - which means that all read articles will be deleted after
1374 \(say) one week. (This only goes for mail groups and the like, of
1375 course.)"
1378 regexp))
1381 "Number of group name elements to leave alone when making a short group name."
1386 "*If non-nil, once you set a level, Gnus will use this level."
1390 ;; Hooks.
1393 "A hook run while Gnus is loaded."
1398 "A hook called to apply kill files to a group.
1399 This hook is intended to apply a kill file to the selected newsgroup.
1400 The function `gnus-apply-kill-file' is called by default.
1402 Since a general kill file is too heavy to use only for a few
1403 newsgroups, I recommend you to use a lighter hook function. For
1404 example, if you'd like to apply a kill file to articles which contains
1405 a string `rmgroup' in subject in newsgroup `control', you can use the
1406 following hook:
1408 (setq gnus-apply-kill-hook
1409 (list
1410 (lambda ()
1419 "Function run when a group level is changed.
1420 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
1424 ;;; Face thingies.
1428 mouse-face
1429 summary-menu group-menu article-menu
1430 tree-highlight menu highlight
1431 browse-menu server-menu
1432 page-marker tree-menu binary-menu pick-menu
1433 grouplens-menu)
1434 "*Enable visual features.
1435 If `visual' is disabled, there will be no menus and few faces. Most of
1436 the visual customization options below will be ignored. Gnus will use
1437 less space and be faster as a result.
1439 This variable can also be a list of visual elements to switch on. For
1440 instance, to switch off all visual things except menus, you can say:
1442 (setq gnus-visual '(menu))
1444 Valid elements include `summary-highlight', `group-highlight',
1445 `article-highlight', `mouse-face', `summary-menu', `group-menu',
1446 `article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
1447 `server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
1448 and `grouplens-menu'."
1477 "*Face used for group or summary buffer mouse highlighting.
1478 The line beneath the mouse pointer will be highlighted with this
1479 face."
1492 "Default charset assumed to be used when viewing non-ASCII characters.
1493 This variable is overridden on a group-to-group basis by the
1494 gnus-group-charset-alist variable and is only used on groups not
1495 covered by that variable."
1500 "Default charset assumed to be used when posting non-ASCII characters.
1501 This variable is overridden on a group-to-group basis by the
1502 gnus-group-posting-charset-alist variable and is only used on groups not
1503 covered by that variable.
1504 If nil, no default charset is assumed when posting."
1508 \f
1509 ;;; Internal variables
1533 ;; Dummy variable.
1536 ;; Variable holding the user answers to all method prompts.
1539 ;; Variable holding the user answers to all mail method prompts.
1542 ;; Variable holding the user answers to all group prompts.
1550 "*The directory where cached articles will be stored."
1556 nnspool "cache"
1584 "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
1609 gnus-newsrc-last-checked-date
1610 gnus-newsrc-alist gnus-server-alist
1611 gnus-killed-list gnus-zombie-list
1612 gnus-topic-topology gnus-topic-alist
1613 gnus-format-specs)
1617 "Assoc list of read articles.
1644 ;; Save window configuration.
1649 ;;; Let the byte-compiler know that we know about this variable.
1657 ;;; End of variables.
1659 ;; Define some autoload functions Gnus might use.
1662 ;; This little mapcar goes through the list below and marks the
1663 ;; symbols in question as autoloaded functions.
1683 message-send-and-exit message-yank-original)
1689 rmail-show-message rmail-summary-exists
1690 rmail-select-summary rmail-update-summary)
1694 gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1695 gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1699 gnus-Folder-save-name gnus-folder-save-name)
1702 gnus-demon-add-rescan gnus-demon-add-scan-timestamps
1703 gnus-demon-add-disconnection gnus-demon-add-handler
1704 gnus-demon-remove-handler)
1706 gnus-demon-init gnus-demon-cancel)
1708 gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
1710 gnus-nocem-unwanted-article-p)
1712 gnus-server-server-name)
1715 gnus-article-highlight-citation gnus-article-hide-citation-maybe
1716 gnus-article-hide-citation gnus-article-fill-cited-article
1717 gnus-article-hide-citation-in-followups)
1719 gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1720 gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
1722 gnus-cache-possibly-remove-articles gnus-cache-request-article
1723 gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1724 gnus-cache-enter-remove-article gnus-cached-article-p
1725 gnus-cache-open gnus-cache-close gnus-cache-update-article
1726 gnus-cache-articles-in-group)
1728 gnus-cache-remove-article gnus-summary-insert-cached-articles)
1730 gnus-summary-increase-score gnus-summary-set-score
1731 gnus-summary-raise-thread gnus-summary-raise-same-subject
1732 gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
1733 gnus-summary-lower-thread gnus-summary-lower-same-subject
1734 gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
1735 gnus-summary-current-score gnus-score-delta-default
1736 gnus-score-flush-cache gnus-score-close
1737 gnus-possibly-score-headers gnus-score-followup-article
1738 gnus-score-followup-thread)
1741 gnus-current-score-file-nondirectory gnus-score-adaptive
1742 gnus-score-find-trace gnus-score-file-name)
1746 gnus-subscribe-topics)
1750 gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
1751 gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
1752 gnus-uu-mark-by-regexp gnus-uu-mark-all
1753 gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
1754 gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
1755 gnus-uu-decode-unshar-and-save gnus-uu-decode-save
1756 gnus-uu-decode-binhex gnus-uu-decode-uu-view
1757 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
1758 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
1759 gnus-uu-decode-binhex-view gnus-uu-unmark-thread
1760 gnus-uu-mark-over gnus-uu-post-news)
1763 gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
1765 gnus-group-post-news gnus-group-mail gnus-summary-post-news
1766 gnus-summary-followup gnus-summary-followup-with-original
1767 gnus-summary-cancel-article gnus-summary-supersede-article
1768 gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
1769 gnus-summary-mail-forward gnus-summary-mail-other-window
1770 gnus-summary-resend-message gnus-summary-resend-bounced-mail
1771 gnus-summary-wide-reply gnus-summary-followup-to-mail
1772 gnus-summary-followup-to-mail-with-original gnus-bug
1773 gnus-summary-wide-reply-with-original
1774 gnus-summary-post-forward gnus-summary-wide-reply-with-original
1775 gnus-summary-post-forward)
1777 gnus-group-display-picons gnus-picons-article-display-x-face
1778 gnus-picons-display-x-face)
1781 gnus-grouplens-mode)
1785 gnus-list-of-unread-articles gnus-list-of-read-articles
1786 gnus-offer-save-summaries gnus-make-thread-indent-array
1787 gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
1788 gnus-summary-skip-intangible gnus-summary-article-number
1789 gnus-data-header gnus-data-find)
1791 gnus-group-list-groups gnus-group-first-unread-group
1792 gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
1793 gnus-group-setup-buffer gnus-group-get-new-news
1794 gnus-group-make-help-group gnus-group-update-group
1795 gnus-group-iterate gnus-group-group-name)
1797 gnus-backlog-remove-article)
1799 gnus-article-prepare gnus-article-set-window-start
1800 gnus-article-next-page gnus-article-prev-page
1801 gnus-request-article-this-buffer gnus-article-mode
1802 gnus-article-setup-buffer gnus-narrow-to-page
1803 gnus-article-delete-invisible-text gnus-treat-article)
1805 gnus-article-hide-headers gnus-article-hide-boring-headers
1806 gnus-article-treat-overstrike
1807 gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
1808 gnus-article-display-x-face gnus-article-de-quoted-unreadable
1809 gnus-article-de-base64-unreadable
1810 gnus-article-decode-HZ
1811 gnus-article-wash-html
1812 gnus-article-hide-pgp
1813 gnus-article-hide-pem gnus-article-hide-signature
1814 gnus-article-strip-leading-blank-lines gnus-article-date-local
1815 gnus-article-date-original gnus-article-date-lapsed
1816 gnus-article-show-all-headers
1817 gnus-article-edit-mode gnus-article-edit-article
1818 gnus-article-edit-done gnus-article-decode-encoded-words
1819 gnus-start-date-timer gnus-stop-date-timer
1820 gnus-mime-view-all-parts)
1823 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch)
1825 gnus-dup-enter-articles)
1829 gnus-group-move-group-to-server gnus-change-server)
1833 gnus-async-prefetch-article gnus-async-prefetch-remove-group
1834 gnus-async-halt-prefetch)
1836 gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
1837 gnus-agent-get-undownloaded-list gnus-agent-fetch-session
1838 gnus-summary-set-agent-mark gnus-agent-save-group-info)
1840 gnus-unplugged gnus-agentize gnus-agent-batch)
1842 gnus-summary-save-article-vm)
1846 gnus-group-split-update))))
1848 ;;; gnus-sum.el thingies
1852 "*The format specification of the lines in the summary buffer.
1854 It works along the same lines as a normal formatting string,
1855 with some simple extensions.
1857 %N Article number, left padded with spaces (string)
1858 %S Subject (string)
1860 %n Name of the poster (string)
1861 %a Extracted name of the poster (string)
1862 %A Extracted address of the poster (string)
1863 %F Contents of the From: header (string)
1864 %f Contents of the From: or To: headers (string)
1865 %x Contents of the Xref: header (string)
1866 %D Date of the article (string)
1867 %d Date of the article (string) in DD-MMM format
1868 %M Message-id of the article (string)
1869 %r References of the article (string)
1870 %c Number of characters in the article (integer)
1871 %L Number of lines in the article (integer)
1872 %I Indentation based on thread level (a string of spaces)
1873 %T A string with two possible values: 80 spaces if the article
1874 is on thread level two or larger and 0 spaces on level one
1879 %> Spaces of length thread-level (string)
1880 %< Spaces of length (- 20 thread-level) (string)
1881 %i Article score (number)
1882 %z Article zcore (character)
1883 %t Number of articles under the current thread (number).
1884 %e Whether the thread is empty or not (character).
1885 %l GroupLens score (string).
1886 %V Total thread score (number).
1887 %P The line number (number).
1888 %O Download mark (character).
1889 %u User defined specifier. The next character in the format string should
1890 be a letter. Gnus will call the function gnus-user-format-function-X,
1891 where X is the letter following %u. The function will be passed the
1892 current header as argument. The function should return a string, which
1893 will be inserted into the summary just like information from any other
1894 summary specifier.
1896 Text between %( and %) will be highlighted with `gnus-mouse-face'
1897 when the mouse point is placed inside the area. There can only be one
1898 such area.
1900 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1901 with care. For reasons of efficiency, Gnus will compute what column
1903 it is invalid to have these specs after a variable-length spec. Well,
1904 you might not be arrested, but your summary buffer will look strange,
1905 which is bad enough.
1907 The smart choice is to have these specs as for to the left as
1908 possible.
1910 This restriction may disappear in later versions of Gnus."
1914 ;;;
1915 ;;; Skeleton keymaps
1916 ;;;
1921 (while keys
1922 (define-key keymap (pop keys) 'undefined))))
1924 (defvar gnus-article-mode-map
1925 (let ((keymap (make-sparse-keymap)))
1926 (gnus-suppress-keymap keymap)
1927 keymap))
1928 (defvar gnus-summary-mode-map
1929 (let ((keymap (make-keymap)))
1930 (gnus-suppress-keymap keymap)
1931 keymap))
1932 (defvar gnus-group-mode-map
1933 (let ((keymap (make-keymap)))
1934 (gnus-suppress-keymap keymap)
1935 keymap))
1937 \f
1939 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1940 ;; If you want the cursor to go somewhere else, set these two
1941 ;; functions in some startup hook to whatever you want.
1942 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
1943 (defalias 'gnus-group-position-point 'gnus-goto-colon)
1945 ;;; Various macros and substs.
1947 (defun gnus-header-from (header)
1948 (mail-header-from header))
1950 (defmacro gnus-gethash (string hashtable)
1951 "Get hash value of STRING in HASHTABLE."
1952 `(symbol-value (intern-soft ,string ,hashtable)))
1954 (defmacro gnus-sethash (string value hashtable)
1955 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
1956 `(set (intern ,string ,hashtable) ,value))
1957 (put 'gnus-sethash 'edebug-form-spec '(form form form))
1959 (defmacro gnus-group-unread (group)
1960 "Get the currently computed number of unread articles in GROUP."
1961 `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
1963 (defmacro gnus-group-entry (group)
1964 "Get the newsrc entry for GROUP."
1965 `(gnus-gethash ,group gnus-newsrc-hashtb))
1967 (defmacro gnus-active (group)
1968 "Get active info on GROUP."
1969 `(gnus-gethash ,group gnus-active-hashtb))
1971 (defmacro gnus-set-active (group active)
1972 "Set GROUP's active info."
1973 `(gnus-sethash ,group ,active gnus-active-hashtb))
1975 ;; Info access macros.
1977 (defmacro gnus-info-group (info)
1978 `(nth 0 ,info))
1979 (defmacro gnus-info-rank (info)
1980 `(nth 1 ,info))
1981 (defmacro gnus-info-read (info)
1982 `(nth 2 ,info))
1983 (defmacro gnus-info-marks (info)
1984 `(nth 3 ,info))
1985 (defmacro gnus-info-method (info)
1986 `(nth 4 ,info))
1987 (defmacro gnus-info-params (info)
1988 `(nth 5 ,info))
1990 (defmacro gnus-info-level (info)
1991 `(let ((rank (gnus-info-rank ,info)))
1992 (if (consp rank)
1993 (car rank)
1994 rank)))
1995 (defmacro gnus-info-score (info)
1996 `(let ((rank (gnus-info-rank ,info)))
1997 (or (and (consp rank) (cdr rank)) 0)))
1999 (defmacro gnus-info-set-group (info group)
2000 `(setcar ,info ,group))
2001 (defmacro gnus-info-set-rank (info rank)
2002 `(setcar (nthcdr 1 ,info) ,rank))
2003 (defmacro gnus-info-set-read (info read)
2004 `(setcar (nthcdr 2 ,info) ,read))
2005 (defmacro gnus-info-set-marks (info marks &optional extend)
2006 (if extend
2007 `(gnus-info-set-entry ,info ,marks 3)
2008 `(setcar (nthcdr 3 ,info) ,marks)))
2009 (defmacro gnus-info-set-method (info method &optional extend)
2010 (if extend
2011 `(gnus-info-set-entry ,info ,method 4)
2012 `(setcar (nthcdr 4 ,info) ,method)))
2013 (defmacro gnus-info-set-params (info params &optional extend)
2014 (if extend
2015 `(gnus-info-set-entry ,info ,params 5)
2016 `(setcar (nthcdr 5 ,info) ,params)))
2018 (defun gnus-info-set-entry (info entry number)
2019 ;; Extend the info until we have enough elements.
2020 (while (<= (length info) number)
2021 (nconc info (list nil)))
2022 ;; Set the entry.
2023 (setcar (nthcdr number info) entry))
2025 (defmacro gnus-info-set-level (info level)
2026 `(let ((rank (cdr ,info)))
2027 (if (consp (car rank))
2028 (setcar (car rank) ,level)
2029 (setcar rank ,level))))
2030 (defmacro gnus-info-set-score (info score)
2031 `(let ((rank (cdr ,info)))
2032 (if (consp (car rank))
2033 (setcdr (car rank) ,score)
2034 (setcar rank (cons (car rank) ,score)))))
2036 (defmacro gnus-get-info (group)
2037 `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2039 ;; Byte-compiler warning.
2040 (defvar gnus-visual)
2041 ;; Find out whether the gnus-visual TYPE is wanted.
2042 (defun gnus-visual-p (&optional type class)
2043 (and gnus-visual ; Has to be non-nil, at least.
2044 (if (not type) ; We don't care about type.
2045 gnus-visual
2046 (if (listp gnus-visual) ; It's a list, so we check it.
2047 (or (memq type gnus-visual)
2048 (memq class gnus-visual))
2049 t))))
2051 ;;; Load the compatability functions.
2053 (require 'gnus-ems)
2055 \f
2056 ;;;
2057 ;;; Shutdown
2058 ;;;
2060 (defvar gnus-shutdown-alist nil)
2062 (defun gnus-add-shutdown (function &rest symbols)
2063 "Run FUNCTION whenever one of SYMBOLS is shut down."
2064 (push (cons function symbols) gnus-shutdown-alist))
2066 (defun gnus-shutdown (symbol)
2067 "Shut down everything that waits for SYMBOL."
2068 (let ((alist gnus-shutdown-alist)
2069 entry)
2070 (while (setq entry (pop alist))
2071 (when (memq symbol (cdr entry))
2072 (funcall (car entry))))))
2074 \f
2075 ;;;
2076 ;;; Gnus Utility Functions
2077 ;;;
2080 (defmacro gnus-string-or (&rest strings)
2081 "Return the first element of STRINGS that is a non-blank string.
2082 STRINGS will be evaluated in normal `or' order."
2083 `(gnus-string-or-1 ',strings))
2085 (defun gnus-string-or-1 (strings)
2086 (let (string)
2087 (while strings
2088 (setq string (eval (pop strings)))
2090 (setq string nil)
2091 (setq strings nil)))
2092 string))
2094 (defun gnus-version (&optional arg)
2095 "Version number of this version of Gnus.
2096 If ARG, insert string at point."
2097 (interactive "P")
2098 (if arg
2099 (insert (message gnus-version))
2100 (message gnus-version)))
2102 (defun gnus-continuum-version (version)
2103 "Return VERSION as a floating point number."
2106 (let ((alpha (and (match-beginning 1) (match-string 1 version)))
2107 (number (match-string 2 version))
2108 major minor least)
2109 (unless (string-match
2111 (error "Invalid version string: %s" version))
2112 (setq major (string-to-number (match-string 1 number))
2113 minor (string-to-number (match-string 2 number))
2114 least (if (match-beginning 3)
2115 (string-to-number (match-string 3 number))
2116 0))
2117 (string-to-number
2118 (if (zerop major)
2119 (format "%s00%02d%02d"
2120 (if (member alpha '("(ding)" "d"))
2121 "4.99"
2122 (+ 5 (* 0.02
2123 (abs
2124 (- (mm-char-int (aref (downcase alpha) 0))
2125 (mm-char-int ?t))))
2126 -0.01))
2127 minor least)
2128 (format "%d.%02d%02d" major minor least))))))
2130 (defun gnus-info-find-node ()
2131 "Find Info documentation of Gnus."
2132 (interactive)
2133 ;; Enlarge info window if needed.
2134 (let (gnus-info-buffer)
2135 (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
2136 (setq gnus-info-buffer (current-buffer))
2137 (gnus-configure-windows 'info)))
2139 ;;;
2140 ;;; gnus-interactive
2141 ;;;
2143 (defvar gnus-current-prefix-symbol nil
2144 "Current prefix symbol.")
2146 (defvar gnus-current-prefix-symbols nil
2147 "List of current prefix symbols.")
2149 (defun gnus-interactive (string &optional params)
2150 "Return a list that can be fed to `interactive'.
2151 See `interactive' for full documentation.
2153 Adds the following specs:
2155 y -- The current symbolic prefix.
2156 Y -- A list of the current symbolic prefix(es).
2157 A -- Article number.
2158 H -- Article header.
2159 g -- Group name."
2160 (let ((i 0)
2161 out c prompt)
2162 (while (< i (length string))
2164 (setq c (aref string i))
2165 (when (match-end 1)
2166 (setq prompt (match-string 1 string)))
2167 (setq i (match-end 0))
2168 ;; We basically emulate just about everything that
2169 ;; `interactive' does, but add the specs listed above.
2170 (push
2171 (cond
2172 ((= c ?a)
2173 (completing-read prompt obarray 'fboundp t))
2174 ((= c ?b)
2175 (read-buffer prompt (current-buffer) t))
2176 ((= c ?B)
2177 (read-buffer prompt (other-buffer (current-buffer))))
2178 ((= c ?c)
2179 (read-char))
2180 ((= c ?C)
2181 (completing-read prompt obarray 'commandp t))
2182 ((= c ?d)
2183 (point))
2184 ((= c ?D)
2185 (read-file-name prompt nil default-directory 'lambda))
2186 ((= c ?f)
2187 (read-file-name prompt nil nil 'lambda))
2188 ((= c ?F)
2189 (read-file-name prompt))
2190 ((= c ?k)
2191 (read-key-sequence prompt))
2192 ((= c ?K)
2193 (error "Not implemented spec"))
2194 ((= c ?e)
2195 (error "Not implemented spec"))
2196 ((= c ?m)
2197 (mark))
2198 ((= c ?N)
2199 (error "Not implemented spec"))
2200 ((= c ?n)
2201 (string-to-number (read-from-minibuffer prompt)))
2202 ((= c ?p)
2203 (prefix-numeric-value current-prefix-arg))
2204 ((= c ?P)
2205 current-prefix-arg)
2206 ((= c ?r)
2207 'gnus-prefix-nil)
2208 ((= c ?s)
2209 (read-string prompt))
2210 ((= c ?S)
2211 (intern (read-string prompt)))
2212 ((= c ?v)
2213 (read-variable prompt))
2214 ((= c ?x)
2215 (read-minibuffer prompt))
2216 ((= c ?x)
2217 (eval-minibuffer prompt))
2218 ;; And here the new specs come.
2219 ((= c ?y)
2220 gnus-current-prefix-symbol)
2221 ((= c ?Y)
2222 gnus-current-prefix-symbols)
2223 ((= c ?g)
2224 (gnus-group-group-name))
2225 ((= c ?A)
2226 (gnus-summary-skip-intangible)
2227 (or (get-text-property (point) 'gnus-number)
2228 (gnus-summary-last-subject)))
2229 ((= c ?H)
2230 (gnus-data-header (gnus-data-find (gnus-summary-article-number))))
2231 (t
2232 (error "Non-implemented spec")))
2233 out)
2234 (cond
2235 ((= c ?r)
2236 (push (if (< (point) (mark)) (point) (mark)) out)
2237 (push (if (> (point) (mark)) (point) (mark)) out))))
2238 (setq out (delq 'gnus-prefix-nil out))
2239 (nreverse out)))
2241 (defun gnus-symbolic-argument (&optional arg)
2242 "Read a symbolic argument and a command, and then execute command."
2243 (interactive "P")
2244 (let* ((in-command (this-command-keys))
2245 (command in-command)
2246 gnus-current-prefix-symbols
2247 gnus-current-prefix-symbol
2248 syms)
2249 (while (equal in-command command)
2250 (message "%s-" (key-description (this-command-keys)))
2251 (push (intern (char-to-string (read-char))) syms)
2252 (setq command (read-key-sequence nil t)))
2253 (setq gnus-current-prefix-symbols (nreverse syms)
2254 gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
2255 (call-interactively (key-binding command t))))
2257 ;;; More various functions.
2259 (defsubst gnus-check-backend-function (func group)
2260 "Check whether GROUP supports function FUNC.
2261 GROUP can either be a string (a group name) or a select method."
2262 (ignore-errors
2263 (let ((method (if (stringp group)
2264 (car (gnus-find-method-for-group group))
2265 group)))
2266 (unless (featurep method)
2267 (require method))
2268 (fboundp (intern (format "%s-%s" method func))))))
2270 (defun gnus-group-read-only-p (&optional group)
2271 "Check whether GROUP supports editing or not.
2272 If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
2273 that that variable is buffer-local to the summary buffers."
2274 (let ((group (or group gnus-newsgroup-name)))
2275 (not (gnus-check-backend-function 'request-replace-article group))))
2277 (defun gnus-group-total-expirable-p (group)
2278 "Check whether GROUP is total-expirable or not."
2279 (let ((params (gnus-group-find-parameter group))
2280 val)
2281 (cond
2282 ((memq 'total-expire params)
2283 t)
2284 ((setq val (assq 'total-expire params)) ; (auto-expire . t)
2285 (cdr val))
2286 (gnus-total-expirable-newsgroups ; Check var.
2287 (string-match gnus-total-expirable-newsgroups group)))))
2289 (defun gnus-group-auto-expirable-p (group)
2290 "Check whether GROUP is auto-expirable or not."
2291 (let ((params (gnus-group-find-parameter group))
2292 val)
2293 (cond
2294 ((memq 'auto-expire params)
2295 t)
2296 ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
2297 (cdr val))
2298 (gnus-auto-expirable-newsgroups ; Check var.
2299 (string-match gnus-auto-expirable-newsgroups group)))))
2301 (defun gnus-virtual-group-p (group)
2302 "Say whether GROUP is virtual or not."
2303 (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
2304 gnus-valid-select-methods)))
2306 (defun gnus-news-group-p (group &optional article)
2307 "Return non-nil if GROUP (and ARTICLE) come from a news server."
2308 (or (gnus-member-of-valid 'post group) ; Ordinary news group.
2309 (and (gnus-member-of-valid 'post-mail group) ; Combined group.
2310 (if (or (null article)
2311 (not (< article 0)))
2312 (eq (gnus-request-type group article) 'news)
2313 (if (not (vectorp article))
2314 nil
2315 ;; It's a real article.
2316 (eq (gnus-request-type group (mail-header-id article))
2317 'news))))))
2319 ;; Returns a list of writable groups.
2320 (defun gnus-writable-groups ()
2321 (let ((alist gnus-newsrc-alist)
2322 groups group)
2323 (while (setq group (car (pop alist)))
2324 (unless (gnus-group-read-only-p group)
2325 (push group groups)))
2326 (nreverse groups)))
2328 ;; Check whether to use long file names.
2329 (defun gnus-use-long-file-name (symbol)
2330 ;; The variable has to be set...
2331 (and gnus-use-long-file-name
2332 ;; If it isn't a list, then we return t.
2333 (or (not (listp gnus-use-long-file-name))
2334 ;; If it is a list, and the list contains `symbol', we
2335 ;; return nil.
2336 (not (memq symbol gnus-use-long-file-name)))))
2338 ;; Generate a unique new group name.
2339 (defun gnus-generate-new-group-name (leaf)
2340 (let ((name leaf)
2341 (num 0))
2342 (while (gnus-gethash name gnus-newsrc-hashtb)
2343 (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
2344 name))
2346 (defun gnus-ephemeral-group-p (group)
2347 "Say whether GROUP is ephemeral or not."
2348 (gnus-group-get-parameter group 'quit-config t))
2350 (defun gnus-group-quit-config (group)
2351 "Return the quit-config of GROUP."
2352 (gnus-group-get-parameter group 'quit-config t))
2354 (defun gnus-kill-ephemeral-group (group)
2355 "Remove ephemeral GROUP from relevant structures."
2356 (gnus-sethash group nil gnus-newsrc-hashtb))
2358 (defun gnus-simplify-mode-line ()
2359 "Make mode lines a bit simpler."
2360 (setq mode-line-modified (cdr gnus-mode-line-modified))
2361 (when (listp mode-line-format)
2362 (make-local-variable 'mode-line-format)
2363 (setq mode-line-format (copy-sequence mode-line-format))
2364 (when (equal (nth 3 mode-line-format) " ")
2365 (setcar (nthcdr 3 mode-line-format) " "))))
2367 ;;; Servers and groups.
2369 (defsubst gnus-server-add-address (method)
2370 (let ((method-name (symbol-name (car method))))
2371 (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
2372 (not (assq (intern (concat method-name "-address")) method))
2373 (memq 'physical-address (assq (car method)
2374 gnus-valid-select-methods)))
2375 (append method (list (list (intern (concat method-name "-address"))
2376 (nth 1 method))))
2377 method)))
2379 (defsubst gnus-server-get-method (group method)
2380 ;; Input either a server name, and extended server name, or a
2381 ;; select method, and return a select method.
2382 (cond ((stringp method)
2383 (gnus-server-to-method method))
2384 ((equal method gnus-select-method)
2385 gnus-select-method)
2386 ((and (stringp (car method))
2387 group)
2388 (gnus-server-extend-method group method))
2389 ((and method
2390 (not group)
2391 (equal (cadr method) ""))
2392 method)
2393 (t
2394 (gnus-server-add-address method))))
2396 (defun gnus-server-to-method (server)
2397 "Map virtual server names to select methods."
2398 (or
2399 ;; Is this a method, perhaps?
2400 (and server (listp server) server)
2401 ;; Perhaps this is the native server?
2402 (and (equal server "native") gnus-select-method)
2403 ;; It should be in the server alist.
2404 (cdr (assoc server gnus-server-alist))
2405 ;; It could be in the predefined server alist.
2406 (cdr (assoc server gnus-predefined-server-alist))
2407 ;; If not, we look through all the opened server
2408 ;; to see whether we can find it there.
2409 (let ((opened gnus-opened-servers))
2410 (while (and opened
2411 (not (equal server (format "%s:%s" (caaar opened)
2412 (cadaar opened)))))
2413 (pop opened))
2414 (caar opened))
2415 ;; It could be a named method, search all servers
2416 (let ((servers gnus-secondary-select-methods))
2417 (while (and servers
2418 (not (equal server (format "%s:%s" (caar servers)
2419 (cadar servers)))))
2420 (pop servers))
2421 (car servers))))
2423 (defmacro gnus-method-equal (ss1 ss2)
2424 "Say whether two servers are equal."
2425 `(let ((s1 ,ss1)
2426 (s2 ,ss2))
2427 (or (equal s1 s2)
2428 (and (= (length s1) (length s2))
2429 (progn
2430 (while (and s1 (member (car s1) s2))
2431 (setq s1 (cdr s1)))
2432 (null s1))))))
2434 (defun gnus-methods-equal-p (m1 m2)
2435 (let ((m1 (or m1 gnus-select-method))
2436 (m2 (or m2 gnus-select-method)))
2437 (or (equal m1 m2)
2438 (and (eq (car m1) (car m2))
2439 (or (not (memq 'address (assoc (symbol-name (car m1))
2440 gnus-valid-select-methods)))
2441 (equal (nth 1 m1) (nth 1 m2)))))))
2443 (defun gnus-server-equal (m1 m2)
2444 "Say whether two methods are equal."
2445 (let ((m1 (cond ((null m1) gnus-select-method)
2446 ((stringp m1) (gnus-server-to-method m1))
2447 (t m1)))
2448 (m2 (cond ((null m2) gnus-select-method)
2449 ((stringp m2) (gnus-server-to-method m2))
2450 (t m2))))
2451 (gnus-method-equal m1 m2)))
2453 (defun gnus-servers-using-backend (backend)
2454 "Return a list of known servers using BACKEND."
2455 (let ((opened gnus-opened-servers)
2456 out)
2457 (while opened
2458 (when (eq backend (caaar opened))
2459 (push (caar opened) out))
2460 (pop opened))
2461 out))
2463 (defun gnus-archive-server-wanted-p ()
2464 "Say whether the user wants to use the archive server."
2465 (cond
2466 ((or (not gnus-message-archive-method)
2467 (not gnus-message-archive-group))
2468 nil)
2469 ((and gnus-message-archive-method gnus-message-archive-group)
2470 t)
2471 (t
2472 (let ((active (cadr (assq 'nnfolder-active-file
2473 gnus-message-archive-method))))
2474 (and active
2475 (file-exists-p active))))))
2477 (defun gnus-group-prefixed-name (group method)
2478 "Return the whole name from GROUP and METHOD."
2479 (and (stringp method) (setq method (gnus-server-to-method method)))
2480 (if (or (not method)
2481 (gnus-server-equal method "native"))
2482 group
2483 (concat (format "%s" (car method))
2484 (when (and
2485 (or (assoc (format "%s" (car method))
2486 (gnus-methods-using 'address))
2487 (gnus-server-equal method gnus-message-archive-method))
2488 (nth 1 method)
2489 (not (string= (nth 1 method) "")))
2490 (concat "+" (nth 1 method)))
2491 ":" group)))
2493 (defun gnus-group-real-prefix (group)
2494 "Return the prefix of the current group name."
2495 (if (string-match "^[^:]+:" group)
2496 (substring group 0 (match-end 0))
2497 ""))
2499 (defun gnus-group-method (group)
2500 "Return the server or method used for selecting GROUP.
2501 You should probably use `gnus-find-method-for-group' instead."
2502 (let ((prefix (gnus-group-real-prefix group)))
2503 (if (equal prefix "")
2504 gnus-select-method
2505 (let ((servers gnus-opened-servers)
2506 (server "")
2507 backend possible found)
2509 (setq backend (intern (substring prefix 0 (1- (match-end 0))))
2510 server (substring prefix (match-end 0) (1- (length prefix))))
2511 (setq backend (intern (substring prefix 0 (1- (length prefix))))))
2512 (while servers
2513 (when (eq (caaar servers) backend)
2514 (setq possible (caar servers))
2515 (when (equal (cadaar servers) server)
2516 (setq found (caar servers))))
2517 (pop servers))
2518 (or (car (rassoc found gnus-server-alist))
2519 found
2520 (car (rassoc possible gnus-server-alist))
2521 possible
2522 (list backend server))))))
2524 (defsubst gnus-native-method-p (method)
2525 "Return whether METHOD is the native select method."
2526 (gnus-method-equal method gnus-select-method))
2528 (defsubst gnus-secondary-method-p (method)
2529 "Return whether METHOD is a secondary select method."
2530 (let ((methods gnus-secondary-select-methods)
2531 (gmethod (gnus-server-get-method nil method)))
2532 (while (and methods
2533 (not (gnus-method-equal
2534 (gnus-server-get-method nil (car methods))
2535 gmethod)))
2536 (setq methods (cdr methods)))
2537 methods))
2539 (defun gnus-method-simplify (method)
2540 "Return the shortest uniquely identifying string or method for METHOD."
2541 (cond ((stringp method)
2542 method)
2543 ((gnus-native-method-p method)
2544 nil)
2545 ((gnus-secondary-method-p method)
2546 (format "%s:%s" (nth 0 method) (nth 1 method)))
2547 (t
2548 method)))
2550 (defun gnus-groups-from-server (server)
2551 "Return a list of all groups that are fetched from SERVER."
2552 (let ((alist (cdr gnus-newsrc-alist))
2553 info groups)
2554 (while (setq info (pop alist))
2555 (when (gnus-server-equal (gnus-info-method info) server)
2556 (push (gnus-info-group info) groups)))
2557 (sort groups 'string<)))
2559 (defun gnus-group-foreign-p (group)
2560 "Say whether a group is foreign or not."
2561 (and (not (gnus-group-native-p group))
2562 (not (gnus-group-secondary-p group))))
2564 (defun gnus-group-native-p (group)
2565 "Say whether the group is native or not."
2566 (not (string-match ":" group)))
2568 (defun gnus-group-secondary-p (group)
2569 "Say whether the group is secondary or not."
2570 (gnus-secondary-method-p (gnus-find-method-for-group group)))
2572 (defun gnus-group-find-parameter (group &optional symbol allow-list)
2573 "Return the group parameters for GROUP.
2574 If SYMBOL, return the value of that symbol in the group parameters."
2575 (save-excursion
2576 (set-buffer gnus-group-buffer)
2577 (let ((parameters (funcall gnus-group-get-parameter-function group)))
2578 (if symbol
2579 (gnus-group-parameter-value parameters symbol allow-list)
2580 parameters))))
2582 (defun gnus-group-get-parameter (group &optional symbol allow-list)
2583 "Return the group parameters for GROUP.
2584 If SYMBOL, return the value of that symbol in the group parameters.
2585 Most functions should use `gnus-group-find-parameter', which
2586 also examines the topic parameters."
2587 (let ((params (gnus-info-params (gnus-get-info group))))
2588 (if symbol
2589 (gnus-group-parameter-value params symbol allow-list)
2590 params)))
2592 (defun gnus-group-parameter-value (params symbol &optional allow-list)
2593 "Return the value of SYMBOL in group PARAMS."
2594 ;; We only wish to return group parameters (dotted lists) and
2595 ;; not local variables, which may have the same names.
2596 ;; But first we handle single elements...
2597 (or (car (memq symbol params))
2598 ;; Handle alist.
2599 (let (elem)
2600 (catch 'found
2601 (while (setq elem (pop params))
2602 (when (and (consp elem)
2603 (eq (car elem) symbol)
2604 (or allow-list
2605 (atom (cdr elem))))
2606 (throw 'found (cdr elem))))))))
2608 (defun gnus-group-add-parameter (group param)
2609 "Add parameter PARAM to GROUP."
2610 (let ((info (gnus-get-info group)))
2611 (when info
2612 (gnus-group-remove-parameter group (if (consp param) (car param) param))
2613 ;; Cons the new param to the old one and update.
2614 (gnus-group-set-info (cons param (gnus-info-params info))
2615 group 'params))))
2617 (defun gnus-group-set-parameter (group name value)
2618 "Set parameter NAME to VALUE in GROUP."
2619 (let ((info (gnus-get-info group)))
2620 (when info
2621 (gnus-group-remove-parameter group name)
2622 (let ((old-params (gnus-info-params info))
2623 (new-params (list (cons name value))))
2624 (while old-params
2625 (when (or (not (listp (car old-params)))
2626 (not (eq (caar old-params) name)))
2627 (setq new-params (append new-params (list (car old-params)))))
2628 (setq old-params (cdr old-params)))
2629 (gnus-group-set-info new-params group 'params)))))
2631 (defun gnus-group-remove-parameter (group name)
2632 "Remove parameter NAME from GROUP."
2633 (let ((info (gnus-get-info group)))
2634 (when info
2635 (let ((params (gnus-info-params info)))
2636 (when params
2637 (setq params (delq name params))
2638 (while (assq name params)
2639 (gnus-pull name params))
2640 (gnus-info-set-params info params))))))
2642 (defun gnus-group-add-score (group &optional score)
2643 "Add SCORE to the GROUP score.
2644 If SCORE is nil, add 1 to the score of GROUP."
2645 (let ((info (gnus-get-info group)))
2646 (when info
2647 (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
2649 (defun gnus-short-group-name (group &optional levels)
2650 "Collapse GROUP name LEVELS.
2651 Select methods are stripped and any remote host name is stripped down to
2652 just the host name."
2653 (let* ((name "")
2654 (foreign "")
2655 (depth 0)
2656 (skip 1)
2657 (levels (or levels
2658 gnus-group-uncollapsed-levels
2659 (progn
2661 (setq skip (match-end 0)
2662 depth (+ depth 1)))
2663 depth))))
2664 ;; Separate foreign select method from group name and collapse.
2665 ;; If method contains a server, collapse to non-domain server name,
2666 ;; otherwise collapse to select method.
2667 (let* ((colon (string-match ":" group))
2668 (server (and colon (substring group 0 colon)))
2669 (plus (and server (string-match "+" server))))
2670 (when server
2671 (if plus
2672 (setq foreign (substring server (+ 1 plus)
2674 group (substring group (+ 1 colon)))
2675 (setq foreign server
2676 group (substring group (+ 1 colon))))
2677 (setq foreign (concat foreign ":")))
2678 ;; Collapse group name leaving LEVELS uncollapsed elements
2679 (let* ((slist (split-string group "/"))
2680 (slen (length slist))
2682 (dlen (length dlist))
2683 glist
2684 glen
2685 gsep
2686 res)
2687 (if (> slen dlen)
2688 (setq glist slist
2689 glen slen
2690 gsep "/")
2691 (setq glist dlist
2692 glen dlen
2693 gsep "."))
2694 (setq levels (- glen levels))
2695 (dolist (g glist)
2696 (push (if (>= (decf levels) 0)
2697 (if (zerop (length g))
2698 ""
2699 (substring g 0 1))
2700 g)
2701 res))
2702 (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
2704 (defun gnus-narrow-to-body ()
2705 "Narrow to the body of an article."
2706 (narrow-to-region
2707 (progn
2708 (goto-char (point-min))
2710 (point-max)))
2711 (point-max)))
2713 \f
2714 ;;;
2715 ;;; Kill file handling.
2716 ;;;
2718 (defun gnus-apply-kill-file ()
2719 "Apply a kill file to the current newsgroup.
2720 Returns the number of articles marked as read."
2721 (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
2722 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
2723 (gnus-apply-kill-file-internal)
2724 0))
2726 (defun gnus-kill-save-kill-buffer ()
2727 (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
2728 (when (get-file-buffer file)
2729 (save-excursion
2730 (set-buffer (get-file-buffer file))
2731 (when (buffer-modified-p)
2732 (save-buffer))
2733 (kill-buffer (current-buffer))))))
2735 (defcustom gnus-kill-file-name "KILL"
2736 "Suffix of the kill files."
2737 :group 'gnus-score-kill
2738 :group 'gnus-score-files
2739 :type 'string)
2741 (defun gnus-newsgroup-kill-file (newsgroup)
2742 "Return the name of a kill file name for NEWSGROUP.
2743 If NEWSGROUP is nil, return the global kill file name instead."
2744 (cond
2745 ;; The global KILL file is placed at top of the directory.
2746 ((or (null newsgroup)
2747 (string-equal newsgroup ""))
2748 (expand-file-name gnus-kill-file-name
2749 gnus-kill-files-directory))
2750 ;; Append ".KILL" to newsgroup name.
2751 ((gnus-use-long-file-name 'not-kill)
2752 (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
2753 "." gnus-kill-file-name)
2754 gnus-kill-files-directory))
2755 ;; Place "KILL" under the hierarchical directory.
2756 (t
2757 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
2758 "/" gnus-kill-file-name)
2759 gnus-kill-files-directory))))
2761 ;;; Server things.
2763 (defun gnus-member-of-valid (symbol group)
2765 (memq symbol (assoc
2766 (symbol-name (car (gnus-find-method-for-group group)))
2767 gnus-valid-select-methods)))
2769 (defun gnus-method-option-p (method option)
2770 "Return non-nil if select METHOD has OPTION as a parameter."
2771 (when (stringp method)
2772 (setq method (gnus-server-to-method method)))
2773 (memq option (assoc (format "%s" (car method))
2774 gnus-valid-select-methods)))
2776 (defun gnus-similar-server-opened (method)
2777 (let ((opened gnus-opened-servers))
2778 (while (and method opened)
2779 (when (and (equal (cadr method) (cadaar opened))
2780 (equal (car method) (caaar opened))
2781 (not (equal method (caar opened))))
2782 (setq method nil))
2783 (pop opened))
2784 (not method)))
2786 (defun gnus-server-extend-method (group method)
2787 ;; This function "extends" a virtual server. If the server is
2788 ;; "hello", and the select method is ("hello" (my-var "something"))
2789 ;; in the group "alt.alt", this will result in a new virtual server
2790 ;; called "hello+alt.alt".
2791 (if (or (not (inline (gnus-similar-server-opened method)))
2792 (not (cddr method)))
2793 method
2794 `(,(car method) ,(concat (cadr method) "+" group)
2795 (,(intern (format "%s-address" (car method))) ,(cadr method))
2796 ,@(cddr method))))
2798 (defun gnus-server-status (method)
2799 "Return the status of METHOD."
2800 (nth 1 (assoc method gnus-opened-servers)))
2802 (defun gnus-group-name-to-method (group)
2803 "Guess a select method based on GROUP."
2804 (if (string-match ":" group)
2805 (let ((server (substring group 0 (match-beginning 0))))
2807 (list (intern (substring server 0 (match-beginning 0)))
2808 (substring server (match-end 0)))
2809 (list (intern server) "")))
2810 gnus-select-method))
2812 (defun gnus-find-method-for-group (group &optional info)
2813 "Find the select method that GROUP uses."
2814 (or gnus-override-method
2815 (and (not group)
2816 gnus-select-method)
2817 (and (not (gnus-group-entry group));; a new group
2818 (gnus-group-name-to-method group))
2819 (let ((info (or info (gnus-get-info group)))
2820 method)
2821 (if (or (not info)
2822 (not (setq method (gnus-info-method info)))
2823 (equal method "native"))
2824 gnus-select-method
2825 (setq method
2826 (cond ((stringp method)
2827 (inline (gnus-server-to-method method)))
2828 ((stringp (cadr method))
2829 (inline (gnus-server-extend-method group method)))
2830 (t
2831 method)))
2832 (cond ((equal (cadr method) "")
2833 method)
2834 ((null (cadr method))
2835 (list (car method) ""))
2836 (t
2837 (gnus-server-add-address method)))))))
2839 (defun gnus-methods-using (feature)
2840 "Find all methods that have FEATURE."
2841 (let ((valids gnus-valid-select-methods)
2842 outs)
2843 (while valids
2844 (when (memq feature (car valids))
2845 (push (car valids) outs))
2846 (setq valids (cdr valids)))
2847 outs))
2849 (defun gnus-read-group (prompt &optional default)
2850 "Prompt the user for a group name.
2851 Disallow invalid group names."
2852 (let ((prefix "")
2853 group)
2854 (while (not group)
2855 (when (string-match
2856 gnus-invalid-group-regexp
2857 (setq group (read-string (concat prefix prompt)
2858 (cons (or default "") 0)
2859 'gnus-group-history)))
2861 group nil)))
2862 group))
2864 (defun gnus-read-method (prompt)
2865 "Prompt the user for a method.
2866 Allow completion over sensible values."
2867 (let* ((servers
2868 (append gnus-valid-select-methods
2869 (mapcar (lambda (i) (list (format "%s:%s" (caar i)
2870 (cadar i))))
2871 gnus-opened-servers)
2872 gnus-predefined-server-alist
2873 gnus-server-alist))
2874 (method
2875 (completing-read
2876 prompt servers
2877 nil t nil 'gnus-method-history)))
2878 (cond
2879 ((equal method "")
2880 (setq method gnus-select-method))
2881 ((assoc method gnus-valid-select-methods)
2882 (let ((address (if (memq 'prompt-address
2883 (assoc method gnus-valid-select-methods))
2884 (read-string "Address: ")
2885 "")))
2886 (or (let ((opened gnus-opened-servers))
2887 (while (and opened
2888 (not (equal (format "%s:%s" method address)
2889 (format "%s:%s" (caaar opened)
2890 (cadaar opened)))))
2891 (pop opened))
2892 (caar opened))
2893 (list (intern method) address))))
2894 ((assoc method servers)
2895 method)
2896 (t
2897 (list (intern method) "")))))
2899 ;;; User-level commands.
2901 ;;;###autoload
2902 (defun gnus-slave-no-server (&optional arg)
2903 "Read network news as a slave, without connecting to local server."
2904 (interactive "P")
2905 (gnus-no-server arg t))
2907 ;;;###autoload
2908 (defun gnus-no-server (&optional arg slave)
2909 "Read network news.
2910 If ARG is a positive number, Gnus will use that as the
2911 startup level. If ARG is nil, Gnus will be started at level 2.
2912 If ARG is non-nil and not a positive number, Gnus will
2913 prompt the user for the name of an NNTP server to use.
2914 As opposed to `gnus', this command will not connect to the local server."
2915 (interactive "P")
2916 (gnus-no-server-1 arg slave))
2918 ;;;###autoload
2919 (defun gnus-slave (&optional arg)
2920 "Read news as a slave."
2921 (interactive "P")
2922 (gnus arg nil 'slave))
2924 ;;;###autoload
2925 (defun gnus-other-frame (&optional arg)
2926 "Pop up a frame to read news."
2927 (interactive "P")
2928 (let ((window (get-buffer-window gnus-group-buffer)))
2929 (cond (window
2930 (select-frame (window-frame window)))
2931 (t
2932 (select-frame (make-frame)))))
2933 (gnus arg))
2935 ;;(setq thing ? ; this is a comment
2936 ;; more 'yes)
2938 ;;;###autoload
2939 (defun gnus (&optional arg dont-connect slave)
2940 "Read network news.
2941 If ARG is non-nil and a positive number, Gnus will use that as the
2942 startup level. If ARG is non-nil and not a positive number, Gnus will
2943 prompt the user for the name of an NNTP server to use."
2944 (interactive "P")
2945 (gnus-1 arg dont-connect slave))
2947 ;; Allow redefinition of Gnus functions.
2949 (gnus-ems-redefine)
2951 (provide 'gnus)
2953 ;;; gnus.el ends here