Mercurial > hg > xemacs-beta
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)