diff lisp/custom/cus-face.el @ 120:cca96a509cfe r20-1b12

Import from CVS: tag r20-1b12
author cvs
date Mon, 13 Aug 2007 09:25:29 +0200
parents 7d55a9ba150c
children 9b50b4588a93
line wrap: on
line diff
--- a/lisp/custom/cus-face.el	Mon Aug 13 09:24:19 2007 +0200
+++ b/lisp/custom/cus-face.el	Mon Aug 13 09:25:29 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.69
+;; Version: 1.74
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -33,6 +33,10 @@
       (color-instance-name (specifier-instance (face-foreground face) frame)))
   (defalias 'custom-face-foreground 'face-foreground))
 
+(defalias 'custom-face-font-name (if (string-match "XEmacs" emacs-version)
+				     'face-font-name
+				   'face-font))
+
 (eval-and-compile
   (unless (fboundp 'frame-property)
     ;; XEmacs function missing in Emacs 19.34.
@@ -276,11 +280,13 @@
 (defconst custom-face-attributes
   '((:bold (toggle :format "Bold: %[%v%]\n"
 		   :help-echo "Control whether a bold font should be used.")
-	   custom-set-face-bold)
+	   custom-set-face-bold 
+	   custom-face-bold)
     (:italic (toggle :format "Italic: %[%v%]\n"
 		     :help-echo "\
 Control whether an italic font should be used.")
-	     custom-set-face-italic)
+	     custom-set-face-italic
+	     custom-face-italic)
     (:underline (toggle :format "Underline: %[%v%]\n"
 			:help-echo "\
 Control whether the text should be underlined.")
@@ -306,7 +312,7 @@
     ;;	       (custom-invert-face face frame)))
     (:stipple (editable-field :format "Stipple: %v"
 			      :help-echo "Name of background bitmap file.")
-	      set-face-stipple))
+	      set-face-stipple custom-face-stipple))
   "Alist of face attributes. 
 
 The elements are of the form (KEY TYPE SET GET) where KEY is a symbol
@@ -339,6 +345,10 @@
 Each keyword should be listed in `custom-face-attributes'.
 
 If FRAME is nil, use the default face."
+  (condition-case nil
+      ;; Attempt to get `font.el' from w3.
+      (require 'font)
+    (error nil))
   (let ((atts custom-face-attributes)
 	att result get)
     (while atts
@@ -358,43 +368,80 @@
       (make-face-bold face frame)
     (make-face-unbold face frame)))
 
+(defun custom-face-bold (face &rest args)
+  "Return non-nil if the font of FACE is bold."
+  (let* ((font (apply 'custom-face-font-name face args))
+	 (fontobj (font-create-object font)))
+    (font-bold-p fontobj)))
+
 (defun custom-set-face-italic (face value &optional frame)
   "Set the italic property of FACE to VALUE."
   (if value
       (make-face-italic face frame)
     (make-face-unitalic face frame)))
 
+(defun custom-face-italic (face &rest args)
+  "Return non-nil if the font of FACE is italic."
+  (let* ((font (apply 'custom-face-font-name face args))
+	 (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."
+  (if (string-match "XEmacs" emacs-version)
+      (let ((image  (apply 'specifier-instance 
+			   (face-background-pixmap face) args)))
+	(when image 
+	  (image-instance-file-name image)))
+    (apply 'face-stipple face args)))
+
 (when (string-match "XEmacs" emacs-version)
   ;; Support for special XEmacs font attributes.
   (autoload 'font-create-object "font" nil)
 
-  (unless (fboundp 'face-font-name)
-    (defun face-font-name (face &rest args)
-      (apply 'face-font face args)))
-
   (defun custom-set-face-font-size (face size &rest args)
     "Set the font of FACE to SIZE"
-    (let* ((font (apply 'face-font-name face args))
+    (let* ((font (apply 'custom-face-font-name face args))
 	   (fontobj (font-create-object font)))
       (set-font-size fontobj size)
       (apply 'font-set-face-font face fontobj args)))
 
+  (defun custom-face-font-size (face &rest args)
+    "Return the size of the font of FACE as a string."
+    (let* ((font (apply 'custom-face-font-name face args))
+	   (fontobj (font-create-object font)))
+      (format "%d" (font-size fontobj))))
+
   (defun custom-set-face-font-family (face family &rest args)
-    "Set the font of FACE to FAMILY"
-    (let* ((font (apply 'face-font-name face args))
+    "Set the font of FACE to FAMILY."
+    (let* ((font (apply 'custom-face-font-name face args))
 	   (fontobj (font-create-object font)))
       (set-font-family fontobj family)
       (apply 'font-set-face-font face fontobj args)))
 
-  (nconc custom-face-attributes
-	 '((:family (editable-field :format "Font Family: %v"
-				    :help-echo "\
+  (defun custom-face-font-family (face &rest args)
+    "Return the name of the font family of FACE."
+    (let* ((font (apply 'custom-face-font-name face args))
+	   (fontobj (font-create-object font)))
+      (font-family fontobj)))
+
+  (setq custom-face-attributes
+	(append '((:family (editable-field :format "Font Family: %v"
+					  :help-echo "\
 Name of font family to use (e.g. times).") 
-		    custom-set-face-font-family)
-	   (:size (editable-field :format "Size: %v"
-				  :help-echo "\
+			  custom-set-face-font-family
+			  custom-face-font-family)
+		  (:size (editable-field :format "Size: %v"
+					 :help-echo "\
 Text size (e.g. 9pt or 2mm).")
-		  custom-set-face-font-size))))
+			 custom-set-face-font-size
+			 custom-face-font-size)
+		  (:strikethru (toggle :format "Strikethru: %[%v%]\n"
+				      :help-echo "\
+Control whether the text should be strikethru.")
+			       set-face-strikethru-p
+			       face-strikethru-p))
+		custom-face-attributes)))
 
 ;;; Frames.
 
@@ -502,10 +549,6 @@
 		 (custom-get-frame-properties frame))
     (custom-initialize-faces frame)))
 
-;; Enable.  This should go away when bundled with Emacs.
-(unless (string-match "XEmacs" emacs-version)
-  (add-hook 'after-make-frame-hook 'custom-initialize-frame))
-
 ;;; Initializing.
 
 (and (fboundp 'make-face)