Mercurial > emacs
changeset 25245:ef080d2576f9
(face-valid-attribute-values): Return an alist for
families on ttys.
(face-read-integer): Handle unspecified face attributes. Add
completion for `unspecified'.
(read-face-attribute): Handle unspecified font attributes.
(face-valid-attribute-values): Add `unspecified' to lists so that
it can be chosen via completion.
(face-read-string): Don't recognize "none" as input.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 12 Aug 1999 14:35:33 +0000 |
parents | a12e632e1ef5 |
children | a4112d377648 |
files | lisp/faces.el |
diffstat | 1 files changed, 52 insertions(+), 45 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/faces.el Wed Aug 11 20:41:11 1999 +0000 +++ b/lisp/faces.el Thu Aug 12 14:35:33 1999 +0000 @@ -720,37 +720,43 @@ used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects an integer value." - (case attribute - (:family - (if window-system - (mapcar #'(lambda (x) (cons (car x) (car x))) - (x-font-family-list)) - ;; Only one font on TTYs. - (cons "default" "default"))) - ((:width :weight :slant :inverse-video) - (mapcar #'(lambda (x) (cons (symbol-name x) x)) - (internal-lisp-face-attribute-values attribute))) - ((:underline :overline :strike-through :box) - (if window-system - (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) - (internal-lisp-face-attribute-values attribute)) - (mapcar #'(lambda (c) (cons c c)) - (x-defined-colors frame))) - (mapcar #'(lambda (x) (cons (symbol-name x) x)) - (internal-lisp-face-attribute-values attribute)))) - ((:foreground :background) - (mapcar #'(lambda (c) (cons c c)) - (or (and window-system (x-defined-colors frame)) - (tty-defined-colors)))) - ((:height) - 'integerp) - (:stipple - (and window-system - (mapcar #'list - (apply #'nconc (mapcar #'directory-files - x-bitmap-file-path))))) - (t - (error "Internal error")))) + (let (valid) + (setq valid + (case attribute + (:family + (if window-system + (mapcar #'(lambda (x) (cons (car x) (car x))) + (x-font-family-list)) + ;; Only one font on TTYs. + (list (cons "default" "default")))) + ((:width :weight :slant :inverse-video) + (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (internal-lisp-face-attribute-values attribute))) + ((:underline :overline :strike-through :box) + (if window-system + (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (internal-lisp-face-attribute-values attribute)) + (mapcar #'(lambda (c) (cons c c)) + (x-defined-colors frame))) + (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (internal-lisp-face-attribute-values attribute)))) + ((:foreground :background) + (mapcar #'(lambda (c) (cons c c)) + (or (and window-system (x-defined-colors frame)) + (tty-defined-colors)))) + ((:height) + 'integerp) + (:stipple + (and window-system + (mapcar #'list + (apply #'nconc (mapcar #'directory-files + x-bitmap-file-path))))) + (t + (error "Internal error")))) + (if (listp valid) + (nconc (list (cons "unspecified" 'unspecified)) valid) + valid))) + (defvar face-attribute-name-alist @@ -785,9 +791,7 @@ name of the attribute for prompting. COMPLETION-ALIST is an alist of valid values, if non-nil. -Entering ``none'' as attribute value means an unspecified attribute -value. Entering nothing accepts the default value DEFAULT. - +Entering nothing accepts the default value DEFAULT. Value is the new attribute value." (let* ((completion-ignore-case t) (value (completing-read @@ -798,9 +802,7 @@ default))) (format "Set face %s %s: " face name)) completion-alist))) - (if (equal value "none") - nil - (if (equal value "") default value)))) + (if (equal value "") default value))) (defun face-read-integer (face default name) @@ -808,11 +810,16 @@ FACE is the face whose attribute is read. DEFAULT is the default value to return if no new value is entered. NAME is a descriptive name of the attribute for prompting. Value is the new attribute value." - (let ((new-value (face-read-string face - (and default (int-to-string default)) - name))) - (and new-value - (string-to-int new-value)))) + (let ((new-value + (face-read-string face + (if (eq default 'unspecified) + 'unspecified + (int-to-string default)) + name + (list (cons "unspecified" 'unspecified))))) + (if (eq new-value 'unspecified) + new-value + (string-to-int new-value)))) (defun read-face-attribute (face attribute &optional frame) @@ -834,9 +841,9 @@ (setq old-value (prin1-to-string old-value))) (cond ((listp valid) (setq new-value - (cdr (assoc (face-read-string face old-value - attribute-name valid) - valid)))) + (face-read-string face old-value attribute-name valid)) + (unless (eq new-value 'unspecified) + (setq new-value (cdr (assoc new-value valid))))) ((eq valid 'integerp) (setq new-value (face-read-integer face old-value attribute-name))) (t (error "Internal error")))