(facep): New function.

(internal-check-face): Don't make a loop, since signal can't return.

1 files changed, 17 insertions, 6 deletions

diff --git a/lisp/faces.el b/lisp/faces.el
index 8c928962e73..6ee8465b714 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -49,9 +49,15 @@
 (defsubst internal-facep (x)
   (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face)))
 
+(defun facep (x)
+  "Return t if X is a face name or an internal face vector."
+  (and (or (internal-facep x)
+	   (and (symbolp x) (assq x global-face-data)))
+       t))
+      
 (defmacro internal-check-face (face)
-  (` (while (not (internal-facep (, face)))
-       (setq (, face) (signal 'wrong-type-argument (list 'internal-facep (, face)))))))
+  (` (or (internal-facep (, face))
+	 (signal 'wrong-type-argument (list 'internal-facep (, face))))))
 
 ;;; Accessors.
 (defun face-name (face)
@@ -547,10 +553,15 @@ also the same size as FACE on FRAME, or fail."
       (let ((fonts (x-list-fonts pattern face frame)))
 	(or fonts
 	    (if face
-		(error "No fonts matching pattern are the same size as `%s'"
-		       (if (null (face-font face))
-			   (cdr (assq 'font (frame-parameters frame)))
-			 face))
+		(if (string-match "\\*" pattern)
+		    (if (null (face-font face))
+			(error "No matching fonts are the same height as the frame default font")
+		      (error "No matching fonts are the same height as face `%s'" face))
+		  (if (null (face-font face))
+		      (error "Height of font `%s' doesn't match the frame default font"
+			     pattern)
+		    (error "Height of font `%s' doesn't match face `%s'"
+			   pattern face)))
 	      (error "No fonts match `%s'" pattern)))
 	(car fonts))
     (cdr (assq 'font (frame-parameters (selected-frame))))))