\f
-(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
"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)
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)))
(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)
(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))
(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)
(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...")
(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"))))
: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."
(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
"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
(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")))
(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)
(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
(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)
(eval-when-compile (require 'static))
(require 'custom)
+(require 'gnus-vers)
(eval-and-compile
(if (< emacs-major-version 20)
(require 'gnus-load)))
: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
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.
("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
(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)
(gnus-ems-redefine)
-(provide 'gnus)
+(product-provide (provide 'gnus) 'gnus-vers)
;;; gnus.el ends here
projects / elisp / gnus.git- / commitdiff