X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=14725c5916b836025023899cd8a4e695e9a20b11;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=e10d5885baf99f0c626702cde94668e2aba82740;hpb=12880262125c73b531b08cd9005fbaf49c2c3395;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index e10d588..14725c5 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, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -26,6 +26,9 @@ ;;; Code: +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'static)) + (require 'gnus) (require 'gnus-win) (require 'gnus-int) @@ -33,7 +36,6 @@ (require 'gnus-range) (require 'gnus-util) (require 'message) -(eval-when-compile (require 'cl)) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") "Your `.newsrc' file. @@ -41,6 +43,12 @@ :group 'gnus-start :type 'file) +(defcustom gnus-product-directory + (nnheader-concat gnus-directory (concat "." gnus-product-name)) + "Product depend data files directory." + :group 'gnus-start + :type '(choice directory (const nil))) + (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") "Your Gnus Emacs-Lisp startup file name. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." @@ -229,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 ) "\\|") @@ -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. @@ -375,7 +383,7 @@ This hook is called as the first thing when Gnus is started." (defcustom gnus-after-getting-new-news-hook '(gnus-display-time-event-handler) - "*A hook run after Gnus checks for new news when Gnus is already running." + "A hook run after Gnus checks for new news when Gnus is already running." :group 'gnus-group-new :type 'hook) @@ -396,16 +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 'binary - "*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) @@ -432,21 +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 - (let ((coding-system-for-read - gnus-startup-file-coding-system)) - (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 @@ -602,6 +613,21 @@ the first newsgroup." (defvar nnoo-state-alist) (defvar gnus-current-select-method) +(defun gnus-clear-quick-file-variables () + "Clear all variables in quick startup files." + (let ((variables gnus-variable-list)) + ;; Clear Gnus variables. + (while variables + (set (car variables) nil) + (setq variables (cdr variables)))) + (let ((files gnus-product-variable-file-list)) + (while files + (let ((variables (nthcdr 3 (car files)))) + (while variables + (set (car variables) nil) + (setq variables (cdr variables)))) + (setq files (cdr files))))) + (defun gnus-close-all-servers () "Close all servers." (interactive) @@ -610,11 +636,8 @@ the first newsgroup." (defun gnus-clear-system () "Clear all variables and buffers." - ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) + ;; Clear gnus variables. + (gnus-clear-quick-file-variables) ;; Clear other internal variables. (setq gnus-list-of-killed-groups nil gnus-have-read-active-file nil @@ -692,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) @@ -737,6 +762,8 @@ prompt the user for the name of an NNTP server to use." (gnus-group-first-unread-group) (gnus-configure-windows 'group) (gnus-group-set-mode-line) + ;; For reading Info. + (set-language-info "Japanese" 'gnus-info "gnus-ja") (gnus-run-hooks 'gnus-started-hook)))))) (defun gnus-start-draft-setup () @@ -785,7 +812,11 @@ cautiously -- unloading may cause trouble." (set-buffer gnus-dribble-buffer) (goto-char (point-max)) (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) + ;; This has been commented by Josh Huber + ;; It causes problems with both XEmacs and Emacs 21, and doesn't + ;; seem to be of much value. (FIXME: remove this after we make sure + ;; it's not needed). + ;; (set-window-point (get-buffer-window (current-buffer)) (point-max)) (bury-buffer gnus-dribble-buffer) (save-excursion (set-buffer gnus-group-buffer) @@ -835,7 +866,7 @@ cautiously -- unloading may cause trouble." (gnus-y-or-n-p (if purpose "Gnus exited on purpose without saving; read auto-save file anyway? " - "Gnus auto-save file exists. Do you want to read it? "))) + "Gnus auto-save file exists. Do you want to read it? "))) (setq gnus-dribble-eval-file t))))))) (defun gnus-dribble-eval-file () @@ -897,10 +928,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. @@ -951,6 +989,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) @@ -962,12 +1006,7 @@ 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. @@ -1018,7 +1057,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 @@ -1083,7 +1122,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) @@ -1093,7 +1133,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 @@ -1157,10 +1196,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) @@ -1169,27 +1206,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) - (gnus-call-subscribe-functions - 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) @@ -1197,7 +1234,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")))))) @@ -1359,7 +1398,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 @@ -1430,24 +1471,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 @@ -1537,6 +1581,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 @@ -1575,9 +1620,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)) @@ -1616,8 +1661,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 @@ -1640,22 +1685,22 @@ newsgroup." (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 + ;; 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))))))) + (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"))) @@ -1784,13 +1829,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) @@ -1882,7 +1929,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 @@ -1902,7 +1949,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 @@ -1958,7 +2005,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) @@ -1999,10 +2046,7 @@ newsgroup." "Read startup file. If FORCE is non-nil, the .newsrc file is read." ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) + (gnus-clear-quick-file-variables) (let* ((newsrc-file gnus-current-startup-file) (quick-file (concat newsrc-file ".el"))) (save-excursion @@ -2031,65 +2075,127 @@ If FORCE is non-nil, the .newsrc file is read." (buffer-disable-undo) (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) - - ;; Convert old to new. - (gnus-convert-old-newsrc)))) - -(defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." - (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) - -(defun gnus-convert-old-ticks () - (let ((newsrc (cdr gnus-newsrc-alist)) - marks info dormant ticked) - (while (setq info (pop newsrc)) - (when (setq marks (gnus-info-marks info)) - (setq dormant (cdr (assq 'dormant marks)) - ticked (cdr (assq 'tick marks))) - (when (or dormant ticked) - (gnus-info-set-read - info - (gnus-add-to-range - (gnus-info-read info) - (nconc (gnus-uncompress-range dormant) - (gnus-uncompress-range ticked))))))))) + (gnus-message 5 "Reading %s...done" newsrc-file)))))) (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) ;; We always, always read the .eld file. (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) - (condition-case nil - (let ((coding-system-for-read gnus-startup-file-coding-system)) - (load ding-file t t t)) - (error - (ding) - (unless (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 (gnus-continuum-version gnus-newsrc-file-version))) - (when (or (not version) - (< version 5.090002)) - (setq gnus-format-specs nil))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc))) + (when (file-exists-p ding-file) + (with-temp-buffer + (if (or debug-on-error debug-on-quit) + (progn + (insert-file-contents-as-coding-system + gnus-ding-file-coding-system ding-file) + (eval-region (point-min) (point-max))) + (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) (when (file-newer-than-file-p file ding-file) ;; Old format quick file (gnus-message 5 "Reading %s..." file) ;; The .el file is newer than the .eld file, so we read that one ;; as well. - (gnus-read-old-newsrc-el-file file)))) + (gnus-read-old-newsrc-el-file file))) + (when (and gnus-product-directory + (file-directory-p gnus-product-directory)) + (let ((list gnus-product-variable-file-list)) + (while list + (apply 'gnus-product-read-variable-file-1 (car list)) + (setq list (cdr list)))))) + +(defun gnus-re-read-newsrc-el-file (file) + "Attempt to re-read .newsrc.eld file. Returns `nil' if successful. +The backup file \".newsrc.eld_\" will be created before re-reading." + (message "Error in %s; retrying..." file) + (if (and + (condition-case nil + (let ((backup (concat file "_"))) + (copy-file file backup 'ok-if-already-exists 'keep-time) + (message " (The backup file %s has been created)" backup) + t) + (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-ding-file-coding-system) + (condition-case nil + (progn + (eval-region (point-min) (point-max)) + t) + (error nil))))) + (prog1 + nil + (message "Error in %s; retrying...done" file)) + (message "Error in %s; retrying...failed" file) + t)) + +(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) + 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 (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)) + (while variables + (set (car variables) nil) + (gnus-product-variable-touch (car variables)) + (setq variables (cdr variables)))))) ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) @@ -2436,13 +2542,23 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) (gnus-gnus-to-quick-newsrc-format) (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (let ((coding-system-for-write gnus-startup-file-coding-system)) - (save-buffer)) + (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)) (gnus-dribble-delete-file) - (gnus-group-set-mode-line))))) + (gnus-group-set-mode-line)))) + (when gnus-product-directory + (gnus-product-save-variable-file))) + +;; Call the function above at C-x C-c. +(defadvice save-buffers-kill-emacs (before save-gnus-newsrc-file-maybe + activate preactivate) + "Save .newsrc and .newsrc.eld when Emacs is killed." + (when (gnus-alive-p) + (gnus-run-hooks 'gnus-exit-gnus-hook) + (gnus-offer-save-summaries) + (gnus-save-newsrc-file))) (defun gnus-gnus-to-quick-newsrc-format () "Insert Gnus variables such as gnus-newsrc-alist in lisp format." @@ -2477,6 +2593,80 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-prin1 (symbol-value variable)) (insert ")\n")))))) +(defun gnus-product-variable-touch (&rest variables) + (while variables + (put (pop variables) 'gnus-product-variable 'dirty))) + +(defun gnus-product-variables-dirty-p (variables) + (catch 'done + (while variables + (when (eq (get (car variables) 'gnus-product-variable) 'dirty) + (throw 'done t)) + (setq variables (cdr variables))))) + +(defun gnus-product-save-variable-file (&optional force) + "Save all product variables to files, when need to be saved." + (let ((list gnus-product-variable-file-list)) + (gnus-make-directory gnus-product-directory) + (while list + (apply 'gnus-product-save-variable-file-1 force (car list)) + (setq list (cdr list))))) + +(defun gnus-product-save-variable-file-1 (force file checking-methods coding + &rest variables) + "Save a product variable file, when need to be saved." + (when (or force + (gnus-product-variables-dirty-p variables)) + (let ((product (product-find 'gnus-vers))) + (set-buffer (gnus-get-buffer-create " *gnus-product*")) + (make-local-variable 'version-control) + (setq version-control 'never) + (setq file (expand-file-name file gnus-product-directory) + buffer-file-name file + default-directory (file-name-directory file)) + (buffer-disable-undo) + (erase-buffer) + (gnus-message 5 "Saving %s..." file) + (apply 'gnus-product-quick-file-format product checking-methods coding + variables) + (save-buffer-as-coding-system coding) + (kill-buffer (current-buffer)) + (while variables + (put (car variables) 'gnus-product-variable nil) + (setq variables (cdr variables))) + (gnus-message + 5 "Saving %s...done" file)))) + +(defun gnus-product-quick-file-format (product checking-methods + coding &rest variables) + "Insert gnus product depend variables in lisp format." + (let ((print-quoted t) + (print-escape-newlines t) + 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))) + (insert "(or (>= (product-version-compare " + "(product-version (product-find 'gnus-vers))\n" + "\t\t\t\t '" (apply 'prin1-to-string param) ")\n" + "\t0)\n" + " (error \"This file was created by later version of " + "gnus.\"))\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(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"))))) + (defun gnus-strip-killed-list () "Return the killed list minus the groups that match `gnus-save-killed-list'." (let ((list gnus-killed-list) @@ -2559,11 +2749,11 @@ If FORCE is non-nil, the .newsrc file is read." (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"))))) - (let ((coding-system-for-write gnus-startup-file-coding-system)) - (gnus-write-buffer slave-name)) + (gnus-write-buffer-as-coding-system gnus-ding-file-coding-system + slave-name) (when modes (set-file-modes slave-name modes))))) @@ -2688,9 +2878,10 @@ If FORCE is non-nil, the .newsrc file is read." (name (symbol-name group)) (charset (or (gnus-group-name-charset method name) - (gnus-parameter-charset name)))) + (gnus-parameter-charset name) + gnus-default-charset))) (when (and str charset (featurep 'mule)) - (setq str (mm-decode-coding-string str charset))) + (setq str (decode-coding-string str charset))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done")