Mercurial > emacs

changeset 2744:f4fc0c4c76f9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Re-arranged stuff to put defsubst accessors at the top
author Jim Blandy <jimb@redhat.com>
date Tue, 11 May 1993 19:14:34 +0000
parents ddc49d5eee56
children adf91f018312
files lisp/faces.el
diffstat 1 files changed, 84 insertions(+), 71 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/faces.el	Tue May 11 02:48:07 1993 +0000
+++ b/lisp/faces.el	Tue May 11 19:14:34 1993 +0000
@@ -24,6 +24,13 @@
 
 ;;; Code:
 
+
+;;;; Functions for manipulating face vectors.
+
+;;; A face vector is a vector of the form:
+;;;    [face ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE]
+
+;;; Type checkers.
 (defsubst internal-facep (x)
   (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face)))
 
@@ -31,38 +38,7 @@
   (` (while (not (internal-facep (, face)))
        (setq (, face) (signal 'wrong-type-argument (list 'internal-facep (, face)))))))
 
-
-(defvar global-face-data nil "do not use this")
-
-(defun face-list ()
-  "Returns a list of all defined face names."
-  (mapcar 'car global-face-data))
-
-(defun internal-find-face (name &optional frame)
-  "Retrieve the face named NAME.  Return nil if there is no such face.
-If the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
-  (if (and (eq frame t) (not (symbolp name)))
-      (setq name (face-name name)))
-  (if (symbolp name)
-      (cdr (assq name
-		 (if (eq frame t)
-		     global-face-data
-		   (frame-face-alist (or frame (selected-frame))))))
-    (internal-check-face name)
-    name))
-
-(defun internal-get-face (name &optional frame)
-  "Retrieve the face named NAME; error if there is none.
-If the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
-  (or (internal-find-face name frame)
-      (internal-check-face name)))
-
+;;; Accessors.
 (defsubst face-name (face)
   "Return the name of face FACE."
   (aref (internal-get-face face) 1))
@@ -101,45 +77,8 @@
 Otherwise report on the defaults for face FACE (for new frames)."
  (aref (internal-get-face face frame) 7))
 
-
-(defun internal-set-face-1 (face name value index frame)
-  (let ((inhibit-quit t))
-    (if (null frame)
-	(let ((frames (frame-list)))
-	  (while frames
-	    (internal-set-face-1 (face-name face) name value index (car frames))
-	    (setq frames (cdr frames)))
-	  (aset (internal-get-face (if (symbolp face) face (face-name face)) t)
-		index value)
-	  value)
-      (or (eq frame t)
-	  (set-face-attribute-internal (face-id face) name value frame))
-      (aset (internal-get-face face frame) index value))))
-
-
-(defun read-face-name (prompt)
-  (let (face)
-    (while (= (length face) 0)
-      (setq face (completing-read prompt
-				  (mapcar '(lambda (x) (list (symbol-name x)))
-					  (face-list))
-				  nil t)))
-    (intern face)))
-
-(defun internal-face-interactive (what &optional bool)
-  (let* ((fn (intern (concat "face-" what)))
-	 (prompt (concat "Set " what " of face"))
-	 (face (read-face-name (concat prompt ": ")))
-	 (default (if (fboundp fn)
-		      (or (funcall fn face (selected-frame))
-			  (funcall fn 'default (selected-frame)))))
-	 (value (if bool
-		    (y-or-n-p (concat "Should face " (symbol-name face)
-				      " be " bool "? "))
-		  (read-string (concat prompt " " (symbol-name face) " to: ")
-			       default))))
-    (list face (if (equal value "") nil value))))
-
+
+;;; Mutators.
 
 (defsubst set-face-font (face font &optional frame)
   "Change the font of face FACE to FONT (a string).
@@ -183,6 +122,80 @@
   (interactive (internal-face-interactive "underline-p" "underlined"))
   (internal-set-face-1 face 'underline underline-p 7 frame))
 
+
+;;;; Associating face names (symbols) with their face vectors.
+
+(defvar global-face-data nil "do not use this")
+
+(defun face-list ()
+  "Returns a list of all defined face names."
+  (mapcar 'car global-face-data))
+
+(defun internal-find-face (name &optional frame)
+  "Retrieve the face named NAME.  Return nil if there is no such face.
+If the optional argument FRAME is given, this gets the face NAME for
+that frame; otherwise, it uses the selected frame.
+If FRAME is the symbol t, then the global, non-frame face is returned.
+If NAME is already a face, it is simply returned."
+  (if (and (eq frame t) (not (symbolp name)))
+      (setq name (face-name name)))
+  (if (symbolp name)
+      (cdr (assq name
+		 (if (eq frame t)
+		     global-face-data
+		   (frame-face-alist (or frame (selected-frame))))))
+    (internal-check-face name)
+    name))
+
+(defun internal-get-face (name &optional frame)
+  "Retrieve the face named NAME; error if there is none.
+If the optional argument FRAME is given, this gets the face NAME for
+that frame; otherwise, it uses the selected frame.
+If FRAME is the symbol t, then the global, non-frame face is returned.
+If NAME is already a face, it is simply returned."
+  (or (internal-find-face name frame)
+      (internal-check-face name)))
+
+
+(defun internal-set-face-1 (face name value index frame)
+  (let ((inhibit-quit t))
+    (if (null frame)
+	(let ((frames (frame-list)))
+	  (while frames
+	    (internal-set-face-1 (face-name face) name value index (car frames))
+	    (setq frames (cdr frames)))
+	  (aset (internal-get-face (if (symbolp face) face (face-name face)) t)
+		index value)
+	  value)
+      (or (eq frame t)
+	  (set-face-attribute-internal (face-id face) name value frame))
+      (aset (internal-get-face face frame) index value))))
+
+
+(defun read-face-name (prompt)
+  (let (face)
+    (while (= (length face) 0)
+      (setq face (completing-read prompt
+				  (mapcar '(lambda (x) (list (symbol-name x)))
+					  (face-list))
+				  nil t)))
+    (intern face)))
+
+(defun internal-face-interactive (what &optional bool)
+  (let* ((fn (intern (concat "face-" what)))
+	 (prompt (concat "Set " what " of face"))
+	 (face (read-face-name (concat prompt ": ")))
+	 (default (if (fboundp fn)
+		      (or (funcall fn face (selected-frame))
+			  (funcall fn 'default (selected-frame)))))
+	 (value (if bool
+		    (y-or-n-p (concat "Should face " (symbol-name face)
+				      " be " bool "? "))
+		  (read-string (concat prompt " " (symbol-name face) " to: ")
+			       default))))
+    (list face (if (equal value "") nil value))))
+
+
 
 (defun make-face (name)
   "Define a new FACE on all frames.