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")))