emacs: lisp/faces.el comparison

comparison lisp/faces.el @ 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	b145fd152286
children	3aba9b200c5f

comparison

equal deleted inserted replaced

-:a12e632e1ef5
+:ef080d2576f9
 The optional argument FRAME is used to determine available fonts
 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
+(let (valid)
-(:family
+(setq valid
-(if window-system
+	  (case attribute
-	 (mapcar #'(lambda (x) (cons (car x) (car x)))
+	    (:family
-		 (x-font-family-list))
+	     (if window-system
-;; Only one font on TTYs.
+		 (mapcar #'(lambda (x) (cons (car x) (car x)))
-(cons "default" "default")))
+			 (x-font-family-list))
-((:width :weight :slant :inverse-video)
+	       ;; Only one font on TTYs.
-(mapcar #'(lambda (x) (cons (symbol-name x) x))
+	       (list (cons "default" "default"))))
-	     (internal-lisp-face-attribute-values attribute)))
+	    ((:width :weight :slant :inverse-video)
-((:underline :overline :strike-through :box)
+	     (mapcar #'(lambda (x) (cons (symbol-name x) x))
-(if window-system
+		     (internal-lisp-face-attribute-values attribute)))
-	 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
+	    ((:underline :overline :strike-through :box)
-			(internal-lisp-face-attribute-values attribute))
+	     (if window-system
-		(mapcar #'(lambda (c) (cons c c))
+		 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
-			(x-defined-colors frame)))
+				(internal-lisp-face-attribute-values attribute))
-(mapcar #'(lambda (x) (cons (symbol-name x) x))
+			(mapcar #'(lambda (c) (cons c c))
-	       (internal-lisp-face-attribute-values attribute))))
+				(x-defined-colors frame)))
-((:foreground :background)
+	       (mapcar #'(lambda (x) (cons (symbol-name x) x))
-(mapcar #'(lambda (c) (cons c c))
+		       (internal-lisp-face-attribute-values attribute))))
-	     (or (and window-system (x-defined-colors frame))
+	    ((:foreground :background)
-		 (tty-defined-colors))))
+	     (mapcar #'(lambda (c) (cons c c))
-((:height)
+		     (or (and window-system (x-defined-colors frame))
-'integerp)
+			 (tty-defined-colors))))
-(:stipple
+	    ((:height)
-(and window-system
+	     'integerp)
-	  (mapcar #'list
+	    (:stipple
-		  (apply #'nconc (mapcar #'directory-files
+	     (and window-system
-					 x-bitmap-file-path)))))
+		  (mapcar #'list
-(t
+			  (apply #'nconc (mapcar #'directory-files
-(error "Internal error"))))
+						 x-bitmap-file-path)))))
+	    (t
+	     (error "Internal error"))))
+(if (listp valid)
+	(nconc (list (cons "unspecified" 'unspecified)) valid)
+valid)))
 (defvar face-attribute-name-alist
 '((:family . "font family")
 (:width . "character set width")
 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.  COMPLETION-ALIST is an alist
 of valid values, if non-nil.
-Entering ``none'' as attribute value means an unspecified attribute
+Entering nothing accepts the default value DEFAULT.
-value.  Entering nothing accepts the default value DEFAULT.
 Value is the new attribute value."
 (let* ((completion-ignore-case t)
 	 (value (completing-read
 		 (if default
 		     (format "Set face %s %s (default %s): "
 			     face name (downcase (if (symbolp default)
 						     (symbol-name default)
 						   default)))
 		   (format "Set face %s %s: " face name))
 		 completion-alist)))
-(if (equal value "none")
+(if (equal value "") default value)))
-	nil
-(if (equal value "") default value))))
 (defun face-read-integer (face default name)
 "Interactively read an integer face 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
+(let ((new-value
-				     (and default (int-to-string default))
+	 (face-read-string face
-				     name)))
+			   (if (eq default 'unspecified)
-(and new-value
+			       'unspecified
-	 (string-to-int new-value))))
+			     (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)
 "Interactively read a new value for FACE's ATTRIBUTE.
 Optional argument FRAME nil or unspecified means read an attribute value
 	       (or (consp old-value)
 		   (vectorp old-value)))
 (setq old-value (prin1-to-string old-value)))
 (cond ((listp valid)
 	   (setq new-value
-		 (cdr (assoc (face-read-string face old-value
+		 (face-read-string face old-value attribute-name valid))
-					       attribute-name valid)
+	   (unless (eq new-value 'unspecified)
-			     valid))))
+	     (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")))
 ;; Convert stipple and box value text we read back to a list or
 ;; vector if it looks like one.  This makes the assumption that a

Mercurial > emacs

comparison lisp/faces.el @ 25245:ef080d2576f9