X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=c02293f54a658dbe0b122d8f23193093b4eb494a;hb=e5bec5d05f433a43fa2d14cdb7bebeeefab8835f;hp=c8204cef401ad5a50f4f7839dada0a3071589d39;hpb=ae2b783ff77305c9e0bef64297d9eb337e4f29e7;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index c8204ce..c02293f 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,5 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -237,7 +237,7 @@ not match this regexp will be removed before saving the list." (defcustom gnus-ignored-newsgroups (mapconcat 'identity '("^to\\." ; not "real" groups - "^[0-9. \t]+ " ; all digits in name + "^[0-9. \t]+\\( \\|$\\)" ; all digits in name "^[\"][]\"[#'()]" ; bogus characters ) "\\|") @@ -249,7 +249,7 @@ thus making them effectively non-existent." :type 'regexp) (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies - "*Function called with a group name when new group is detected. + "*Function(s) called with a group name when new group is detected. A few pre-made functions are supplied: `gnus-subscribe-randomly' inserts new groups at the beginning of the list of groups; `gnus-subscribe-alphabetically' inserts new groups in strict @@ -267,11 +267,18 @@ claim them." (function-item gnus-subscribe-killed) (function-item gnus-subscribe-zombies) (function-item gnus-subscribe-topics) - function)) + function + (repeat function))) + +(defcustom gnus-subscribe-newsgroup-hooks nil + "*Hooks run after you subscribe to a new group. The hooks will be called +with new group's name as argument." + :group 'gnus-group-new + :type 'hook) (defcustom gnus-subscribe-options-newsgroup-method 'gnus-subscribe-alphabetically - "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. + "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines. If, for instance, you want to subscribe to all newsgroups in the \"no\" and \"alt\" hierarchies, you'd put the following in your .newsrc file: @@ -288,7 +295,8 @@ the subscription method in this variable." (function-item gnus-subscribe-killed) (function-item gnus-subscribe-zombies) (function-item gnus-subscribe-topics) - function)) + function + (repeat function))) (defcustom gnus-subscribe-hierarchical-interactive nil "*If non-nil, Gnus will offer to subscribe hierarchically. @@ -536,22 +544,22 @@ Can be used to turn version control on or off." ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (save-excursion (set-buffer (nnheader-find-file-noselect gnus-current-startup-file)) - (let ((groupkey newgroup) - before) - (while (and (not before) groupkey) - (goto-char (point-min)) - (let ((groupkey-re - (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) - (while (and (re-search-forward groupkey-re nil t) - (progn - (setq before (match-string 1)) - (string< before newgroup))))) - ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) - (setq groupkey - (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey) - (substring groupkey (match-beginning 1) (match-end 1))))) - (gnus-subscribe-newsgroup newgroup before)) - (kill-buffer (current-buffer)))) + (prog1 + (let ((groupkey newgroup) before) + (while (and (not before) groupkey) + (goto-char (point-min)) + (let ((groupkey-re + (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) + (while (and (re-search-forward groupkey-re nil t) + (progn + (setq before (match-string 1)) + (string< before newgroup))))) + ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) + (setq groupkey + (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey) + (substring groupkey (match-beginning 1) (match-end 1))))) + (gnus-subscribe-newsgroup newgroup before)) + (kill-buffer (current-buffer))))) (defun gnus-subscribe-interactively (group) "Subscribe the new GROUP interactively. @@ -580,7 +588,9 @@ the first newsgroup." newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) - (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))) + (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) + (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) + t)) (defun gnus-read-active-file-p () "Say whether the active file has been read from `gnus-select-method'." @@ -615,6 +625,12 @@ the first newsgroup." (setq variables (cdr variables)))) (setq files (cdr files))))) +(defun gnus-close-all-servers () + "Close all servers." + (interactive) + (dolist (server gnus-opened-servers) + (gnus-close-server (car server)))) + (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear gnus variables. @@ -817,6 +833,7 @@ cautiously -- unloading may cause trouble." (set-buffer-modified-p nil) (let ((auto (make-auto-save-file-name)) (gnus-dribble-ignore t) + (purpose nil) modes) (when (or (file-exists-p auto) (file-exists-p dribble-file)) ;; Load whichever file is newest -- the auto save file @@ -832,10 +849,15 @@ cautiously -- unloading may cause trouble." (file-exists-p dribble-file) (setq modes (file-modes gnus-current-startup-file))) (set-file-modes dribble-file modes)) + (goto-char (point-min)) + (when (search-forward "Gnus was exited on purpose" nil t) + (setq purpose t)) ;; Possibly eval the file later. (when (or gnus-always-read-dribble-file (gnus-y-or-n-p - "Gnus auto-save file exists. Do you want to read it? ")) + (if purpose + "Gnus exited on purpose without saving; read auto-save file anyway? " + "Gnus auto-save file exists. Do you want to read it? "))) (setq gnus-dribble-eval-file t))))))) (defun gnus-dribble-eval-file () @@ -936,6 +958,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; See whether we need to read the description file. (when (and (boundp 'gnus-group-line-format) + (stringp gnus-group-line-format) (let ((case-fold-search nil)) (string-match "%[-,0-9]*D" gnus-group-line-format)) (not gnus-description-hashtb) @@ -968,6 +991,21 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)))) +(defun gnus-call-subscribe-functions (method group) + "Call METHOD to subscribe GROUP. +If no function returns `non-nil', call `gnus-subscribe-zombies'." + (unless (cond + ((gnus-functionp method) + (funcall method group)) + ((listp method) + (catch 'found + (dolist (func method) + (if (funcall func group) + (throw 'found t))) + nil)) + (t nil)) + (gnus-subscribe-zombies group))) + (defun gnus-find-new-newsgroups (&optional arg) "Search for new newsgroups and add them. Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'. @@ -1020,7 +1058,8 @@ for new groups, and subscribe the new groups as zombies." ((eq do-sub 'subscribe) (setq groups (1+ groups)) (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t @@ -1028,7 +1067,8 @@ for new groups, and subscribe the new groups as zombies." (gnus-sethash group group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) + (gnus-call-subscribe-functions + gnus-subscribe-newsgroup-method group))))))) gnus-active-hashtb) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) @@ -1113,7 +1153,8 @@ for new groups, and subscribe the new groups as zombies." ((eq do-sub 'subscribe) (incf groups) (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t @@ -1121,7 +1162,8 @@ for new groups, and subscribe the new groups as zombies." (gnus-sethash group group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) + (gnus-call-subscribe-functions + gnus-subscribe-newsgroup-method group))))))) hashtb)) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups))) @@ -1163,7 +1205,8 @@ for new groups, and subscribe the new groups as zombies." (cond ((eq do-sub 'subscribe) (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t @@ -1338,7 +1381,9 @@ newsgroup." (setq info (pop newsrc) group (gnus-info-group info)) (unless (or (gnus-active group) ; Active - (gnus-info-method info)) ; Foreign + (and (gnus-info-method info) + (not (gnus-secondary-method-p + (gnus-info-method info))))) ; Foreign ;; Found a bogus newsgroup. (push group bogus))) (if confirm @@ -1527,7 +1572,7 @@ newsgroup." gnus-activate-foreign-newsgroups) (t 0)) level)) - scanned-methods info group active method retrievegroups) + scanned-methods info group active method retrieve-groups) (gnus-message 5 "Checking new news...") (while newsrc @@ -1574,10 +1619,10 @@ newsgroup." (if (gnus-check-backend-function 'retrieve-groups group) ;; if server support gnus-retrieve-groups we push ;; the group onto retrievegroups for later checking - (if (assoc method retrievegroups) - (setcdr (assoc method retrievegroups) - (cons group (cdr (assoc method retrievegroups)))) - (push (list method group) retrievegroups)) + (if (assoc method retrieve-groups) + (setcdr (assoc method retrieve-groups) + (cons group (cdr (assoc method retrieve-groups)))) + (push (list method group) retrieve-groups)) ;; hack: `nnmail-get-new-mail' changes the mail-source depending ;; on the group, so we must perform a scan for every group ;; if the users has any directory mail sources. @@ -1610,21 +1655,21 @@ newsgroup." ;; unread articles and stuff. (gnus-set-active group nil) (let ((tmp (gnus-gethash group gnus-newsrc-hashtb))) - (if tmp (setcar tmp t)))))) + (when tmp + (setcar tmp t)))))) ;; iterate through groups on methods which support gnus-retrieve-groups ;; and fetch a partial active file and use it to find new news. - (while retrievegroups - (let* ((mg (pop retrievegroups)) - (method (or (car mg) gnus-select-method)) - (groups (cdr mg))) + (dolist (rg retrieve-groups) + (let ((method (or (car rg) gnus-select-method)) + (groups (cdr rg))) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. (when (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) - (gnus-read-active-file-2 (mapcar (lambda (group) - (gnus-group-real-name group)) - groups) method) + (gnus-read-active-file-2 + (mapcar (lambda (group) (gnus-group-real-name group)) groups) + method) (dolist (group groups) (cond ((setq active (gnus-active (gnus-info-group @@ -2780,13 +2825,7 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (name (symbol-name group)) (charset (or (gnus-group-name-charset method name) - (let ((alist gnus-group-charset-alist) - elem charset) - (while (setq elem (pop alist)) - (when (and name (string-match (car elem) name)) - (setq alist nil - charset (cadr elem)))) - charset)))) + (gnus-parameter-charset name)))) (when (and str charset (featurep 'mule)) (setq str (decode-coding-string str charset))) (set group str)))