Mercurial > hg > xemacs-beta
diff lisp/cus-face.el @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | 74fd4e045ea6 |
children | ebe98a74bd68 |
line wrap: on
line diff
--- a/lisp/cus-face.el Mon Aug 13 11:19:22 2007 +0200 +++ b/lisp/cus-face.el Mon Aug 13 11:20:41 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> -;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> +;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> ;; Keywords: help, faces ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ @@ -30,7 +30,6 @@ "Like `defface', but FACE is evaluated as a normal argument." ;; (when (fboundp 'pureload) ;; (error "Attempt to declare a face during dump")) - ;; #### should we possibly reset force-face here? (unless (get face 'face-defface-spec) (put face 'face-defface-spec spec) (unless (find-face face) @@ -40,12 +39,12 @@ frame) ;; Create global face. (make-empty-face face) - (face-display-set face value nil '(custom)) + (face-display-set face value) ;; Create frame local faces (while frames (setq frame (car frames) frames (cdr frames)) - (face-display-set face value frame '(custom))) + (face-display-set face value frame)) (init-face-from-resources face))) (when (and doc (null (face-doc-string face))) (set-face-doc-string face doc)) @@ -70,7 +69,7 @@ custom-set-face-font-size custom-face-font-size) (:family (editable-field :format "Font Family: %v" :help-echo "\ -Name of font family to use (e.g. times).") +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 "\ @@ -111,7 +110,7 @@ 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 tags &rest atts) +(defun face-custom-attributes-set (face frame &rest atts) "For FACE on FRAME set the attributes [KEYWORD VALUE].... Each keyword should be listed in `custom-face-attributes'. @@ -122,7 +121,7 @@ (fun (nth 2 (assq name custom-face-attributes)))) (setq atts (cdr (cdr atts))) (condition-case nil - (funcall fun face value frame tags) + (funcall fun face value frame) (error nil))))) (defun face-custom-attributes-get (face frame) @@ -158,11 +157,11 @@ (list (list t (face-custom-attributes-get symbol (selected-frame)))))) -(defun custom-set-face-bold (face value &optional frame tags) +(defun custom-set-face-bold (face value &optional frame) "Set the bold property of FACE to VALUE." (if value - (make-face-bold face frame tags) - (make-face-unbold face frame tags))) + (make-face-bold face frame) + (make-face-unbold face frame))) ;; Really, we should get rid of these font.el dependencies... They ;; are still presenting a problem with dumping the faces (font.el is @@ -177,11 +176,11 @@ (fontobj (font-create-object font))) (font-bold-p fontobj))) -(defun custom-set-face-italic (face value &optional frame tags) +(defun custom-set-face-italic (face value &optional frame) "Set the italic property of FACE to VALUE." (if value - (make-face-italic face frame tags) - (make-face-unitalic face frame tags))) + (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." @@ -197,13 +196,13 @@ (and image (image-instance-file-name image)))) -(defun custom-set-face-font-size (face size &optional locale tags) +(defun custom-set-face-font-size (face size &rest args) "Set the font of FACE to SIZE" - (let* ((font (apply 'face-font-name face locale)) + (let* ((font (apply 'face-font-name face args)) ;; Gag (fontobj (font-create-object font))) (set-font-size fontobj size) - (apply 'font-set-face-font face fontobj locale tags))) + (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." @@ -212,13 +211,13 @@ (fontobj (font-create-object font))) (format "%s" (font-size fontobj)))) -(defun custom-set-face-font-family (face family &optional locale tags) +(defun custom-set-face-font-family (face family &rest args) "Set the font of FACE to FAMILY." - (let* ((font (apply 'face-font-name face locale)) + (let* ((font (apply 'face-font-name face args)) ;; Gag (fontobj (font-create-object font))) (set-font-family fontobj family) - (apply 'font-set-face-font face fontobj locale tags))) + (apply 'font-set-face-font face fontobj args))) (defun custom-face-font-family (face &rest args) "Return the name of the font family of FACE." @@ -234,101 +233,40 @@ (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)))) + (face-spec-set face spec))) ;;; Initializing. ;;;###autoload (defun custom-set-faces (&rest args) "Initialize faces according to user preferences. -This asociates the setting with the USER theme. The arguments should be a list where each entry has the form: - (FACE SPEC [NOW [COMMENT]]) + (FACE SPEC [NOW]) SPEC will be stored as the saved value for FACE. If NOW is present and non-nil, FACE will also be created according to SPEC. -COMMENT is a string comment about FACE. See `defface' for the format of SPEC." - (apply #'custom-theme-set-faces 'user args)) - -;;;###autoload -(defun custom-theme-set-faces (theme &rest args) - "Initialize faces according to settings specified by args. -Records the settings as belonging to THEME. - -See `custom-set-faces' for a description of the arguments ARGS." - (custom-check-theme theme) - (let ((immediate (get theme 'theme-immediate))) - (while args - (let ((entry (car args))) - (if (listp entry) - (let ((face (nth 0 entry)) - (spec (nth 1 entry)) - (now (nth 2 entry)) - (comment (nth 3 entry))) - (put face 'saved-face spec) - (custom-push-theme 'theme-face face theme 'set spec) - (put face 'saved-face-comment comment) - (when (or now immediate) - (put face 'force-face (if now 'rogue 'immediate))) - (when (or now immediate (find-face face)) - (put face 'face-comment comment) - (unless (find-face face) - (make-empty-face face)) - (face-spec-set face spec nil '(custom))) - (setq args (cdr args))) - ;; Old format, a plist of FACE SPEC pairs. - (let ((face (nth 0 args)) - (spec (nth 1 args))) + (while args + (let ((entry (car args))) + (if (listp entry) + (let ((face (nth 0 entry)) + (spec (nth 1 entry)) + (now (nth 2 entry))) (put face 'saved-face spec) - (custom-push-theme 'theme-face face theme 'set spec)) - (setq args (cdr (cdr args)))))))) - -;;;###autoload -(defun custom-theme-face-value (face theme) - "Return spec of FACE in THEME if the THEME modifies the -FACE. Nil otherwise." - (car-safe (custom-theme-value theme (get face 'theme-face)))) - -(defun custom-theme-reset-internal-face (face to-theme) - (let ((spec (custom-theme-face-value face to-theme)) - was-in-theme) - (setq was-in-theme spec) - (setq spec (or spec (get face 'standard-value))) - (when spec - (put face 'save-face was-in-theme) - (when (or (get face 'force-face) (find-face face)) + (when now + (put face 'force-face t)) + (when (or now (find-face face)) (unless (find-face face) (make-empty-face face)) - (face-spec-set face spec))) - spec)) - -;;;###autoload -(defun custom-theme-reset-faces (theme &rest args) - (custom-check-theme theme) - "Reset the value of the face to values previously defined. -Assosiate this setting with THEME. - -ARGS is a list of lists of the form - - (face to-theme) - -This means reset face to its value in to-theme." - (mapc #'(lambda (arg) - (apply #'custom-theme-reset-internal-face arg) - (custom-push-theme (car arg) 'theme-face theme 'reset (cadr arg))) - args)) - -;;;###autoload -(defun custom-reset-faces (&rest args) - "Reset the value of the face to values previously defined. -Assosiate this setting with the 'user' theme. - -ARGS is defined as for `custom-theme-reset-faces'" - (apply #'custom-theme-reset-faces 'user args)) - + (face-spec-set face spec)) + (setq args (cdr args))) + ;; Old format, a plist of FACE SPEC pairs. + (let ((face (nth 0 args)) + (spec (nth 1 args))) + (put face 'saved-face spec)) + (setq args (cdr (cdr args))))))) ;;; The End.