1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 (eval '(run-hooks 'gnus-load-hook))
34 "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
37 (defgroup gnus-start nil
38 "Starting your favorite newsreader."
41 (defgroup gnus-score nil
42 "Score and kill file handling."
45 (defconst gnus-version-number "0.46"
46 "Version number for this version of Gnus.")
48 (defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
49 "Version string for this version of Gnus.")
51 (defcustom gnus-inhibit-startup-message nil
52 "*If non-nil, the startup message will not be displayed."
56 (defcustom gnus-play-startup-jingle nil
57 "If non-nil, play the Gnus jingle at startup."
61 ;;; Kludges to help the transition from the old `custom.el'.
63 ;; XEmacs and Emacs 19.29 facep does different things.
64 (defalias 'custom-facep
65 (cond ((fboundp 'find-face)
72 ;; The XEmacs people think this is evil, so it must go.
73 (defun custom-face-lookup (&optional fg bg stipple bold italic underline)
74 "Lookup or create a face with specified attributes."
75 (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
78 (or stipple "default")
79 bold italic underline))))
80 (if (and (custom-facep name)
83 (copy-face 'default name)
85 (not (string-equal fg "default")))
87 (set-face-foreground name fg)
90 (not (string-equal bg "default")))
92 (set-face-background name bg)
95 (not (string-equal stipple "default"))
96 (not (eq stipple 'custom:asis))
97 (fboundp 'set-face-stipple))
98 (set-face-stipple name stipple))
100 (not (eq bold 'custom:asis)))
102 (make-face-bold name)
105 (not (eq italic 'custom:asis)))
107 (make-face-italic name)
110 (not (eq underline 'custom:asis)))
112 (set-face-underline-p name t)
116 ;;; Internal variables
118 (defvar gnus-group-buffer "*Group*")
121 (autoload 'gnus-play-jingle "gnus-audio"))
125 (defun gnus-splash ()
127 (switch-to-buffer gnus-group-buffer)
128 (let ((buffer-read-only nil))
130 (unless gnus-inhibit-startup-message
131 (gnus-group-startup-message)
133 (when gnus-play-startup-jingle
134 (gnus-play-jingle))))))
136 (defun gnus-indent-rigidly (start end arg)
137 "Indent rigidly using only spaces and no tabs."
140 (narrow-to-region start end)
141 (indent-rigidly start end arg)
142 ;; We translate tabs into spaces -- not everybody uses
143 ;; an 8-character tab.
144 (goto-char (point-min))
145 (while (search-forward "\t" nil t)
146 (replace-match " " t t)))))
148 (defun gnus-group-startup-message (&optional x y)
149 "Insert startup message in current buffer."
150 ;; Insert the message.
155 _ ___ __ ___ __ _ ___
175 (gnus-indent-rigidly (point-min) (point-max)
176 (/ (max (- (window-width) (or x 46)) 0) 2))
177 (goto-char (point-min))
179 (let* ((pheight (count-lines (point-min) (point-max)))
180 (wheight (window-height))
181 (rest (- wheight pheight)))
182 (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
184 (goto-char (point-min))
185 (when (search-forward "Praxis" nil t)
186 (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
187 (goto-char (point-min))
188 (setq mode-line-buffer-identification gnus-version)
189 (set-buffer-modified-p t))
192 (let ((command (format "%s" this-command)))
193 (when (and (string-match "gnus" command)
194 (not (string-match "gnus-other-frame" command)))
203 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
204 ;; If you want the cursor to go somewhere else, set these two
205 ;; functions in some startup hook to whatever you want.
206 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
207 (defalias 'gnus-group-position-point 'gnus-goto-colon)
209 ;;; Various macros and substs.
211 (defun gnus-header-from (header)
212 (mail-header-from header))
214 (defmacro gnus-gethash (string hashtable)
215 "Get hash value of STRING in HASHTABLE."
216 `(symbol-value (intern-soft ,string ,hashtable)))
218 (defmacro gnus-sethash (string value hashtable)
219 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
220 `(set (intern ,string ,hashtable) ,value))
221 (put 'nnheader-temp-write 'edebug-form-spec '(form form form))
223 (defmacro gnus-group-unread (group)
224 "Get the currently computed number of unread articles in GROUP."
225 `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
227 (defmacro gnus-group-entry (group)
228 "Get the newsrc entry for GROUP."
229 `(gnus-gethash ,group gnus-newsrc-hashtb))
231 (defmacro gnus-active (group)
232 "Get active info on GROUP."
233 `(gnus-gethash ,group gnus-active-hashtb))
235 (defmacro gnus-set-active (group active)
236 "Set GROUP's active info."
237 `(gnus-sethash ,group ,active gnus-active-hashtb))
239 (defun gnus-alive-p ()
240 "Say whether Gnus is running or not."
241 (and gnus-group-buffer
242 (get-buffer gnus-group-buffer)
244 (set-buffer gnus-group-buffer)
245 (eq major-mode 'gnus-group-mode))))
247 ;; Info access macros.
249 (defmacro gnus-info-group (info)
251 (defmacro gnus-info-rank (info)
253 (defmacro gnus-info-read (info)
255 (defmacro gnus-info-marks (info)
257 (defmacro gnus-info-method (info)
259 (defmacro gnus-info-params (info)
262 (defmacro gnus-info-level (info)
263 `(let ((rank (gnus-info-rank ,info)))
267 (defmacro gnus-info-score (info)
268 `(let ((rank (gnus-info-rank ,info)))
269 (or (and (consp rank) (cdr rank)) 0)))
271 (defmacro gnus-info-set-group (info group)
272 `(setcar ,info ,group))
273 (defmacro gnus-info-set-rank (info rank)
274 `(setcar (nthcdr 1 ,info) ,rank))
275 (defmacro gnus-info-set-read (info read)
276 `(setcar (nthcdr 2 ,info) ,read))
277 (defmacro gnus-info-set-marks (info marks &optional extend)
279 `(gnus-info-set-entry ,info ,marks 3)
280 `(setcar (nthcdr 3 ,info) ,marks)))
281 (defmacro gnus-info-set-method (info method &optional extend)
283 `(gnus-info-set-entry ,info ,method 4)
284 `(setcar (nthcdr 4 ,info) ,method)))
285 (defmacro gnus-info-set-params (info params &optional extend)
287 `(gnus-info-set-entry ,info ,params 5)
288 `(setcar (nthcdr 5 ,info) ,params)))
290 (defun gnus-info-set-entry (info entry number)
291 ;; Extend the info until we have enough elements.
292 (while (< (length info) number)
293 (nconc info (list nil)))
295 (setcar (nthcdr number info) entry))
297 (defmacro gnus-info-set-level (info level)
298 `(let ((rank (cdr ,info)))
299 (if (consp (car rank))
300 (setcar (car rank) ,level)
301 (setcar rank ,level))))
302 (defmacro gnus-info-set-score (info score)
303 `(let ((rank (cdr ,info)))
304 (if (consp (car rank))
305 (setcdr (car rank) ,score)
306 (setcar rank (cons (car rank) ,score)))))
308 (defmacro gnus-get-info (group)
309 `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
311 ;; Byte-compiler warning.
313 ;; Find out whether the gnus-visual TYPE is wanted.
314 (defun gnus-visual-p (&optional type class)
315 (and gnus-visual ; Has to be non-nil, at least.
316 (if (not type) ; We don't care about type.
318 (if (listp gnus-visual) ; It's a list, so we check it.
319 (or (memq type gnus-visual)
320 (memq class gnus-visual))
323 ;;; Load the compatability functions.
332 (defvar gnus-shutdown-alist nil)
334 (defun gnus-add-shutdown (function &rest symbols)
335 "Run FUNCTION whenever one of SYMBOLS is shut down."
336 (push (cons function symbols) gnus-shutdown-alist))
338 (defun gnus-shutdown (symbol)
339 "Shut down everything that waits for SYMBOL."
340 (let ((alist gnus-shutdown-alist)
342 (while (setq entry (pop alist))
343 (when (memq symbol (cdr entry))
344 (funcall (car entry))))))
348 ;;; Gnus Utility Functions
351 ;; Add the current buffer to the list of buffers to be killed on exit.
352 (defun gnus-add-current-to-buffer-list ()
353 (or (memq (current-buffer) gnus-buffer-list)
354 (push (current-buffer) gnus-buffer-list)))
356 (defun gnus-version (&optional arg)
357 "Version number of this version of Gnus.
358 If ARG, insert string at point."
360 (let ((methods gnus-valid-select-methods)
363 ;; Go through all the legal select methods and add their version
364 ;; numbers to the total version string. Only the backends that are
365 ;; currently in use will have their message numbers taken into
368 (setq meth (intern (concat (caar methods) "-version")))
370 (stringp (symbol-value meth))
371 (setq mess (concat mess "; " (symbol-value meth))))
372 (setq methods (cdr methods)))
374 (insert (message mess))
377 (defun gnus-continuum-version (version)
378 "Return VERSION as a floating point number."
379 (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
380 (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
381 (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
382 (number (match-string 2 version))
384 (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
385 (setq major (string-to-number (match-string 1 number)))
386 (setq minor (string-to-number (match-string 2 number)))
387 (setq least (if (match-beginning 3)
388 (string-to-number (match-string 3 number))
392 (format "%s00%02d%02d"
394 ((member alpha '("(ding)" "d")) "4.99")
395 ((member alpha '("September" "s")) "5.01")
396 ((member alpha '("Red" "r")) "5.03"))
398 (format "%d.%02d%02d" major minor least))))))
400 (defun gnus-info-find-node ()
401 "Find Info documentation of Gnus."
403 ;; Enlarge info window if needed.
404 (let (gnus-info-buffer)
405 (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
406 (setq gnus-info-buffer (current-buffer))
407 (gnus-configure-windows 'info)))
409 ;;; More various functions.
411 (defun gnus-group-read-only-p (&optional group)
412 "Check whether GROUP supports editing or not.
413 If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
414 that that variable is buffer-local to the summary buffers."
415 (let ((group (or group gnus-newsgroup-name)))
416 (not (gnus-check-backend-function 'request-replace-article group))))
418 (defun gnus-group-total-expirable-p (group)
419 "Check whether GROUP is total-expirable or not."
420 (let ((params (gnus-group-find-parameter group))
423 ((memq 'total-expire params)
425 ((setq val (assq 'total-expire params)) ; (auto-expire . t)
427 (gnus-total-expirable-newsgroups ; Check var.
428 (string-match gnus-total-expirable-newsgroups group)))))
430 (defun gnus-group-auto-expirable-p (group)
431 "Check whether GROUP is total-expirable or not."
432 (let ((params (gnus-group-find-parameter group))
435 ((memq 'auto-expire params)
437 ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
439 (gnus-auto-expirable-newsgroups ; Check var.
440 (string-match gnus-auto-expirable-newsgroups group)))))
442 (defun gnus-virtual-group-p (group)
443 "Say whether GROUP is virtual or not."
444 (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
445 gnus-valid-select-methods)))
447 (defun gnus-news-group-p (group &optional article)
448 "Return non-nil if GROUP (and ARTICLE) come from a news server."
449 (or (gnus-member-of-valid 'post group) ; Ordinary news group.
450 (and (gnus-member-of-valid 'post-mail group) ; Combined group.
451 (eq (gnus-request-type group article) 'news))))
453 ;; Returns a list of writable groups.
454 (defun gnus-writable-groups ()
455 (let ((alist gnus-newsrc-alist)
457 (while (setq group (car (pop alist)))
458 (unless (gnus-group-read-only-p group)
459 (push group groups)))
462 ;; Check whether to use long file names.
463 (defun gnus-use-long-file-name (symbol)
464 ;; The variable has to be set...
465 (and gnus-use-long-file-name
466 ;; If it isn't a list, then we return t.
467 (or (not (listp gnus-use-long-file-name))
468 ;; If it is a list, and the list contains `symbol', we
470 (not (memq symbol gnus-use-long-file-name)))))
472 ;; Generate a unique new group name.
473 (defun gnus-generate-new-group-name (leaf)
476 (while (gnus-gethash name gnus-newsrc-hashtb)
477 (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
480 (defun gnus-ephemeral-group-p (group)
481 "Say whether GROUP is ephemeral or not."
482 (gnus-group-get-parameter group 'quit-config))
484 (defun gnus-group-quit-config (group)
485 "Return the quit-config of GROUP."
486 (gnus-group-get-parameter group 'quit-config))
488 (defun gnus-kill-ephemeral-group (group)
489 "Remove ephemeral GROUP from relevant structures."
490 (gnus-sethash group nil gnus-newsrc-hashtb))
492 (defun gnus-simplify-mode-line ()
493 "Make mode lines a bit simpler."
494 (setq mode-line-modified "-- ")
495 (when (listp mode-line-format)
496 (make-local-variable 'mode-line-format)
497 (setq mode-line-format (copy-sequence mode-line-format))
498 (when (equal (nth 3 mode-line-format) " ")
499 (setcar (nthcdr 3 mode-line-format) " "))))
501 ;;; Servers and groups.
503 (defsubst gnus-server-add-address (method)
504 (let ((method-name (symbol-name (car method))))
505 (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
506 (not (assq (intern (concat method-name "-address")) method)))
507 (append method (list (list (intern (concat method-name "-address"))
511 (defsubst gnus-server-get-method (group method)
512 ;; Input either a server name, and extended server name, or a
513 ;; select method, and return a select method.
514 (cond ((stringp method)
515 (gnus-server-to-method method))
516 ((equal method gnus-select-method)
518 ((and (stringp (car method)) group)
519 (gnus-server-extend-method group method))
520 ((and method (not group)
521 (equal (cadr method) ""))
524 (gnus-server-add-address method))))
526 (defun gnus-server-to-method (server)
527 "Map virtual server names to select methods."
529 ;; Is this a method, perhaps?
530 (and server (listp server) server)
531 ;; Perhaps this is the native server?
532 (and (equal server "native") gnus-select-method)
533 ;; It should be in the server alist.
534 (cdr (assoc server gnus-server-alist))
535 ;; It could be in the predefined server alist.
536 (cdr (assoc server gnus-predefined-server-alist))
537 ;; If not, we look through all the opened server
538 ;; to see whether we can find it there.
539 (let ((opened gnus-opened-servers))
541 (not (equal server (format "%s:%s" (caaar opened)
546 (defmacro gnus-method-equal (ss1 ss2)
547 "Say whether two servers are equal."
551 (and (= (length s1) (length s2))
553 (while (and s1 (member (car s1) s2))
557 (defun gnus-server-equal (m1 m2)
558 "Say whether two methods are equal."
559 (let ((m1 (cond ((null m1) gnus-select-method)
560 ((stringp m1) (gnus-server-to-method m1))
562 (m2 (cond ((null m2) gnus-select-method)
563 ((stringp m2) (gnus-server-to-method m2))
565 (gnus-method-equal m1 m2)))
567 (defun gnus-servers-using-backend (backend)
568 "Return a list of known servers using BACKEND."
569 (let ((opened gnus-opened-servers)
572 (when (eq backend (caaar opened))
573 (push (caar opened) out))
577 (defun gnus-archive-server-wanted-p ()
578 "Say whether the user wants to use the archive server."
580 ((or (not gnus-message-archive-method)
581 (not gnus-message-archive-group))
583 ((and gnus-message-archive-method gnus-message-archive-group)
586 (let ((active (cadr (assq 'nnfolder-active-file
587 gnus-message-archive-method))))
589 (file-exists-p active))))))
591 (defun gnus-group-prefixed-name (group method)
592 "Return the whole name from GROUP and METHOD."
593 (and (stringp method) (setq method (gnus-server-to-method method)))
596 (concat (format "%s" (car method))
598 (or (assoc (format "%s" (car method))
599 (gnus-methods-using 'address))
600 (gnus-server-equal method gnus-message-archive-method))
602 (not (string= (nth 1 method) "")))
603 (concat "+" (nth 1 method)))
606 (defun gnus-group-real-prefix (group)
607 "Return the prefix of the current group name."
608 (if (string-match "^[^:]+:" group)
609 (substring group 0 (match-end 0))
612 (defun gnus-group-method (group)
613 "Return the server or method used for selecting GROUP."
614 (let ((prefix (gnus-group-real-prefix group)))
615 (if (equal prefix "")
617 (let ((servers gnus-opened-servers)
619 backend possible found)
620 (if (string-match "^[^\\+]+\\+" prefix)
621 (setq backend (intern (substring prefix 0 (1- (match-end 0))))
622 server (substring prefix (match-end 0) (1- (length prefix))))
623 (setq backend (intern (substring prefix 0 (1- (length prefix))))))
625 (when (eq (caaar servers) backend)
626 (setq possible (caar servers))
627 (when (equal (cadaar servers) server)
628 (setq found (caar servers))))
630 (or (car (rassoc found gnus-server-alist))
632 (car (rassoc possible gnus-server-alist))
634 (list backend server))))))
636 (defsubst gnus-secondary-method-p (method)
637 "Return whether METHOD is a secondary select method."
638 (let ((methods gnus-secondary-select-methods)
639 (gmethod (gnus-server-get-method nil method)))
641 (not (equal (gnus-server-get-method nil (car methods))
643 (setq methods (cdr methods)))
646 (defun gnus-group-foreign-p (group)
647 "Say whether a group is foreign or not."
648 (and (not (gnus-group-native-p group))
649 (not (gnus-group-secondary-p group))))
651 (defun gnus-group-native-p (group)
652 "Say whether the group is native or not."
653 (not (string-match ":" group)))
655 (defun gnus-group-secondary-p (group)
656 "Say whether the group is secondary or not."
657 (gnus-secondary-method-p (gnus-find-method-for-group group)))
659 (defun gnus-group-find-parameter (group &optional symbol)
660 "Return the group parameters for GROUP.
661 If SYMBOL, return the value of that symbol in the group parameters."
663 (set-buffer gnus-group-buffer)
664 (let ((parameters (funcall gnus-group-get-parameter-function group)))
666 (gnus-group-parameter-value parameters symbol)
669 (defun gnus-group-get-parameter (group &optional symbol)
670 "Return the group parameters for GROUP.
671 If SYMBOL, return the value of that symbol in the group parameters."
672 (let ((params (gnus-info-params (gnus-get-info group))))
674 (gnus-group-parameter-value params symbol)
677 (defun gnus-group-parameter-value (params symbol)
678 "Return the value of SYMBOL in group PARAMS."
679 (or (car (memq symbol params)) ; It's either a simple symbol
680 (cdr (assq symbol params)))) ; or a cons.
682 (defun gnus-group-add-parameter (group param)
683 "Add parameter PARAM to GROUP."
684 (let ((info (gnus-get-info group)))
686 () ; This is a dead group. We just ignore it.
687 ;; Cons the new param to the old one and update.
688 (gnus-group-set-info (cons param (gnus-info-params info))
691 (defun gnus-group-set-parameter (group name value)
692 "Set parameter NAME to VALUE in GROUP."
693 (let ((info (gnus-get-info group)))
695 () ; This is a dead group. We just ignore it.
696 (let ((old-params (gnus-info-params info))
697 (new-params (list (cons name value))))
699 (when (or (not (listp (car old-params)))
700 (not (eq (caar old-params) name)))
701 (setq new-params (append new-params (list (car old-params)))))
702 (setq old-params (cdr old-params)))
703 (gnus-group-set-info new-params group 'params)))))
705 (defun gnus-group-add-score (group &optional score)
706 "Add SCORE to the GROUP score.
707 If SCORE is nil, add 1 to the score of GROUP."
708 (let ((info (gnus-get-info group)))
710 (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
712 ;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
713 (defun gnus-short-group-name (group &optional levels)
714 "Collapse GROUP name LEVELS.
715 Select methods are stripped and any remote host name is stripped down to
717 (let* ((name "") (foreign "") (depth -1) (skip 1)
720 (while (string-match "\\." group skip)
721 (setq skip (match-end 0)
724 ;; separate foreign select method from group name and collapse.
725 ;; if method contains a server, collapse to non-domain server name,
726 ;; otherwise collapse to select method
727 (when (string-match ":" group)
728 (cond ((string-match "+" group)
729 (let* ((plus (string-match "+" group))
730 (colon (string-match ":" group))
731 (dot (string-match "\\." group)))
732 (setq foreign (concat
733 (substring group (+ 1 plus)
734 (cond ((null dot) colon)
735 ((< colon dot) colon)
736 ((< dot colon) dot)))
738 group (substring group (+ 1 colon))
741 (let* ((colon (string-match ":" group)))
742 (setq foreign (concat (substring group 0 (+ 1 colon)))
743 group (substring group (+ 1 colon)))
745 ;; collapse group name leaving LEVELS uncollapsed elements
747 (if (and (string-match "\\." group) (> levels 0))
748 (setq name (concat name (substring group 0 1))
749 group (substring group (match-end 0))
751 name (concat name "."))
752 (setq name (concat foreign name group)
759 ;;; Kill file handling.
762 (defun gnus-apply-kill-file ()
763 "Apply a kill file to the current newsgroup.
764 Returns the number of articles marked as read."
765 (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
766 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
767 (gnus-apply-kill-file-internal)
770 (defun gnus-kill-save-kill-buffer ()
771 (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
772 (when (get-file-buffer file)
774 (set-buffer (get-file-buffer file))
775 (when (buffer-modified-p)
777 (kill-buffer (current-buffer))))))
779 (defcustom gnus-kill-file-name "KILL"
780 "Suffix of the kill files."
784 (defun gnus-newsgroup-kill-file (newsgroup)
785 "Return the name of a kill file name for NEWSGROUP.
786 If NEWSGROUP is nil, return the global kill file name instead."
788 ;; The global KILL file is placed at top of the directory.
789 ((or (null newsgroup)
790 (string-equal newsgroup ""))
791 (expand-file-name gnus-kill-file-name
792 gnus-kill-files-directory))
793 ;; Append ".KILL" to newsgroup name.
794 ((gnus-use-long-file-name 'not-kill)
795 (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
796 "." gnus-kill-file-name)
797 gnus-kill-files-directory))
798 ;; Place "KILL" under the hierarchical directory.
800 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
801 "/" gnus-kill-file-name)
802 gnus-kill-files-directory))))
806 (defun gnus-member-of-valid (symbol group)
807 "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
809 (symbol-name (car (gnus-find-method-for-group group)))
810 gnus-valid-select-methods)))
812 (defun gnus-method-option-p (method option)
813 "Return non-nil if select METHOD has OPTION as a parameter."
814 (when (stringp method)
815 (setq method (gnus-server-to-method method)))
816 (memq option (assoc (format "%s" (car method))
817 gnus-valid-select-methods)))
819 (defun gnus-server-extend-method (group method)
820 ;; This function "extends" a virtual server. If the server is
821 ;; "hello", and the select method is ("hello" (my-var "something"))
822 ;; in the group "alt.alt", this will result in a new virtual server
823 ;; called "hello+alt.alt".
826 (if (gnus-server-equal method gnus-select-method) gnus-select-method
827 (cdr (assoc (car method) gnus-server-alist))))))
830 (setcar (cdr entry) (concat (nth 1 entry) "+" group))
831 (nconc entry (cdr method)))))
833 (defun gnus-server-status (method)
834 "Return the status of METHOD."
835 (nth 1 (assoc method gnus-opened-servers)))
837 (defun gnus-group-name-to-method (group)
838 "Return a select method suitable for GROUP."
839 (if (string-match ":" group)
840 (let ((server (substring group 0 (match-beginning 0))))
841 (if (string-match "\\+" server)
842 (list (intern (substring server 0 (match-beginning 0)))
843 (substring server (match-end 0)))
844 (list (intern server) "")))
847 (defun gnus-find-method-for-group (group &optional info)
848 "Find the select method that GROUP uses."
849 (or gnus-override-method
852 (let ((info (or info (gnus-get-info group)))
855 (not (setq method (gnus-info-method info)))
856 (equal method "native"))
859 (cond ((stringp method)
860 (gnus-server-to-method method))
861 ((stringp (car method))
862 (gnus-server-extend-method group method))
865 (cond ((equal (cadr method) "")
867 ((null (cadr method))
868 (list (car method) ""))
870 (gnus-server-add-address method)))))))
872 (defun gnus-check-backend-function (func group)
873 "Check whether GROUP supports function FUNC."
874 (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
876 (fboundp (intern (format "%s-%s" method func)))))
878 (defun gnus-methods-using (feature)
879 "Find all methods that have FEATURE."
880 (let ((valids gnus-valid-select-methods)
883 (when (memq feature (car valids))
884 (push (car valids) outs))
885 (setq valids (cdr valids)))
888 (defun gnus-read-method (prompt)
889 "Prompt the user for a method.
890 Allow completion over sensible values."
893 prompt (append gnus-valid-select-methods gnus-predefined-server-alist
895 nil t nil 'gnus-method-history)))
898 (setq method gnus-select-method))
899 ((assoc method gnus-valid-select-methods)
900 (list (intern method)
901 (if (memq 'prompt-address
902 (assoc method gnus-valid-select-methods))
903 (read-string "Address: ")
905 ((assoc method gnus-server-alist)
908 (list (intern method) "")))))
910 ;;; User-level commands.
913 (defun gnus-slave-no-server (&optional arg)
914 "Read network news as a slave, without connecting to local server"
916 (gnus-no-server arg t))
919 (defun gnus-no-server (&optional arg slave)
921 If ARG is a positive number, Gnus will use that as the
922 startup level. If ARG is nil, Gnus will be started at level 2.
923 If ARG is non-nil and not a positive number, Gnus will
924 prompt the user for the name of an NNTP server to use.
925 As opposed to `gnus', this command will not connect to the local server."
927 (gnus-no-server-1 arg slave))
930 (defun gnus-slave (&optional arg)
931 "Read news as a slave."
933 (gnus arg nil 'slave))
936 (defun gnus-other-frame (&optional arg)
937 "Pop up a frame to read news."
940 (let ((pop-up-frames t))
942 (select-frame (make-frame))
946 (defun gnus (&optional arg dont-connect slave)
948 If ARG is non-nil and a positive number, Gnus will use that as the
949 startup level. If ARG is non-nil and not a positive number, Gnus will
950 prompt the user for the name of an NNTP server to use."
952 (gnus-1 arg dont-connect slave))
954 ;; Allow redefinition of Gnus functions.
960 ;;; gnus.el ends here