forked from pool/xemacs
149 lines
5.5 KiB
Diff
149 lines
5.5 KiB
Diff
|
|
||
|
|
# 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
|
||
|
|
|