Contents in release-21-2 at 1999-06-30-19.

[chise/xemacs-chise.git.1] / lisp / cus-face.el

diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 09e7771..cf4755d 100644 (file)
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -39,12 +39,12 @@
            frame)
        ;; Create global face.
        (make-empty-face face)
            frame)
        ;; Create global face.
        (make-empty-face face)

-       (face-display-set face value)
+       (face-display-set face value nil '(custom))

        ;; Create frame local faces
        (while frames
          (setq frame (car frames)
                frames (cdr frames))
        ;; Create frame local faces
        (while frames
          (setq frame (car frames)
                frames (cdr frames))

-         (face-display-set face value frame))
+         (face-display-set face value frame '(custom)))

        (init-face-from-resources face)))
     (when (and doc (null (face-doc-string face)))
       (set-face-doc-string face doc))
        (init-face-from-resources face)))
     (when (and doc (null (face-doc-string face)))
       (set-face-doc-string face doc))

@@ -67,13 +67,17 @@
                           :help-echo "\
 Text size (e.g. 9pt or 2mm).")
           custom-set-face-font-size custom-face-font-size)
                           :help-echo "\
 Text size (e.g. 9pt or 2mm).")
           custom-set-face-font-size custom-face-font-size)

-    (:stipple (editable-field :format "Stipple: %v"
-                             :help-echo "Name of background bitmap file.")
-             set-face-stipple custom-face-stipple)

     (:family (editable-field :format "Font Family: %v"
                             :help-echo "\
 Name of font family to use (e.g. times).") 
             custom-set-face-font-family custom-face-font-family)
     (:family (editable-field :format "Font Family: %v"
                             :help-echo "\
 Name of font family to use (e.g. times).") 
             custom-set-face-font-family custom-face-font-family)

+    (:background-pixmap (editable-field :format "Background pixmap: %v"
+                                       :help-echo "\
+Name of background pixmap file.")
+             set-face-background-pixmap custom-face-background-pixmap)
+    (:dim (toggle :format "%[Dim%]: %v\n"
+                 :help-echo "Control whether the text should be dimmed.")
+         set-face-dim-p face-dim-p)

     (:bold (toggle :format "%[Bold%]: %v\n"
                   :help-echo "Control whether a bold font should be used.")
           custom-set-face-bold custom-face-bold)
     (:bold (toggle :format "%[Bold%]: %v\n"
                   :help-echo "Control whether a bold font should be used.")
           custom-set-face-bold custom-face-bold)

@@ -85,7 +89,6 @@ Control whether an italic font should be used.")
                        :help-echo "\
 Control whether the text should be underlined.")
                set-face-underline-p face-underline-p)
                        :help-echo "\
 Control whether the text should be underlined.")
                set-face-underline-p face-underline-p)

-    ;; #### Should make it work on X

     (:strikethru (toggle :format "%[Strikethru%]: %v\n"
                         :help-echo "\
 Control whether the text should be strikethru.")
     (:strikethru (toggle :format "%[Strikethru%]: %v\n"
                         :help-echo "\
 Control whether the text should be strikethru.")

@@ -107,7 +110,7 @@ be changed.
 The GET function should take two arguments, the face to examine, and
 optonally the frame where the face should be examined.")
 
 The GET function should take two arguments, the face to examine, and
 optonally the frame where the face should be examined.")
 

-(defun face-custom-attributes-set (face frame &rest atts)
+(defun face-custom-attributes-set (face frame tags &rest atts)

   "For FACE on FRAME set the attributes [KEYWORD VALUE]....
 Each keyword should be listed in `custom-face-attributes'.
 
   "For FACE on FRAME set the attributes [KEYWORD VALUE]....
 Each keyword should be listed in `custom-face-attributes'.
 

@@ -118,7 +121,7 @@ If FRAME is nil, set the default face."
           (fun (nth 2 (assq name custom-face-attributes))))
       (setq atts (cdr (cdr atts)))
       (condition-case nil
           (fun (nth 2 (assq name custom-face-attributes))))
       (setq atts (cdr (cdr atts)))
       (condition-case nil

-         (funcall fun face value frame)
+         (funcall fun face value frame tags)

        (error nil)))))
 
 (defun face-custom-attributes-get (face frame)
        (error nil)))))
 
 (defun face-custom-attributes-get (face frame)

@@ -146,11 +149,19 @@ If FRAME is nil, use the default face."
        (error nil)))
     result))
 
        (error nil)))
     result))
 

-(defun custom-set-face-bold (face value &optional frame)
+(defsubst custom-face-get-spec (symbol)
+  (or (get symbol 'customized-face)
+      (get symbol 'saved-face)
+      (get symbol 'face-defface-spec)
+      ;; Attempt to construct it.
+      (list (list t (face-custom-attributes-get
+                    symbol (selected-frame))))))
+
+(defun custom-set-face-bold (face value &optional frame tags)

   "Set the bold property of FACE to VALUE."
   (if value
   "Set the bold property of FACE to VALUE."
   (if value

-      (make-face-bold face frame)
-    (make-face-unbold face frame)))
+      (make-face-bold face frame tags)
+    (make-face-unbold face frame tags)))

 
 ;; Really, we should get rid of these font.el dependencies...  They
 ;; are still presenting a problem with dumping the faces (font.el is
 
 ;; Really, we should get rid of these font.el dependencies...  They
 ;; are still presenting a problem with dumping the faces (font.el is

@@ -165,11 +176,11 @@ If FRAME is nil, use the default face."
         (fontobj (font-create-object font)))
     (font-bold-p fontobj)))
 
         (fontobj (font-create-object font)))
     (font-bold-p fontobj)))
 

-(defun custom-set-face-italic (face value &optional frame)
+(defun custom-set-face-italic (face value &optional frame tags)

   "Set the italic property of FACE to VALUE."
   (if value
   "Set the italic property of FACE to VALUE."
   (if value

-      (make-face-italic face frame)
-    (make-face-unitalic face frame)))
+      (make-face-italic face frame tags)
+    (make-face-unitalic face frame tags)))

 
 (defun custom-face-italic (face &rest args)
   "Return non-nil if the font of FACE is italic."
 
 (defun custom-face-italic (face &rest args)
   "Return non-nil if the font of FACE is italic."

@@ -178,20 +189,20 @@ If FRAME is nil, use the default face."
         (fontobj (font-create-object font)))
     (font-italic-p fontobj)))
 
         (fontobj (font-create-object font)))
     (font-italic-p fontobj)))
 

-(defun custom-face-stipple (face &rest args)
-  "Return the name of the stipple file used for FACE."
+(defun custom-face-background-pixmap (face &rest args)
+  "Return the name of the background pixmap file used for FACE."

   (let ((image  (apply 'specifier-instance 
                       (face-background-pixmap face) args)))
     (and image 
         (image-instance-file-name image))))
 
   (let ((image  (apply 'specifier-instance 
                       (face-background-pixmap face) args)))
     (and image 
         (image-instance-file-name image))))
 

-(defun custom-set-face-font-size (face size &rest args)
+(defun custom-set-face-font-size (face size &optional locale tags)

   "Set the font of FACE to SIZE"
   "Set the font of FACE to SIZE"

-  (let* ((font (apply 'face-font-name face args))
+  (let* ((font (apply 'face-font-name face locale))

         ;; Gag
         (fontobj (font-create-object font)))
     (set-font-size fontobj size)
         ;; Gag
         (fontobj (font-create-object font)))
     (set-font-size fontobj size)

-    (apply 'font-set-face-font face fontobj args)))
+    (apply 'font-set-face-font face fontobj locale tags)))

 
 (defun custom-face-font-size (face &rest args)
   "Return the size of the font of FACE as a string."
 
 (defun custom-face-font-size (face &rest args)
   "Return the size of the font of FACE as a string."

@@ -200,13 +211,13 @@ If FRAME is nil, use the default face."
         (fontobj (font-create-object font)))
     (format "%s" (font-size fontobj))))
 
         (fontobj (font-create-object font)))
     (format "%s" (font-size fontobj))))
 

-(defun custom-set-face-font-family (face family &rest args)
+(defun custom-set-face-font-family (face family &optional locale tags)

   "Set the font of FACE to FAMILY."
   "Set the font of FACE to FAMILY."

-  (let* ((font (apply 'face-font-name face args))
+  (let* ((font (apply 'face-font-name face locale))

         ;; Gag
         (fontobj (font-create-object font)))
     (set-font-family fontobj family)
         ;; Gag
         (fontobj (font-create-object font)))
     (set-font-family fontobj family)

-    (apply 'font-set-face-font face fontobj args)))
+    (apply 'font-set-face-font face fontobj locale tags)))

 
 (defun custom-face-font-family (face &rest args)
   "Return the name of the font family of FACE."
 
 (defun custom-face-font-family (face &rest args)
   "Return the name of the font family of FACE."

@@ -215,6 +226,15 @@ If FRAME is nil, use the default face."
         (fontobj (font-create-object font)))
     (font-family fontobj)))
 
         (fontobj (font-create-object font)))
     (font-family fontobj)))
 

+;;;###autoload
+(defun custom-set-face-update-spec (face display plist)
+  "Customize the FACE for display types matching DISPLAY, merging
+  in the new items from PLIST"
+  (let ((spec (face-spec-update-all-matching (custom-face-get-spec face)
+                                            display plist)))
+    (put face 'customized-face spec)
+    (face-spec-set face spec nil '(custom))))
+

 ;;; Initializing.
 
 ;;;###autoload
 ;;; Initializing.
 
 ;;;###autoload

@@ -240,7 +260,7 @@ See `defface' for the format of SPEC."
            (when (or now (find-face face))
              (unless (find-face face)
                (make-empty-face face))
            (when (or now (find-face face))
              (unless (find-face face)
                (make-empty-face face))

-             (face-spec-set face spec))
+             (face-spec-set face spec nil '(custom)))

            (setq args (cdr args)))
        ;; Old format, a plist of FACE SPEC pairs.
        (let ((face (nth 0 args))
            (setq args (cdr args)))
        ;; Old format, a plist of FACE SPEC pairs.
        (let ((face (nth 0 args))