File changeset-dec62ca5a899.patch of Package xemacs

Overview Repositories Revisions Requests Users Attributes Meta

File changeset-dec62ca5a899.patch of Package xemacs

# HG changeset patch
# User Stephen J. Turnbull <stephen@xemacs.org>
# Date 1259891798 -32400
# Node ID dec62ca5a899f41688a663765df1aefddfae6351
# Parent 75975fd0b7fc8043f7fc719439c225fa739134d9
Prevent font frobbers from operating on TTY specs.

--- lisp/ChangeLog	Wed Nov 18 22:44:28 2009 +0900
+++ lisp/ChangeLog	Fri Dec 04 10:56:38 2009 +0900
@@ -79,6 +79,20 @@
 	Update docstring.
 	(narrow-to-defun):
 	Document that optional ARG is ignored.
+
+2009-11-01  Stephen Turnbull  <stephen@xemacs.org>
+
+	* faces.el (Face-frob-property):
+	Give mapper for TTYs 2 args.
+	(make-face-family):
+	(make-face-size):
+	Generic mapper ignores TTYs and null devices.
+	(make-face-bold):
+	(make-face-italic):
+	(make-face-bold-italic):
+	(make-face-unbold):
+	(make-face-unitalic):
+	TTY mapper takes 2 args.
 
 2009-10-09  Stephen Turnbull  <stephen@xemacs.org>
 
--- lisp/faces.el	Wed Nov 18 22:44:28 2009 +0900
+++ lisp/faces.el	Fri Dec 04 10:56:38 2009 +0900
@@ -933,10 +933,11 @@
   ;; and EXACT-P are as in that call.  UNFROBBED-FACE and FROBBED-FACE are
   ;; what we expect the original face and the result to look like,
   ;; respectively.  TTY-PROPS is a list of face properties to frob in place
-  ;; of `font' for TTY's.  FROB-MAPPING is either a plist mapping device
+  ;; of `font' for TTYs.  FROB-MAPPING is either a plist mapping device
   ;; types to functions of two args (NAME DEVICE) that will frob the
-  ;; instantiator as appropriate for the device type (this includes TTY's),
-  ;; or a function to handle the mapping for all device types.
+  ;; instantiator to NAME as appropriate for DEVICE's type (this includes
+  ;; TTYs #### TTYs are not passed the device, just the symbol 'tty), or a
+  ;; function to handle the mapping for all device types.
   ;; STANDARD-FACE-MAPPING is an alist of mappings of inheritance
   ;; instantiators to be replaced with other inheritance instantiators, meant
   ;; for e.g. converting [bold] into [bold-italic].
@@ -1038,7 +1039,11 @@
 			       (t
 				(let ((value
 				       (if (eq devtype-spec 'tty)
-					   (funcall mapper x)
+					   ;; #### not quite right but need
+					   ;; two args to match documentation
+					   ;; mostly we just ignore TTYs so
+					   ;; for now just pass the devtype
+					   (funcall mapper x 'tty)
 					 (funcall mapper x
 						  (derive-domain-from-locale
 						   locale devtype-spec
@@ -1193,11 +1198,16 @@
 
   (Face-frob-property face locale tags exact-p
 		      nil nil 'font nil
+		      ;; #### this code is duplicated in make-face-size
 		      `(lambda (f d)
-			  ;; keep the dependency on font.el for now
-			  (let ((fo (font-create-object f d)))
-			    (set-font-family fo ,family)
-			    (font-create-name fo d)))
+			 ;; keep the dependency on font.el for now
+			 ;; #### The filter on null d is a band-aid.
+			 ;; Frob-face-property should not be passing in
+			 ;; null devices.
+			 (unless (or (null d) (eq d 'tty))
+			   (let ((fo (font-create-object f d)))
+			     (set-font-family fo ,family)
+			     (font-create-name fo d))))
 		      nil))
 
 ;; Style (ie, typographical face) frobbing
@@ -1311,7 +1321,7 @@
   (interactive (list (read-face-name "Make which face bold: ")))
   (Face-frob-property face locale tags exact-p
 		      'default 'bold 'font '(highlight)
-		      '(tty		(lambda (x) t)
+		      '(tty		(lambda (f d) t)
 			x		x-make-font-bold
 			gtk		gtk-make-font-bold
 			mswindows	mswindows-make-font-bold
@@ -1330,7 +1340,7 @@
   (interactive (list (read-face-name "Make which face italic: ")))
   (Face-frob-property face locale tags exact-p
 		      'default 'italic 'font '(underline)
-		      '(tty		(lambda (x) t)
+		      '(tty		(lambda (f d) t)
 			x		x-make-font-italic
 			gtk		gtk-make-font-italic
 			mswindows	mswindows-make-font-italic
@@ -1349,7 +1359,7 @@
   (interactive (list (read-face-name "Make which face bold-italic: ")))
   (Face-frob-property face locale tags exact-p
 		      'default 'bold-italic 'font '(underline highlight)
-		      '(tty		(lambda (x) t)
+		      '(tty		(lambda (f d) t)
 			x		x-make-font-bold-italic
 			gtk		gtk-make-font-bold-italic
 			mswindows	mswindows-make-font-bold-italic
@@ -1369,7 +1379,7 @@
   (interactive (list (read-face-name "Make which face non-bold: ")))
   (Face-frob-property face locale tags exact-p
 		      'bold 'default 'font '(highlight)
-		      '(tty		(lambda (x) nil)
+		      '(tty		(lambda (f d) nil)
 			x		x-make-font-unbold
 			gtk		gtk-make-font-unbold
 			mswindows	mswindows-make-font-unbold
@@ -1388,7 +1398,7 @@
   (interactive (list (read-face-name "Make which face non-italic: ")))
   (Face-frob-property face locale tags exact-p
 		      'italic 'default 'font '(underline)
-		      '(tty		(lambda (x) nil)
+		      '(tty		(lambda (f d) nil)
 			x		x-make-font-unitalic
 			gtk		gtk-make-font-unitalic
 			mswindows	mswindows-make-font-unitalic
@@ -1408,11 +1418,16 @@
 		     (read-number "Size to set: " t 10)))
   (Face-frob-property face locale tags exact-p
 		      nil nil 'font nil
+		      ;; #### this code is duplicated in make-face-family
 		      `(lambda (f d)
 			 ;; keep the dependency on font.el for now
-			 (let ((fo (font-create-object f d)))
-			   (set-font-size fo ,size)
-			   (font-create-name fo d)))
+			 ;; #### The filter on null d is a band-aid.
+			 ;; Frob-face-property should not be passing in
+			 ;; null devices.
+			 (unless (or (null d) (eq d 'tty))
+			   (let ((fo (font-create-object f d)))
+			     (set-font-size fo ,size)
+			     (font-create-name fo d))))
 		      nil))
 
 ;; Why do the following two functions lose so badly in so many

Places

File changeset-dec62ca5a899.patch of Package xemacs

Places