* Makefile.in (install-package-ja): Compile and install lisp files first.
[elisp/gnus.git-] / lisp / gnus-spec.el
index e315487..ff2802e 100644 (file)
@@ -1,5 +1,6 @@
 ;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     Katsumi Yamaoka <yamaoka@jpl.org>
        (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 (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))))))
+                (not (string-match "mode" var)))))
+        (entry (assq type gnus-format-specs)))
     (if entry
        (let ((elem (assoc value entry)))
          (if elem
     (lisp-interaction-mode)
     (insert (pp-to-string spec))))
 
-(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)))
+(put 'gnus-search-or-regist-spec 'lisp-indent-function 1)
+(defmacro gnus-search-or-regist-spec (mspec &rest body)
+  (let ((specs (nth 0 mspec)) (type (nth 1 mspec)) (format (nth 2 mspec))
+       (spec (nth 3 mspec)) (entry (nth 4 mspec)) (elem (nth 5 mspec)))
+    `(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*"))))))))
+       (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."
              ;; 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))))))))))
+              (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)
@@ -383,7 +386,7 @@ by `gnus-xmas-redefine'."
   ;; This function parses the FORMAT string with the help of the
   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
   ;; string.
-  (let ((xemacs-mule-p (and gnus-xemacs (featurep 'mule)))
+  (let ((xemacs-mule-p (and (featurep 'xemacs) (featurep 'mule)))
        max-width
        spec flist fstring elem result dontinsert user-defined
        type value pad-width spec-beg cut-width ignore-value
@@ -575,7 +578,7 @@ If PROPS, insert the result."
                       ;; Under XEmacs, it's (funcall #<compiled-function ...>)
                       (not (and (eq 'funcall (car form))
                                 (byte-code-function-p (cadr form)))))
-             (fset 'gnus-tmp-func `(lambda () ,form))
+             (defalias 'gnus-tmp-func `(lambda () ,form))
              (byte-compile 'gnus-tmp-func)
              (setq compiled-function (gnus-byte-code 'gnus-tmp-func))
              (set (intern (format "gnus-%s-line-format-spec" type))