X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fcus-face.el;h=cf4755db8bf7889bdc3e9515d945758c359bd77f;hp=09e7771a2e62035dfec01201a4f1e31eeaa8143a;hb=1c97bf160520f9e0b193236a902eb4b73d59d134;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 09e7771..cf4755d 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -39,12 +39,12 @@ 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)) - (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)) @@ -67,13 +67,17 @@ :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) + (: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) @@ -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) - ;; #### Should make it work on X (: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.") -(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'. @@ -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 - (funcall fun face value frame) + (funcall fun face value frame tags) (error nil))))) (defun face-custom-attributes-get (face frame) @@ -146,11 +149,19 @@ If FRAME is nil, use the default face." (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 - (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 @@ -165,11 +176,11 @@ If FRAME is nil, use the default face." (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 - (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." @@ -178,20 +189,20 @@ If FRAME is nil, use the default face." (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)))) -(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" - (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) - (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." @@ -200,13 +211,13 @@ If FRAME is nil, use the default face." (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." - (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) - (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." @@ -215,6 +226,15 @@ If FRAME is nil, use the default face." (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 @@ -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)) - (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))