X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=cf4b856ec04f9a301af6b3494241a8611894b240;hb=7064878d80c116f154853a32b3851403815b054b;hp=3bddae8576c5ddbc63775bb42c8580960341b5bc;hpb=3e4ccbd414e896907d6ebd20312aabf6ee720f25;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 3bddae8..cf4b856 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, 2002 ;; 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. @@ -303,7 +311,7 @@ hierarchy in its entirety." :type 'boolean) (defcustom gnus-auto-subscribed-groups - "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" + "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir" "*All new groups that match this regexp will be subscribed automatically. Note that this variable only deals with new groups. It has no effect whatsoever on old groups. @@ -396,18 +404,25 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'hook) +(defcustom gnus-group-mode-hook nil + "Hook for Gnus group mode." + :group 'gnus-group-various + :options '(gnus-topic-mode) + :type 'hook) + (defcustom gnus-always-read-dribble-file nil "Unconditionally read the dribble file." :group 'gnus-newsrc :type 'boolean) -(defvar gnus-startup-file-coding-system (static-if (boundp 'MULE) - '*ctext* - 'ctext) - "*Coding system for startup file.") - ;;; Internal variables +(defvar gnus-ding-file-coding-system (static-if (boundp 'MULE) + '*ctext* + 'ctext) + "Coding system for ding file.") +;; Note that the ding file for T-gnus ought not to have byte-codes. + (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) (defvar gnus-dribble-buffer nil) @@ -434,19 +449,15 @@ Can be used to turn version control on or off." (if gnus-init-inhibit (setq gnus-init-inhibit nil) (setq gnus-init-inhibit inhibit-next) - (let ((files (list gnus-site-init-file gnus-init-file)) - file) - (while files - (and (setq file (pop files)) - (or (and (file-exists-p file) - ;; Don't try to load a directory. - (not (file-directory-p file))) - (file-exists-p (concat file ".el")) - (file-exists-p (concat file ".elc"))) - (condition-case var - (load file nil t) - (error - (error "Error in %s: %s" file var))))))))) + (dolist (file (list gnus-site-init-file gnus-init-file)) + (when (and file + (locate-library file)) + (if (or debug-on-error debug-on-quit) + (load file nil t) + (condition-case var + (load file nil t) + (error + (error "Error in %s: %s" file (cadr var)))))))))) ;; For subscribing new newsgroup @@ -536,22 +547,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 +591,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 +628,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. @@ -696,6 +715,8 @@ prompt the user for the name of an NNTP server to use." (nnheader-init-server-buffer) (setq gnus-slave slave) (gnus-read-init-file) + (if gnus-agent + (gnus-agentize)) (when gnus-simple-splash (setq gnus-simple-splash nil) @@ -817,6 +838,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 +854,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 () @@ -897,10 +924,17 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Make sure the archive server is available to all and sundry. (when gnus-message-archive-method - (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist) - gnus-server-alist)) - (push (cons "archive" gnus-message-archive-method) - gnus-server-alist)) + (unless (assoc "archive" gnus-server-alist) + (push `("archive" + nnfolder + "archive" + (nnfolder-directory + ,(nnheader-concat message-directory "archive")) + (nnfolder-active-file + ,(nnheader-concat message-directory "archive/active")) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t)) + gnus-server-alist))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. @@ -936,6 +970,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) @@ -950,6 +985,12 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." gnus-plugged) (gnus-find-new-newsgroups)) + ;; Check and remove bogus newsgroups. + (when (and init gnus-check-bogus-newsgroups + gnus-read-active-file (not level) + (gnus-server-opened gnus-select-method)) + (gnus-check-bogus-newsgroups)) + ;; We might read in new NoCeM messages here. (when (and gnus-use-nocem (not level) @@ -961,12 +1002,22 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Find the number of unread articles in each non-dead group. (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) - (gnus-get-unread-articles level)) - - (when (and init gnus-check-bogus-newsgroups - gnus-read-active-file (not level) - (gnus-server-opened gnus-select-method)) - (gnus-check-bogus-newsgroups)))) + (gnus-get-unread-articles level)))) + +(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. @@ -1002,7 +1053,7 @@ for new groups, and subscribe the new groups as zombies." (gnus-message 5 "Looking for new newsgroups...") (unless gnus-have-read-active-file (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (current-time-string)) + (setq gnus-newsrc-last-checked-date (message-make-date)) (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) ;; Go though every newsgroup in `gnus-active-hashtb' and compare @@ -1020,7 +1071,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 +1080,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)) @@ -1065,7 +1118,8 @@ for new groups, and subscribe the new groups as zombies." (and regs (cdar regs)))))) (defun gnus-ask-server-for-new-groups () - (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) + (let* ((new-date (message-make-date)) + (date (or gnus-newsrc-last-checked-date new-date)) (methods (cons gnus-select-method (nconc (when (gnus-archive-server-wanted-p) @@ -1075,7 +1129,6 @@ for new groups, and subscribe the new groups as zombies." gnus-check-new-newsgroups) gnus-secondary-select-methods)))) (groups 0) - (new-date (current-time-string)) group new-newsgroups got-new method hashtb gnus-override-subscribe-method) (unless gnus-killed-hashtb @@ -1113,7 +1166,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 +1175,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))) @@ -1137,10 +1192,8 @@ for new groups, and subscribe the new groups as zombies." (catch 'ended ;; First check if any of the following files exist. If they do, ;; it's not the first time the user has used Gnus. - (dolist (file (list gnus-current-startup-file - (concat gnus-current-startup-file ".el") + (dolist (file (list (concat gnus-current-startup-file ".el") (concat gnus-current-startup-file ".eld") - gnus-startup-file (concat gnus-startup-file ".el") (concat gnus-startup-file ".eld"))) (when (file-exists-p file) @@ -1149,26 +1202,27 @@ for new groups, and subscribe the new groups as zombies." (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t)) (gnus-read-active-file))) - (setq gnus-newsrc-last-checked-date (current-time-string)) + (setq gnus-newsrc-last-checked-date (message-make-date)) ;; Subscribe to the default newsgroups. (let ((groups (or gnus-default-subscribed-newsgroups gnus-backup-default-subscribed-newsgroups)) group) - (when (eq groups t) - ;; If t, we subscribe (or not) all groups as if they were new. - (mapatoms - (lambda (sym) - (when (setq group (symbol-name sym)) - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (push group gnus-killed-list)))))) - gnus-active-hashtb) + (if (eq groups t) + ;; If t, we subscribe (or not) all groups as if they were new. + (mapatoms + (lambda (sym) + (when (setq group (symbol-name sym)) + (let ((do-sub (gnus-matches-options-n group))) + (cond + ((eq do-sub 'subscribe) + (gnus-sethash group group gnus-killed-hashtb) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) + ((eq do-sub 'ignore) + nil) + (t + (push group gnus-killed-list)))))) + gnus-active-hashtb) (dolist (group groups) ;; Only subscribe the default groups that are activated. (when (gnus-active group) @@ -1176,7 +1230,9 @@ for new groups, and subscribe the new groups as zombies." group gnus-level-default-subscribed gnus-level-killed))) (save-excursion (set-buffer gnus-group-buffer) - (gnus-group-make-help-group)) + ;; Don't error if the group already exists. This happens when a + ;; first-time user types 'F'. -- didier + (gnus-group-make-help-group t)) (when gnus-novice-user (gnus-message 7 "`A k' to list killed groups")))))) @@ -1338,7 +1394,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 @@ -1409,24 +1467,27 @@ newsgroup." (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan group method)) t) - (condition-case () + (if (or debug-on-error debug-on-quit) (inline (gnus-request-group group dont-check method)) - ;;(error nil) - (quit - (message "Quit activating %s" group) - nil)) - (setq active (gnus-parse-active)) - ;; If there are no articles in the group, the GROUP - ;; command may have responded with the `(0 . 0)'. We - ;; ignore this if we already have an active entry - ;; for the group. - (if (and (zerop (car active)) - (zerop (cdr active)) - (gnus-active group)) - (gnus-active group) - (gnus-set-active group active) - ;; Return the new active info. - active)))) + (condition-case () + (inline (gnus-request-group group dont-check method)) + ;;(error nil) + (quit + (message "Quit activating %s" group) + nil))) + (unless dont-check + (setq active (gnus-parse-active)) + ;; If there are no articles in the group, the GROUP + ;; command may have responded with the `(0 . 0)'. We + ;; ignore this if we already have an active entry + ;; for the group. + (if (and (zerop (car active)) + (zerop (cdr active)) + (gnus-active group)) + (gnus-active group) + (gnus-set-active group active) + ;; Return the new active info. + active))))) (defun gnus-get-unread-articles-in-group (info active &optional update) (when active @@ -1516,6 +1577,7 @@ newsgroup." ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. (defun gnus-get-unread-articles (&optional level) + (setq gnus-server-method-cache nil) (let* ((newsrc (cdr gnus-newsrc-alist)) (level (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level @@ -1527,7 +1589,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 @@ -1554,9 +1616,9 @@ newsgroup." (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) + (setq active (gnus-activate-group group 'scan))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent gnus-plugged active) + (when (and gnus-agent active (gnus-online method)) (gnus-agent-save-group-info method (gnus-group-real-name group) active)) (unless (inline (gnus-virtual-group-p group)) @@ -1574,10 +1636,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. @@ -1595,8 +1657,8 @@ newsgroup." (setq active (gnus-activate-group group)) (setq active (gnus-activate-group group 'scan)) (push method scanned-methods)) - (when active - (gnus-close-group group)))))) + (when active + (gnus-close-group group)))))) ;; Get the number of unread articles in the group. (cond @@ -1610,31 +1672,31 @@ 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) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) + ;; 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) + (dolist (group groups) + (cond + ((setq active (gnus-active (gnus-info-group + (setq info (gnus-get-info group))))) + (inline (gnus-get-unread-articles-in-group info active t))) + (t + ;; The group couldn't be reached, so we nix out the number of + ;; unread articles and stuff. + (gnus-set-active group nil) + (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) (gnus-message 5 "Checking new news...done"))) @@ -1763,13 +1825,15 @@ newsgroup." ;; Only do each method once, in case the methods appear more ;; than once in this list. (unless (member method methods) - (condition-case () + (if (or debug-on-error debug-on-quit) (gnus-read-active-file-1 method force) - ;; We catch C-g so that we can continue past servers - ;; that do not respond. - (quit - (message "Quit reading the active file") - nil))))))) + (condition-case () + (gnus-read-active-file-1 method force) + ;; We catch C-g so that we can continue past servers + ;; that do not respond. + (quit + (message "Quit reading the active file") + nil)))))))) (defun gnus-read-active-file-1 (method force) (let (where mesg) @@ -1861,7 +1925,7 @@ newsgroup." (insert ?\\))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active gnus-plugged) + (when (and gnus-agent real-active (gnus-online method)) (gnus-agent-save-active method)) ;; If these are groups from a foreign select method, we insert the @@ -1881,7 +1945,7 @@ newsgroup." (goto-char (point-min)) (let (group max min) (while (not (eobp)) - (condition-case err + (condition-case () (progn (narrow-to-region (point) (gnus-point-at-eol)) ;; group gets set to a symbol interned in the hash table @@ -1937,7 +2001,7 @@ newsgroup." ;; Let the Gnus agent save the active file. (if (and gnus-agent real-active - gnus-plugged + (gnus-online method) (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) @@ -2016,19 +2080,32 @@ If FORCE is non-nil, the .newsrc file is read." (let (gnus-newsrc-assoc) (when (file-exists-p ding-file) (with-temp-buffer - (condition-case nil + (if (or debug-on-error debug-on-quit) (progn (insert-file-contents-as-coding-system - gnus-startup-file-coding-system ding-file) + gnus-ding-file-coding-system ding-file) (eval-region (point-min) (point-max))) - (error - (ding) - (or (not (or (zerop (buffer-size)) - (eq 'binary gnus-startup-file-coding-system) - (gnus-re-read-newsrc-el-file ding-file))) - (gnus-yes-or-no-p - (format "Error in %s; continue? " ding-file)) - (error "Error in %s" ding-file))))) + (condition-case nil + (progn + (insert-file-contents-as-coding-system + gnus-ding-file-coding-system ding-file) + (eval-region (point-min) (point-max))) + (error + (ding) + (or (not (or (zerop (buffer-size)) + (eq 'binary gnus-ding-file-coding-system) + (gnus-re-read-newsrc-el-file ding-file))) + (gnus-yes-or-no-p + (format "Error in %s; continue? " ding-file)) + (error "Error in %s" ding-file)))))) +;; ;; Older versions of `gnus-format-specs' are no longer valid +;; ;; in Oort Gnus 0.01. +;; (let ((version +;; (and gnus-newsrc-file-version +;; (gnus-continuum-version gnus-newsrc-file-version)))) +;; (when (or (not version) +;; (< version 5.090009)) +;; (setq gnus-format-specs gnus-default-format-specs))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) (gnus-make-hashtable-from-newsrc-alist) @@ -2058,11 +2135,12 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (error nil)) (progn (insert-file-contents-as-binary file nil nil nil 'replace) + (goto-char (point-min)) (when (re-search-forward "^[\t ]*([\t\n\r ]*setq[\t\n\r ]+gnus-format-specs" nil t) (delete-region (goto-char (match-beginning 0)) (forward-list 1)) (decode-coding-region (point-min) (point-max) - gnus-startup-file-coding-system) + gnus-ding-file-coding-system) (condition-case nil (progn (eval-region (point-min) (point-max)) @@ -2077,24 +2155,36 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (defun gnus-product-read-variable-file-1 (file checking-methods coding &rest variables) (let (error gnus-product-file-version method file-ver) - (when (or - (condition-case err - (let ((coding-system-for-read coding) - (input-coding-system coding)) - (load (expand-file-name file gnus-product-directory) t nil t) - nil) - (error - (message "%s" err) - (setq error t))) - (and (assq 'emacs-version checking-methods) - (not (string= emacs-version + (when (or (condition-case err + (let ((coding-system-for-read coding) + (input-coding-system coding)) + (load (expand-file-name file gnus-product-directory) + nil nil t) + nil) + (error + (message "Error while reading %s: %s" + (expand-file-name file gnus-product-directory) + (error-message-string err)) + (setq error t))) + (and (setq method (assq 'product-version checking-methods)) + (not (and (setq file-ver + (cdr (assq 'product-version + gnus-product-file-version))) + (zerop (product-version-compare file-ver + (cadr method)))))) + (and (assq 'emacs-version checking-methods) + (not (and (assq 'emacs-version gnus-product-file-version) + (string-equal + emacs-version (cdr (assq 'emacs-version - gnus-product-file-version))))) - (and (setq method (assq 'product-version checking-methods)) - (or (not (setq file-ver - (cdr (assq 'product-version - gnus-product-file-version)))) - (< (product-version-compare file-ver (cadr method)) 0)))) + gnus-product-file-version)))))) + (and (assq 'correct-string-widths checking-methods) + (not (and (assq 'correct-string-widths + gnus-product-file-version) + (eq (and gnus-use-correct-string-widths t) + (and (cdr (assq 'correct-string-widths + gnus-product-file-version)) + t)))))) (unless error (message "\"%s\" seems to have mismatched contents, updating..." file)) @@ -2448,7 +2538,7 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) (gnus-gnus-to-quick-newsrc-format) (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer-as-coding-system gnus-startup-file-coding-system) + (save-buffer-as-coding-system gnus-ding-file-coding-system) (kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) @@ -2548,7 +2638,7 @@ The backup file \".newsrc.eld_\" will be created before re-reading." "Insert gnus product depend variables in lisp format." (let ((print-quoted t) (print-escape-newlines t) - variable param) + print-length print-level variable param) (insert (format ";; -*- Mode: emacs-lisp; coding: %s -*-\n" coding)) (insert (format ";; %s startup file.\n" (product-name product))) (when (setq param (cdr (assq 'product-version checking-methods))) @@ -2558,16 +2648,20 @@ The backup file \".newsrc.eld_\" will be created before re-reading." "\t0)\n" " (error \"This file was created by later version of " "gnus.\"))\n")) - (insert "(setq gnus-product-file-version \n" + (insert "(setq gnus-product-file-version\n" " '((product-version . " (prin1-to-string (product-version product)) ")\n" - "\t(emacs-version . " (prin1-to-string emacs-version) ")))\n") + "\t(emacs-version . " + (prin1-to-string emacs-version) ")\n" + "\t(correct-string-widths . " + (if gnus-use-correct-string-widths "t" "nil") + ")))\n") (while variables (when (and (boundp (setq variable (pop variables))) (symbol-value variable)) - (insert "(setq " (symbol-name variable) " '") - (gnus-prin1 (symbol-value variable)) - (insert ")\n"))))) + (insert "(setq " (symbol-name variable) " '") + (gnus-prin1 (symbol-value variable)) + (insert ")\n"))))) (defun gnus-strip-killed-list () "Return the killed list minus the groups that match `gnus-save-killed-list'." @@ -2651,11 +2745,11 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (save-excursion (set-buffer gnus-dribble-buffer) (let ((slave-name - (make-temp-name (concat gnus-current-startup-file "-slave-"))) + (mm-make-temp-file (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) - (gnus-write-buffer-as-coding-system - gnus-startup-file-coding-system slave-name) + (gnus-write-buffer-as-coding-system gnus-ding-file-coding-system + slave-name) (when modes (set-file-modes slave-name modes))))) @@ -2775,16 +2869,15 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (skip-chars-forward " \t") ;; ... which leads to this line being effectively ignored. (when (symbolp group) - (let ((str (buffer-substring - (point) (progn (end-of-line) (point)))) - (coding - (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'gnus-mule-get-coding-system) - (gnus-mule-get-coding-system (symbol-name group))))) - (when coding - (setq str (decode-coding-string str (car coding)))) + (let* ((str (buffer-substring + (point) (progn (end-of-line) (point)))) + (name (symbol-name group)) + (charset + (or (gnus-group-name-charset method name) + (gnus-parameter-charset name) + gnus-default-charset))) + (when (and str charset (featurep 'mule)) + (setq str (decode-coding-string str charset))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done")