(gnus-format-specs): Modify data structure.

(gnus-format-specs-compiled): Likewise.
(gnus-update-format): Support new data structure of `gnus-format-specs'.
(gnus-update-format-specification-1): Support new data structure of
`gnus-format-specs-compiled'.
(gnus-update-format-specifications): Likewise.
(gnus-search-or-regist-spec): New utility macro.

diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el
index 4d9d716..8fbaf63 100644 (file)
--- a/lisp/gnus-spec.el
+++ b/lisp/gnus-spec.el
@@ -119,17 +119,19 @@
   (gnus-byte-code 'gnus-group-line-format-spec))
 
 (defvar gnus-format-specs
-  `((version . ,emacs-version)
-    (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
-    (summary-dummy "*  %(:                          :%) %S\n"
-                  ,gnus-summary-dummy-line-format-spec)
-    (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
-            ,gnus-summary-line-format-spec))
+  `((group ("%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec))
+    (summary-dummy ("*  %(:                          :%) %S\n"
+                  ,gnus-summary-dummy-line-format-spec))
+    (summary ("%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+             ,gnus-summary-line-format-spec)))
   "Alist of format specs.")
 
 (defvar gnus-format-specs-compiled nil
   "Alist of compiled format specs.
-Each element should be the form (TYPE . BYTECODE).")
+Each element should be the form:
+\(TYPE (FORMAT-STRING-1 . BYTECODE-1)
+                 :
+       (FORMAT-STRING-n . BYTECODE-n)).")
 
 (defvar gnus-article-mode-line-format-spec nil)
 (defvar gnus-summary-mode-line-format-spec nil)
@@ -151,43 +153,55 @@ Each element should be the form (TYPE . BYTECODE).")
        (match-string 1)))))
   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
                              (match-string 1 var))))
-        (entry (assq type gnus-format-specs))
-        value spec)
-    (when entry
-      (setq gnus-format-specs (delq entry gnus-format-specs)))
+        (value (symbol-value (intern var)))
+        (spec (set
+               (intern (format "%s-spec" var))
+               (gnus-parse-format 
+                value (symbol-value (intern (format "%s-alist" var)))
+                (not (string-match "mode" var))))))
+    (if entry
+       (let ((elem (assoc value entry)))
+         (if elem
+             (setcdr elem spec)
+           (setcdr entry (cons (cons value elem) (cdr entry)))))
+      (push (list type (cons value spec)) 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)))
-                       (symbol-value (intern (format "%s-alist" var)))
-                       (not (string-match "mode" var))))
-    (setq spec (symbol-value (intern (format "%s-spec" var))))
-    (push (list type value spec) gnus-format-specs)
 
     (pop-to-buffer "*Gnus Format*")
     (erase-buffer)
     (lisp-interaction-mode)
     (insert (pp-to-string spec))))
 
-(defun gnus-update-format-specification-1 (type val &optional new)
-  (if gnus-compile-user-specs
-      (let ((bytecode (if new
-                         nil
-                       (cdr (assq type gnus-format-specs-compiled)))))
-       (unless bytecode
-         (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))
-         (when (get-buffer "*Compile-Log*")
-           (bury-buffer "*Compile-Log*"))
-         (when (get-buffer "*Compile-Log-Show*")
-           (bury-buffer "*Compile-Log-Show*"))
-         (set-alist 'gnus-format-specs-compiled type bytecode)
-         (gnus-product-variable-touch 'gnus-format-specs-compiled))
-       (set (intern (format "gnus-%s-line-format-spec" type)) bytecode))
-    (set (intern (format "gnus-%s-line-format-spec" type)) val)))
+(defmacro gnus-search-or-regist-spec (specs type format spec entry elem
+                                           &rest body)
+  `(let* ((,entry (assq ,type ,specs))
+         (,elem (assoc ,format (cdr ,entry))))
+     (or (cdr ,elem)
+        (when (progn ,@body)
+          (if ,entry
+              (if ,elem
+                  (setcdr ,elem ,spec)
+                (setcdr ,entry (cons (cons ,format ,spec) (cdr ,entry))))
+            (push (list ,type (cons ,format ,spec)) ,specs))
+          (gnus-product-variable-touch (quote ,specs)))
+        ,spec)))
+
+(defun gnus-update-format-specification-1 (type format val)
+  (set (intern (format "gnus-%s-line-format-spec" type))
+       (gnus-search-or-regist-spec
+       gnus-format-specs-compiled type format val entry elem
+       (when (and gnus-compile-user-specs val)
+         (setq val (prog1
+                       (progn
+                         (fset 'gnus-tmp-func `(lambda () ,val))
+                         (require 'bytecomp)
+                         (let (byte-compile-warnings)
+                           (byte-compile 'gnus-tmp-func))
+                         (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*"))))))))
 
 (defun gnus-update-format-specifications (&optional force &rest types)
   "Update all (necessary) format specifications."
@@ -195,46 +209,42 @@ Each element should be the form (TYPE . BYTECODE).")
   ;; See whether all the stored info needs to be flushed.
   (when force
     (message "%s" "Force update format specs.")
-    (setq gnus-format-specs nil))
+    (setq gnus-format-specs nil
+         gnus-format-specs-compiled nil)
+    (gnus-product-variable-touch 'gnus-format-specs
+                                'gnus-format-specs-compiled))
 
   ;; Go through all the formats and see whether they need updating.
-  (let (new-format entry type val)
-    (while (setq type (pop types))
-      ;; Jump to the proper buffer to find out the value of
-      ;; the variable, if possible.  (It may be buffer-local.)
-      (save-excursion
-       (let ((buffer (intern (format "gnus-%s-buffer" type)))
-             val)
-         (when (and (boundp buffer)
-                    (setq val (symbol-value buffer))
-                    (gnus-buffer-exists-p val))
-           (set-buffer val))
-         (setq new-format (symbol-value
-                           (intern (format "gnus-%s-line-format" type)))))
-       (setq entry (cdr (assq type gnus-format-specs)))
-       (if (and (car entry)
-                (equal (car entry) new-format))
-           ;; Use the old format.
-           (gnus-update-format-specification-1 type (cadr entry))
-         ;; This is a new format.
-         (setq val
-               (if (not (stringp new-format))
-                   ;; This is a function call or something.
-                   new-format
-                 ;; This is a "real" format.
-                 (gnus-parse-format
-                  new-format
-                  (symbol-value
-                   (intern (format "gnus-%s-line-format-alist" type)))
-                  (not (string-match "mode$" (symbol-name type))))))
-         ;; Enter the new format spec into the list.
-         (if entry
-             (progn
-               (setcar (cdr entry) val)
-               (setcar entry new-format))
-           (push (list type new-format val) gnus-format-specs))
-         (gnus-product-variable-touch 'gnus-format-specs)
-         (gnus-update-format-specification-1 type val 'new))))))
+  (let (type val)
+    (save-excursion
+      (while (setq type (pop types))
+       ;; Jump to the proper buffer to find out the value of
+       ;; the variable, if possible.  (It may be buffer-local.)
+       (let* ((new-format
+               (let ((buffer (intern (format "gnus-%s-buffer" type))))
+                 (when (and (boundp buffer)
+                            (setq val (symbol-value buffer))
+                            (gnus-buffer-exists-p val))
+                   (set-buffer val))
+                 (symbol-value
+                  (intern (format "gnus-%s-line-format" type))))))
+         (or (gnus-update-format-specification-1 type new-format nil)
+             ;; This is a new format.
+             (gnus-update-format-specification-1
+               type new-format
+               (gnus-search-or-regist-spec
+                gnus-format-specs type new-format val entry elem
+                (setq val (if (stringp new-format)
+                              ;; This is a "real" format.
+                              (gnus-parse-format
+                               new-format
+                               (symbol-value
+                                (intern (format "gnus-%s-line-format-alist"
+                                                type)))
+                               (not (string-match "mode$"
+                                                  (symbol-name type))))
+                            ;; This is a function call or something.
+                            new-format))))))))))
 
 (defvar gnus-mouse-face-0 'highlight)
 (defvar gnus-mouse-face-1 'highlight)