From da8dc57d88dc7cf0f8279b279cab9125ccb17ba5 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Thu, 16 Mar 2000 09:06:55 +0000 Subject: [PATCH] Sync with Nana-gnus 7.1.0.14. --- lisp/gnus-msg.el | 10 ---- lisp/gnus-spec.el | 61 +++++++++++--------- lisp/gnus-start.el | 163 +++++++++++++++++++++++++++++++++++++++------------- lisp/gnus.el | 78 +++++-------------------- 4 files changed, 173 insertions(+), 139 deletions(-) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 956f7c2..270f800 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -645,16 +645,6 @@ If SILENT, don't prompt the user." -(defun gnus-extended-version () - "Stringified gnus version." - (concat gnus-product-name "/" gnus-version-number - " (based on " - gnus-original-product-name " v" gnus-original-version-number ")" - (if (zerop (string-to-number gnus-revision-number)) - "" - (concat " (revision " gnus-revision-number ")")) - )) - (defun gnus-message-make-user-agent (&optional include-mime-info max-column) "Return user-agent info. INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 14d52d5..7ece20a 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -129,8 +129,10 @@ "Alist of format specs.") (defvar gnus-format-specs-compiled nil - "Alist of compiled format specs. -Each element should be the form (TYPE . BYTECODE).") + "Alist of compiled format specs. Each element should be the form: +\(TYPE (FORMAT . COMPILED-FUNCTION) + (FORMAT . COMPILED-FUNCTION) + ...)") (defvar gnus-article-mode-line-format-spec nil) (defvar gnus-summary-mode-line-format-spec nil) @@ -156,6 +158,7 @@ Each element should be the form (TYPE . BYTECODE).") value spec) (when entry (setq gnus-format-specs (delq entry gnus-format-specs))) + (gnus-product-variable-touch 'gnus-format-specs) (set (intern (format "%s-spec" var)) (gnus-parse-format (setq value (symbol-value (intern var))) @@ -169,36 +172,39 @@ Each element should be the form (TYPE . BYTECODE).") (lisp-interaction-mode) (insert (pp-to-string spec)))) -(defun gnus-update-format-specification-1 (type val &optional new) +(defun gnus-update-format-specification-1 (type format val &optional new) (if gnus-compile-user-specs - (let ((bytecode (if new - nil - (cdr (assq type gnus-format-specs-compiled))))) - (unless bytecode + (let* ((elem (cdr (assq type gnus-format-specs-compiled))) + (compiled-function + (if new + nil + (cdr (assoc format elem))))) + (unless compiled-function (fset 'gnus-tmp-func `(lambda () ,val)) (require 'bytecomp) (let (byte-compile-warnings) (byte-compile 'gnus-tmp-func)) - (setq bytecode (gnus-byte-code 'gnus-tmp-func)) + (setq compiled-function (gnus-byte-code 'gnus-tmp-func)) (when (get-buffer "*Compile-Log*") (bury-buffer "*Compile-Log*")) (when (get-buffer "*Compile-Log-Show*") - (bury-buffer "*Compile-Log-Show*"))) - (set (intern (format "gnus-%s-line-format-spec" type)) bytecode) - (set-alist 'gnus-format-specs-compiled type bytecode)) + (bury-buffer "*Compile-Log-Show*")) + (if elem + (set-alist 'elem format compiled-function) + (setq elem (list format compiled-function))) + (set-alist 'gnus-format-specs-compiled type elem) + (gnus-product-variable-touch 'gnus-format-specs-compiled)) + (set (intern (format "gnus-%s-line-format-spec" type)) + compiled-function)) (set (intern (format "gnus-%s-line-format-spec" type)) val))) (defun gnus-update-format-specifications (&optional force &rest types) "Update all (necessary) format specifications." ;; Make the indentation array. ;; See whether all the stored info needs to be flushed. - (when (or force - (not (equal emacs-version - (cdr (assq 'version gnus-format-specs)))) - (not (equal gnus-version gnus-newsrc-file-version))) + (when force (message "%s" "Force update format specs.") - (setq gnus-format-specs nil - gnus-newsrc-file-version gnus-version)) + (setq gnus-format-specs nil)) ;; Go through all the formats and see whether they need updating. (let (new-format entry type val) @@ -218,7 +224,7 @@ Each element should be the form (TYPE . BYTECODE).") (if (and (car entry) (equal (car entry) new-format)) ;; Use the old format. - (gnus-update-format-specification-1 type (cadr entry)) + (gnus-update-format-specification-1 type new-format (cadr entry)) ;; This is a new format. (setq val (if (not (stringp new-format)) @@ -236,10 +242,8 @@ Each element should be the form (TYPE . BYTECODE).") (setcar (cdr entry) val) (setcar entry new-format)) (push (list type new-format val) gnus-format-specs)) - (gnus-update-format-specification-1 type val 'new))))) - - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) + (gnus-product-variable-touch 'gnus-format-specs) + (gnus-update-format-specification-1 type new-format val 'new)))))) (defvar gnus-mouse-face-0 'highlight) (defvar gnus-mouse-face-1 'highlight) @@ -553,7 +557,7 @@ If PROPS, insert the result." (require 'bytecomp) (let ((entries gnus-format-specs) (byte-compile-warnings '(unresolved callargs redefine)) - entry type bytecode) + entry type compiled-function) (save-excursion (gnus-message 7 "Compiling format specs...") @@ -571,9 +575,14 @@ If PROPS, insert the result." (byte-code-function-p (cadr form))))) (fset 'gnus-tmp-func `(lambda () ,form)) (byte-compile 'gnus-tmp-func) - (setq bytecode (gnus-byte-code 'gnus-tmp-func)) - (set (intern (format "gnus-%s-line-format-spec" type)) bytecode) - (set-alist 'gnus-format-specs-compiled type bytecode))))) + (setq compiled-function (gnus-byte-code 'gnus-tmp-func)) + (set (intern (format "gnus-%s-line-format-spec" type)) + compiled-function) + (let ((elem (cdr (assq type gnus-format-specs-compiled)))) + (if elem + (set-alist 'elem (cadr entry) compiled-function) + (setq elem (list (cadr entry) compiled-function))) + (set-alist 'gnus-format-specs-compiled type elem)))))) (push (cons 'version emacs-version) gnus-format-specs) (gnus-message 7 "Compiling user specs...done")))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 13f3423..7bbcb30 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -42,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." @@ -592,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 @@ -1943,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 @@ -1975,36 +1990,7 @@ 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"))) @@ -2030,7 +2016,35 @@ If FORCE is non-nil, the .newsrc file is read." (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-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)) + (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) @@ -2382,7 +2396,9 @@ If FORCE is non-nil, the .newsrc file is read." (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 @@ -2426,6 +2442,75 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-prin1 (symbol-value variable)) (insert ")\n")))))) +(defun gnus-product-variable-touch (variable) + (put variable '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) diff --git a/lisp/gnus.el b/lisp/gnus.el index 0ec9ec5..169f475 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -34,6 +34,7 @@ (eval-when-compile (require 'static)) (require 'custom) +(require 'gnus-vers) (eval-and-compile (if (< emacs-major-version 20) (require 'gnus-load))) @@ -262,29 +263,6 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-product-name "T-gnus" - "Product name of this version of gnus.") - -(defconst gnus-version-number "6.14.1" - "Version number for this version of gnus.") - -(defconst gnus-revision-number "14" - "Revision number for this version of gnus.") - -(defconst gnus-original-version-number "5.8.3" - "Version number for this version of Gnus.") - -(provide 'running-pterodactyl-gnus-0_73-or-later) - -(defconst gnus-original-product-name "Gnus" - "Product name of the original version of Gnus.") - -(defconst gnus-version - (format "%s %s r%s (based on %s v%s ; for SEMI 1.13, FLIM 1.13)" - gnus-product-name gnus-version-number gnus-revision-number - gnus-original-product-name gnus-original-version-number) - "Version string for this version of gnus.") - (defcustom gnus-inhibit-startup-message nil "If non-nil, the startup message will not be displayed. This variable is used before `.gnus.el' is loaded, so it should @@ -1603,10 +1581,19 @@ This variable can be nil, gnus or gnus-ja." gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist - gnus-format-specs) + gnus-topic-topology gnus-topic-alist) "Gnus variables saved in the quick startup file.") +(defvar gnus-product-variable-file-list + (let ((version (product-version (product-find 'gnus-vers)))) + `(("strict-cache" ((product-version ,version) (emacs-version)) + binary + gnus-format-specs-compiled) + ("cache" ((product-version ,version)) + ctext + gnus-format-specs))) + "Gnus variables are saved in the produce depend quick startup files.") + (defcustom gnus-compile-user-specs t "If non-nil, the user-defined format specs will be byte-compiled automatically. @@ -1764,8 +1751,7 @@ use the article treating faculties instead. Is is described in Info node ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) - gnus-article-mail gnus-copy-article-buffer gnus-extended-version - gnus-following-method) + gnus-article-mail gnus-copy-article-buffer gnus-following-method) ("gnus-msg" :interactive t gnus-group-post-news gnus-group-mail gnus-summary-post-news gnus-summary-followup gnus-summary-followup-with-original @@ -2114,42 +2100,6 @@ STRINGS will be evaluated in normal `or' order." (setq strings nil))) string)) -(defun gnus-version (&optional arg) - "Version number of this version of Gnus. -If ARG, insert string at point." - (interactive "P") - (if arg - (insert (message "%s" gnus-version)) - (message "%s" gnus-version))) - -(defun gnus-continuum-version (version) - "Return VERSION as a floating point number." - (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) - (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) - (let ((alpha (and (match-beginning 1) (match-string 1 version))) - (number (match-string 2 version)) - major minor least) - (unless (string-match - "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (error "Invalid version string: %s" version)) - (setq major (string-to-number (match-string 1 number)) - minor (string-to-number (match-string 2 number)) - least (if (match-beginning 3) - (string-to-number (match-string 3 number)) - 0)) - (string-to-number - (if (zerop major) - (format "%s00%02d%02d" - (if (member alpha '("(ding)" "d")) - "4.99" - (+ 5 (* 0.02 - (abs - (- (char-int (aref (downcase alpha) 0)) - (char-int ?t)))) - -0.01)) - minor least) - (format "%d.%02d%02d" major minor least)))))) - (defun gnus-info-find-node () "Find Info documentation of Gnus." (interactive) @@ -2980,6 +2930,6 @@ prompt the user for the name of an NNTP server to use." (gnus-ems-redefine) -(provide 'gnus) +(product-provide (provide 'gnus) 'gnus-vers) ;;; gnus.el ends here -- 1.7.10.4