X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=5f8205011493d55e4c4d1e14b6df81d9edbc2772;hb=refs%2Ftags%2Ft-gnus-6_14_1-17;hp=405bd8df6c7b3370ff6601d9f48f19606285eef5;hpb=027a90912122f2cb3e36d82310f32962e3ce2f71;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 405bd8d..5f82050 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -25,6 +25,9 @@ ;;; Code: +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'static)) + (require 'gnus) (require 'gnus-win) (require 'gnus-int) @@ -32,7 +35,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. @@ -40,6 +42,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." @@ -365,7 +373,7 @@ This hook is called as the first thing when Gnus is started." (defcustom gnus-after-getting-new-news-hook (when (gnus-boundp 'display-time-timer) '(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) @@ -391,7 +399,9 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'boolean) -(defvar gnus-startup-file-coding-system 'binary +(defvar gnus-startup-file-coding-system (static-if (boundp 'MULE) + '*ctext* + 'ctext) "*Coding system for startup file.") ;;; Internal variables @@ -432,9 +442,7 @@ Can be used to turn version control on or off." (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)) + (load file nil t) (error (error "Error in %s: %s" file var))))))))) @@ -590,13 +598,25 @@ the first newsgroup." (defvar nnoo-state-alist) (defvar gnus-current-select-method) -(defun gnus-clear-system () - "Clear all variables and buffers." - ;; Clear Gnus variables. +(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-clear-system () + "Clear all variables and buffers." + ;; 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 @@ -718,6 +738,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 () @@ -1939,10 +1961,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 @@ -1971,59 +1990,95 @@ 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 + (when (file-exists-p ding-file) + (with-temp-buffer + (condition-case nil + (progn + (insert-file-contents-as-coding-system + gnus-startup-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)))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc))) + (error "Error in %s" ding-file))))) + (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) + (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) + (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 (gnus-product-file-version method file-ver) + (if (or (condition-case err + (let ((coding-system-for-read coding) + (input-coding-system coding)) + (load (expand-file-name file gnus-product-directory) t t t) + nil) + (error (message "%s" err))) + (and (assq 'emacs-version checking-methods) + (not (string= 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)))) + (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) @@ -2370,13 +2425,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-startup-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." @@ -2411,6 +2476,76 @@ 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) + 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") + (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) @@ -2625,7 +2760,7 @@ If FORCE is non-nil, the .newsrc file is read." (fboundp 'gnus-mule-get-coding-system) (gnus-mule-get-coding-system (symbol-name group))))) (when coding - (setq str (mm-decode-coding-string str (car coding)))) + (setq str (decode-coding-string str (car coding)))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done")