(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.

1 files changed, 52 insertions, 45 deletions

diff --git a/lisp/faces.el b/lisp/faces.el
index 003d732f141..8ed46f6e876 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -720,37 +720,43 @@ and colors.  If it is nil or not specified, the selected frame is
 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 @@ value to return if no new value is entered.  NAME is a descriptive
 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 @@ Value is the new attribute value."
                                                    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 @@ Value is the new attribute value."
 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 @@ of a global face.  Value is the new attribute value."
       (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")))