CVS update by aidan xemacs/src, faces.h, mule-charset.c,
objects-tty.c, redisplay-x.c, unicode.c ...
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Sun Nov 5 17:31:52 EST 2006
User: aidan
Date: 06/11/05 23:31:51
Modified: xemacs/src ChangeLog charset.h console-impl.h faces.c
faces.h font-mgr.h general-slots.h intl.c lisp.h
mule-charset.c objects-gtk.c objects-msw.c
objects-tty.c objects-x.c objects.c objects.h
redisplay-x.c redisplay.c specifier.c specifier.h
unicode.c
Added: xemacs/src objects-xlike-inc.c
Log:
Support specifying fonts for particular character sets in Mule; support
translation to ISO 10646-1 for Mule character sets without an otherwise
matching font; move to a vector of X11-charset-X11-registry instead of a
regex for the charset-registry property.
Revision Changes Path
1.768 +58 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.767
retrieving revision 1.768
diff -u -p -r1.767 -r1.768
--- ChangeLog 2006/11/01 23:14:31 1.767
+++ ChangeLog 2006/11/05 22:31:31 1.768
@@ -1,3 +1,61 @@
+2006-11-05 Aidan Kehoe <kehoea at parhasard.net>
+
+ * mule/arabic.el (arabic-digit):
+ * mule/arabic.el (arabic-1-column):
+ * mule/arabic.el (arabic-2-column):
+ * mule/chinese.el (make-chinese-cns11643-charset):
+ * mule/chinese.el (chinese-sisheng):
+ * mule/english.el (ascii-right-to-left):
+ * mule/ethiopic.el (ethiopic):
+ * mule/european.el (latin-iso8859-14):
+ * mule/european.el (latin-iso8859-16):
+ * mule/indian.el (indian-is13194):
+ * mule/indian.el (indian-1-column):
+ * mule/indian.el (indian-2-column):
+ * mule/japanese.el (japanese-jisx0213-1):
+ * mule/japanese.el (japanese-jisx0213-2):
+ * mule/lao.el (lao):
+ * mule/misc-lang.el (ipa):
+ * mule/mule-charset.el:
+ * mule/thai-xtis.el (thai-xtis):
+ * mule/tibetan.el (tibetan-1-column):
+ * mule/tibetan.el (tibetan):
+ * mule/vietnamese.el (vietnamese-viscii-lower):
+ * mule/vietnamese.el (vietnamese-viscii-upper):
+ Stop using the `registry' charset property; use `registries'
+ instead. The difference is that registries is an ordered vector of
+ X11 registries and encodings rather than a regexp; this means we
+ can leave the matching to the X11 server, avoiding transferring
+ huge amounts of data (perhaps across the network!) in order to do
+ a regexp search on it.
+ * mule/mule-charset.el (charset-registries): New.
+ charset-registries returns the registries of a charset;
+ * mule/mule-charset.el (set-charset-registry): Moved here from C.
+
+2006-11-05 Aidan Kehoe <kehoea at parhasard.net>
+
+ * faces.el (face-property-matching-instance):
+ Simplify.
+ * faces.el (face-font-instance):
+ Document CHARSET.
+ * faces.el (set-face-font):
+ Give more details on common values for font instantiators,
+ LOCALEs.
+ * unicode.el:
+ Remove a few comments that were only relevant to GNU Emacs.
+ * unicode.el (decode-char):
+ * unicode.el (encode-char):
+ Document CODE, CHAR using uppercase, since they're
+ parameters. Update commentary on GNU's mule-unicode charsets and
+ how we've solved the same problem.
+ * x-faces.el (x-init-face-from-resources):
+ Retain some of the fallbacks in the generated default face, since
+ it doesn't make sense to try Andale Mono's ISO-10646-1 encoding
+ for Amharic or Thai.
+ * x-font-menu.el (charset-registries):
+ * x-font-menu.el (x-reset-device-font-menus-core):
+ Use charset-registries instead of charset-registry.
+
2006-11-02 Adrian Aichner <adrian at xemacs.org>
* font-lock.el: Sync font-lock-add-keywords and
1.39 +30 -25 XEmacs/xemacs/lisp/faces.el
Index: faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -p -r1.38 -r1.39
--- faces.el 2006/04/25 14:01:52 1.38
+++ faces.el 2006/11/05 22:31:32 1.39
@@ -250,19 +250,9 @@ matching process."
(setq face (get-face face))
(let ((value (get face property)))
- (if (specifierp value)
- (setq value (if (or (charsetp matchspec)
- (and (symbolp matchspec)
- (find-charset matchspec)))
- (or
- (specifier-matching-instance
- value (cons matchspec nil) domain default
- no-fallback)
- (specifier-matching-instance
- value (cons matchspec t) domain default
- no-fallback))
- (specifier-matching-instance value matchspec domain
- default no-fallback))))
+ (when (specifierp value)
+ (setq value (specifier-matching-instance value matchspec domain
+ default no-fallback)))
value))
(defun set-face-property (face property value &optional locale tag-set
@@ -473,25 +463,40 @@ Normally DOMAIN will be a window or nil
and an instance object describing how the font appears in that
particular window and buffer will be returned.
+CHARSET is a Mule charset (meaning return the font used for that charset) or
+nil (meaning return the font used for ASCII.)
+
See `face-property-instance' for more information."
- (if charset
- (face-property-matching-instance face 'font charset domain)
- (face-property-instance face 'font domain)))
+ (if (null charset)
+ (face-property-instance face 'font domain)
+ (let (matchspec)
+ ;; get-charset signals an error if its argument doesn't have an
+ ;; associated charset.
+ (setq charset (get-charset charset)
+ matchspec (cons charset nil))
+ (or (null (setcdr matchspec 'initial))
+ (face-property-matching-instance
+ face 'font matchspec domain)
+ (null (setcdr matchspec 'final))
+ (face-property-matching-instance
+ face 'font matchspec domain)))))
(defun set-face-font (face font &optional locale tag-set how-to-add)
"Change the font of FACE to FONT in LOCALE.
FACE may be either a face object or a symbol representing a face.
-FONT should be an instantiator (see `make-font-specifier'), a list of
- instantiators, an alist of specifications (each mapping a
- locale to an instantiator list), or a font specifier object.
-
-If FONT is an alist, LOCALE must be omitted. If FONT is a
- specifier object, LOCALE can be a locale, a locale type, `all',
- or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
- specifies the locale under which the specified instantiator(s)
- will be added, and defaults to `global'.
+FONT should be an instantiator (see `make-font-specifier'; a common
+ instantiator is a platform-dependent string naming the font), a list
+ of instantiators, an alist of specifications (each mapping a locale
+ to an instantiator list), or a font specifier object.
+
+If FONT is an alist, LOCALE must be omitted. If FONT is a specifier
+ object, LOCALE can be a locale, a locale type, `all', or nil; see
+ `copy-specifier' for its semantics. Common LOCALEs are buffer
+ objects, window objects, device objects and `global'. Otherwise
+ LOCALE specifies the locale under which the specified
+ instantiator(s) will be added, and defaults to `global'.
See `set-face-property' for more information."
(interactive (face-interactive "font"))
1.15 +14 -82 XEmacs/xemacs/lisp/unicode.el
Index: unicode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/unicode.el,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -p -r1.14 -r1.15
--- unicode.el 2006/07/13 20:45:49 1.14
+++ unicode.el 2006/11/05 22:31:32 1.15
@@ -29,54 +29,19 @@
;;; Code:
-; ;; Subsets of Unicode.
+;; GNU Emacs has the charsets:
-; #### what is this bogosity ... "chars 96, final ?2" !!?!
-; (make-charset 'mule-unicode-2500-33ff
-; "Unicode characters of the range U+2500..U+33FF."
-; '(dimension
-; 2
-; registry "ISO10646-1"
-; chars 96
-; columns 1
-; direction l2r
-; final ?2
-; graphic 0
-; short-name "Unicode subset 2"
-; long-name "Unicode subset (U+2500..U+33FF)"
-; ))
-
-
-; (make-charset 'mule-unicode-e000-ffff
-; "Unicode characters of the range U+E000..U+FFFF."
-; '(dimension
-; 2
-; registry "ISO10646-1"
-; chars 96
-; columns 1
-; direction l2r
-; final ?3
-; graphic 0
-; short-name "Unicode subset 3"
-; long-name "Unicode subset (U+E000+FFFF)"
-; ))
-
-
-; (make-charset 'mule-unicode-0100-24ff
-; "Unicode characters of the range U+0100..U+24FF."
-; '(dimension
-; 2
-; registry "ISO10646-1"
-; chars 96
-; columns 1
-; direction l2r
-; final ?1
-; graphic 0
-; short-name "Unicode subset"
-; long-name "Unicode subset (U+0100..U+24FF)"
-; ))
+;; mule-unicode-2500-33ff
+;; mule-unicode-e000-ffff
+;; mule-unicode-0100-24ff
+
+;; built-in. This is hack--and an incomplete hack at that--against the
+;; spirit and the letter of standard ISO 2022 character sets. Instead of
+;; this, we have the jit-ucs-charset-N Mule character sets, created in
+;; unicode.c on encountering a Unicode code point that we don't recognise,
+;; and saved in ISO 2022 coding systems using the UTF-8 escape described in
+;; ISO-IR 196.
-
;; accessed in loadup.el, mule-cmds.el; see discussion in unicode.c
(defvar load-unicode-tables-at-dump-time (eq system-type 'windows-nt)
"[INTERNAL] Whether to load the Unicode tables at dump time.
@@ -305,51 +270,19 @@ Standard encoding for representing UTF-8
need-bom t))
(defun decode-char (quote-ucs code &optional restriction)
- "FSF compatibility--return Mule character with Unicode codepoint `code'.
+ "FSF compatibility--return Mule character with Unicode codepoint CODE.
The second argument must be 'ucs, the third argument is ignored. "
(assert (eq quote-ucs 'ucs) t
"Sorry, decode-char doesn't yet support anything but the UCS. ")
(unicode-to-char code))
(defun encode-char (char quote-ucs &optional restriction)
- "FSF compatibility--return the Unicode code point of `char'.
+ "FSF compatibility--return the Unicode code point of CHAR.
The second argument must be 'ucs, the third argument is ignored. "
(assert (eq quote-ucs 'ucs) t
"Sorry, encode-char doesn't yet support anything but the UCS. ")
(char-to-unicode char))
-(when (featurep 'mule)
- ;; This CCL program is used for displaying the fallback UCS character set,
- ;; and can be repurposed to lao and the IPA, all going well.
- ;;
- ;; define-ccl-program is available after mule-ccl is loaded, much later
- ;; than this file in the build process. The below is the result of
- ;;
- ;; (macroexpand
- ;; '(define-ccl-program ccl-encode-to-ucs-2
- ;; `(1
- ;; ((r1 = (r1 << 8))
- ;; (r1 = (r1 | r2))
- ;; (mule-to-unicode r0 r1)
- ;; (r1 = (r0 >> 8))
- ;; (r2 = (r0 & 255))))
- ;; "CCL program to transform Mule characters to UCS-2."))
- ;;
- ;; and it should occasionally be confirmed that the correspondence still
- ;; holds.
-
- (let ((prog [1 10 131127 8 98872 65823 147513 8 82009 255 22]))
- (defconst ccl-encode-to-ucs-2 prog
- "CCL program to transform Mule characters to UCS-2.")
- (put (quote ccl-encode-to-ucs-2) (quote ccl-program-idx)
- (register-ccl-program (quote ccl-encode-to-ucs-2) prog)) nil))
-
-;; Won't do this just yet, though.
-;; (set-charset-registry 'lao "iso10646-1")
-;; (set-charset-ccl-program 'lao 'ccl-encode-to-ucs-2)
-;; (set-charset-registry 'ipa "iso10646-1")
-;; (set-charset-ccl-program 'ipa 'ccl-encode-to-ucs-2)
-
;; #### UTF-7 is not yet implemented, and it's tricky to do. There's
;; an implementation in appendix A.1 of the Unicode Standard, Version
;; 2.0, but I don't know its licensing characteristics.
@@ -358,8 +291,7 @@ The second argument must be 'ucs, the th
; 'utf-7 'unicode
; "UTF-7"
; '(mnemonic "UTF7"
-; documentation
-; "UTF-7 Unicode encoding -- 7-bit-ASCII modal Internet-mail-compatible
+; documentation; "UTF-7 Unicode encoding -- 7-bit-ASCII modal Internet-mail-compatible
; encoding especially designed for headers, with the following
; properties:
1.26 +22 -1 XEmacs/xemacs/lisp/x-faces.el
Index: x-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -p -r1.25 -r1.26
--- x-faces.el 2006/04/25 14:01:54 1.25
+++ x-faces.el 2006/11/05 22:31:32 1.26
@@ -782,7 +782,28 @@ Otherwise, it returns the next larger ve
;; globally. This means we should override global
;; defaults for all X device classes.
(remove-specifier (face-font face) locale x-tag-set nil))
- (set-face-font face fn locale 'x append))
+ (set-face-font face fn locale 'x append)
+ ;
+ ; (debug-print "the face is %s, locale %s, specifier %s"
+ ; face locale (face-font face))
+ ;
+ ;; And retain some of the fallbacks in the generated default face,
+ ;; since we don't want to try andale-mono's ISO-10646-1 encoding for
+ ;; Amharic or Thai. This is fragile; it depends on the code in
+ ;; faces.c.
+ (dolist (assocked '((x encode-as-utf-8 initial)
+ (x two-dimensional initial)
+ (x one-dimensional final)
+ (x two-dimensional final)))
+ (when (and (specifierp (face-font face))
+ (consp (specifier-fallback (face-font face)))
+ (setq assocked
+ (assoc assocked
+ (specifier-fallback
+ (face-font face)))))
+ (set-face-font face (cdr assocked) locale
+ (nreverse (car assocked)) append))))
+
;; Kludge-o-rooni. Set the foreground and background resources for
;; X devices only -- otherwise things tend to get all messed up
;; if you start up an X frame and then later create a TTY frame.
1.18 +2 -4 XEmacs/xemacs/lisp/x-font-menu.el
Index: x-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -p -r1.17 -r1.18
--- x-font-menu.el 2006/05/11 14:57:05 1.17
+++ x-font-menu.el 2006/11/05 22:31:32 1.18
@@ -43,7 +43,7 @@
x-font-regexp-spacing))
(globally-declare-fboundp
- '(charset-registry))
+ '(charset-registries))
(defvar x-font-menu-registry-encoding nil
"Registry and encoding to use with font menu fonts.")
@@ -157,9 +157,7 @@ or if you change your font path, you can
;; #### - this should implement a `menus-only' option, which would
;; recalculate the menus from the cache w/o having to do font-list again.
(unless x-font-regexp-ascii
- (setq x-font-regexp-ascii (if (featurep 'mule)
- (charset-registry 'ascii)
- "iso8859-1")))
+ (setq x-font-regexp-ascii (elt (charset-registries 'ascii) 0)))
(setq x-font-menu-registry-encoding
(if (featurep 'mule) "*-*" "iso8859-1"))
(let ((case-fold-search t)
1.8 +4 -5 XEmacs/xemacs/lisp/mule/arabic.el
Index: arabic.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/arabic.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- arabic.el 2002/03/16 10:39:05 1.7
+++ arabic.el 2006/11/05 22:31:37 1.8
@@ -47,9 +47,8 @@
;; Others are of direction right-to-left and of width 1-column or
;; 2-column.
(make-charset 'arabic-digit "Arabic digit"
- '(dimension
- 1
- registry "MuleArabic-0"
+ '(dimension 1
+ registries ["MuleArabic-0"]
chars 94
columns 1
direction l2r
@@ -62,7 +61,7 @@
(make-charset 'arabic-1-column "Arabic 1-column"
'(dimension
1
- registry "MuleArabic-1"
+ registries ["MuleArabic-1"]
chars 94
columns 1
direction r2l
@@ -75,7 +74,7 @@
(make-charset 'arabic-2-column "Arabic 2-column"
'(dimension
1
- registry "MuleArabic-2"
+ registries ["MuleArabic-2"]
chars 94
columns 2
direction r2l
1.13 +4 -4 XEmacs/xemacs/lisp/mule/chinese.el
Index: chinese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/chinese.el,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -p -r1.12 -r1.13
--- chinese.el 2005/12/24 22:31:51 1.12
+++ chinese.el 2006/11/05 22:31:37 1.13
@@ -146,8 +146,8 @@
(name plane final)
(make-charset
name (concat "CNS 11643 Plane " plane " (Chinese traditional)")
- `(registry
- ,(concat "CNS11643[.-]\\(.*[.-]\\)?" plane "$")
+ `(registries
+ ,(vector (concat "cns11643.1992-" plane ))
dimension 2
chars 94
final ,final
@@ -171,7 +171,7 @@
(make-charset ;; not in FSF 21.1
'chinese-isoir165
"ISO-IR-165 (CCITT Extended GB; Chinese simplified)"
- `(registry "isoir165"
+ `(registries ["isoir165-0"]
dimension 2
chars 94
final ?E
@@ -185,7 +185,7 @@
'(dimension
1
;; XEmacs addition: second half of registry spec
- registry "sisheng_cwnn\\|OMRON_UDC_ZH"
+ registries ["omron_udc_zh-0" "sisheng_cwnn-0"]
chars 94
columns 1
direction l2r
1.7 +1 -1 XEmacs/xemacs/lisp/mule/english.el
Index: english.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/english.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- english.el 2002/03/29 04:46:41 1.6
+++ english.el 2006/11/05 22:31:37 1.7
@@ -36,7 +36,7 @@
"ASCII (left half of ISO 8859-1) with right-to-left direction"
'(dimension
1
- registry "ISO8859-1"
+ registries ["ISO8859-1"]
chars 94
columns 1
direction r2l
1.7 +4 -1 XEmacs/xemacs/lisp/mule/ethiopic.el
Index: ethiopic.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/ethiopic.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- ethiopic.el 2002/03/16 10:39:06 1.6
+++ ethiopic.el 2006/11/05 22:31:37 1.7
@@ -32,7 +32,7 @@
(make-charset 'ethiopic "Ethiopic characters"
'(dimension
2
- registry "Ethiopic-Unicode"
+ registries ["Ethiopic-Unicode"]
chars 94
columns 2
direction l2r
@@ -82,5 +82,8 @@
(features ethio-util)
(sample-text . "$(3$Q#U!.(B")
(documentation . t)))
+
+;; In a more ideal world, we could set the default face fallback from here
+;; to use one of the misc-fixed sizes that handles Ethiopic.
;;; ethiopic.el ends here
1.13 +2 -2 XEmacs/xemacs/lisp/mule/european.el
Index: european.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/european.el,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -p -r1.12 -r1.13
--- european.el 2005/05/10 17:02:59 1.12
+++ european.el 2006/11/05 22:31:37 1.13
@@ -121,7 +121,7 @@
"Right-Hand Part of Latin Alphabet 8 (ISO/IEC 8859-14)"
'(dimension
1
- registry "ISO8859-14"
+ registries ["ISO8859-14"]
chars 96
columns 1
direction l2r
@@ -135,7 +135,7 @@
"Right-Hand Part of Latin Alphabet 10 (ISO/IEC 8859-16)"
'(dimension
1
- registry "ISO8859-16"
+ registries ["ISO8859-16"]
chars 96
columns 1
direction l2r
1.4 +3 -3 XEmacs/xemacs/lisp/mule/indian.el
Index: indian.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/indian.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- indian.el 2002/03/16 10:39:06 1.3
+++ indian.el 2006/11/05 22:31:37 1.4
@@ -99,7 +99,7 @@
"Generic Indian charset for data exchange with IS 13194"
'(dimension
1
- registry "IS13194-Devanagari"
+ registries ["IS13194-Devanagari"]
chars 94
columns 2
direction l2r
@@ -114,7 +114,7 @@
"Indian charset for 2-column width glyphs"
'(dimension
2
- registry "MuleIndian-1"
+ registries ["MuleIndian-1"]
chars 94
columns 1
direction l2r
@@ -129,7 +129,7 @@
"Indian charset for 2-column width glyphs"
'(dimension
2
- registry "MuleIndian-2"
+ registries ["MuleIndian-2"]
chars 94
columns 2
direction l2r
1.12 +2 -72 XEmacs/xemacs/lisp/mule/japanese.el
Index: japanese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/japanese.el,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -p -r1.11 -r1.12
--- japanese.el 2004/01/29 05:22:40 1.11
+++ japanese.el 2006/11/05 22:31:37 1.12
@@ -33,80 +33,10 @@
;;; Code:
-; (make-charset 'katakana-jisx0201
-; "Katakana Part of JISX0201.1976"
-; '(dimension
-; 1
-; registry "JISX0201"
-; chars 94
-; columns 1
-; direction l2r
-; final ?I
-; graphic 1
-; short-name "JISX0201 Katakana"
-; long-name "Japanese Katakana (JISX0201.1976)"
-; ))
-
-; (make-charset 'latin-jisx0201
-; "Roman Part of JISX0201.1976"
-; '(dimension
-; 1
-; registry "JISX0201"
-; chars 94
-; columns 1
-; direction l2r
-; final ?J
-; graphic 0
-; short-name "JISX0201 Roman"
-; long-name "Japanese Roman (JISX0201.1976)"
-; ))
-
-; (make-charset 'japanese-jisx0208-1978
-; "JISX0208.1978 Japanese Kanji (so called \"old JIS\"): ISO-IR-42"
-; '(dimension
-; 2
-; registry "JISX0208.1990"
-; registry "JISX0208.1978"
-; chars 94
-; columns 2
-; direction l2r
-; final ?@
-; graphic 0
-; short-name "JISX0208.1978"
-; long-name "JISX0208.1978 (Japanese): ISO-IR-42"
-; ))
-
-; (make-charset 'japanese-jisx0208
-; "JISX0208.1983/1990 Japanese Kanji: ISO-IR-87"
-; '(dimension
-; 2
-; chars 94
-; columns 2
-; direction l2r
-; final ?B
-; graphic 0
-; short-name "JISX0208"
-; long-name "JISX0208.1983/1990 (Japanese): ISO-IR-87"
-; ))
-
-; (make-charset 'japanese-jisx0212
-; "JISX0212 Japanese supplement: ISO-IR-159"
-; '(dimension
-; 2
-; registry "JISX0212"
-; chars 94
-; columns 2
-; direction l2r
-; final ?D
-; graphic 0
-; short-name "JISX0212"
-; long-name "JISX0212 (Japanese): ISO-IR-159"
-; ))
-
(make-charset 'japanese-jisx0213-1 "JISX0213 Plane 1 (Japanese)"
'(dimension
2
- registry "JISX0213.2000-1"
+ registries ["JISX0213.2000-1"]
chars 94
columns 2
direction l2r
@@ -120,7 +50,7 @@
(make-charset 'japanese-jisx0213-2 "JISX0213 Plane 2 (Japanese)"
'(dimension
2
- registry "JISX0213.2000-2"
+ registries ["JISX0213.2000-2"]
chars 94
columns 2
direction l2r
1.5 +1 -1 XEmacs/xemacs/lisp/mule/lao.el
Index: lao.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/lao.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- lao.el 2002/03/18 10:07:37 1.4
+++ lao.el 2006/11/05 22:31:37 1.5
@@ -33,7 +33,7 @@
(make-charset 'lao "Lao characters (ISO10646 0E80..0EDF)"
'(dimension
1
- registry "MuleLao-1"
+ registries ["MuleLao-1"]
chars 94
columns 1
direction l2r
1.6 +1 -1 XEmacs/xemacs/lisp/mule/misc-lang.el
Index: misc-lang.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/misc-lang.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -p -r1.5 -r1.6
--- misc-lang.el 2002/03/16 10:39:07 1.5
+++ misc-lang.el 2006/11/05 22:31:38 1.6
@@ -34,7 +34,7 @@
(make-charset 'ipa "IPA (International Phonetic Association)"
'(dimension
1
- registry "MuleIPA"
+ registries ["MuleIPA"]
chars 96
columns 1
direction l2r
1.19 +21 -2 XEmacs/xemacs/lisp/mule/mule-charset.el
Index: mule-charset.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-charset.el,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -p -r1.18 -r1.19
--- mule-charset.el 2005/12/23 11:42:35 1.18
+++ mule-charset.el 2006/11/05 22:31:38 1.19
@@ -106,12 +106,31 @@ Only left-to-right is currently implemen
0
1))
-;; Not in Emacs/Mule
+;; Not in GNU Emacs/Mule
(defun charset-registry (charset)
"Return the registry of CHARSET.
This is a regular expression matching the registry field of fonts
that can display the characters in CHARSET."
- (charset-property charset 'registry))
+ (lwarn 'xintl 'warning
+ "charset-registry is obsolete--use charset-registries instead. ")
+ (when (charset-property charset 'registries)
+ (elt (charset-property charset 'registries) 0)))
+
+(defun charset-registries (charset)
+ "Return the registries of CHARSET."
+ (charset-property charset 'registries))
+
+(defun set-charset-registry (charset registry)
+ "Obsolete; use set-charset-registries instead. "
+ (check-argument-type 'stringp registry)
+ (check-argument-type 'charsetp (find-charset charset))
+ (unless (equal registry (regexp-quote registry))
+ (lwarn 'xintl 'warning
+ "Regexps no longer allowed for charset-registry. Treating %s%s"
+ registry " as a string."))
+ (set-charset-registries
+ charset
+ (apply 'vector registry (append (charset-registries charset) nil))))
(defun charset-ccl-program (charset)
"Return the CCL program of CHARSET.
1.5 +6 -6 XEmacs/xemacs/lisp/mule/thai-xtis.el
Index: thai-xtis.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/thai-xtis.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- thai-xtis.el 2002/03/18 10:07:37 1.4
+++ thai-xtis.el 2006/11/05 22:31:38 1.5
@@ -35,12 +35,12 @@
;;; Code:
(make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)."
- '(registry "xtis-0"
- dimension 2
- columns 1
- chars 94
- final ??
- graphic 0))
+ '(registries ["xtis-0"]
+ dimension 2
+ columns 1
+ chars 94
+ final ??
+ graphic 0))
(define-category ?x "Precomposed Thai character.")
(modify-category-entry 'thai-xtis ?x)
1.4 +2 -2 XEmacs/xemacs/lisp/mule/tibetan.el
Index: tibetan.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/tibetan.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- tibetan.el 2002/03/16 10:39:07 1.3
+++ tibetan.el 2006/11/05 22:31:38 1.4
@@ -87,7 +87,7 @@
(make-charset 'tibetan-1-column "Tibetan 1 column glyph"
'(dimension
2
- registry "MuleTibetan-1"
+ registries ["MuleTibetan-1"]
chars 94
columns 1
direction l2r
@@ -101,7 +101,7 @@
(make-charset 'tibetan "Tibetan characters"
'(dimension
2
- registry "MuleTibetan-2"
+ registries ["MuleTibetan-2"]
chars 94
columns 2
direction l2r
1.7 +2 -2 XEmacs/xemacs/lisp/mule/vietnamese.el
Index: vietnamese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/vietnamese.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- vietnamese.el 2002/03/21 07:30:24 1.6
+++ vietnamese.el 2006/11/05 22:31:38 1.7
@@ -37,7 +37,7 @@
(make-charset 'vietnamese-viscii-lower "VISCII1.1 lower-case"
'(dimension
1
- registry "VISCII1.1"
+ registries ["VISCII1.1"]
chars 96
columns 1
direction l2r
@@ -50,7 +50,7 @@
(make-charset 'vietnamese-viscii-upper "VISCII1.1 upper-case"
'(dimension
1
- registry "VISCII1.1"
+ registries ["VISCII1.1"]
chars 96
columns 1
direction l2r
1.1005 +133 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.1004
retrieving revision 1.1005
diff -u -p -r1.1004 -r1.1005
--- ChangeLog 2006/11/01 20:25:48 1.1004
+++ ChangeLog 2006/11/05 22:31:42 1.1005
@@ -1,3 +1,136 @@
+2006-11-05 Aidan Kehoe <kehoea at parhasard.net>
+
+ * charset.h:
+ Prefer the charset-registries property to the charset-registry
+ property; accept the latter for compatibility, warning when its
+ regexp functionality is used.
+
+ * charset.h (XCHARSET_CCL_PROGRAM):
+ * charset.h (XCHARSET_NAME):
+ Make dummy versions of these available in non-Mule.
+
+ * console-impl.h:
+ * console-impl.h (struct console_methods):
+ Rename the last parameter to a couple of methods; reformat their
+ declarations.
+
+ * faces.c:
+ * faces.c (face_property_matching_instance):
+ * faces.c (ensure_face_cachel_contains_charset):
+ * faces.c (merge_face_cachel_data):
+ * faces.c (reset_face_cachel):
+ * faces.c (mark_face_cachels_as_not_updated):
+ * faces.c (syms_of_faces):
+ * faces.c (vars_of_faces):
+ * faces.c (complex_vars_of_faces):
+ Provide a DEBUG_FACES macro; use it to make debugging output
+ available in debug builds.
+ Implement multi-stage font lookup, assigning the stages names, not
+ numbers.
+ Re-implement the cachel->font_specified cache using the
+ infrastructure for Lisp bit vectors.
+
+ * faces.h:
+ * faces.h (struct face_cachel):
+ * faces.h (FACE_CACHEL_FONT_UPDATED):
+ * faces.h (FACE_FONT):
+ Re-implement the cachel->font_specified cache using the
+ infrastructure for Lisp bit vectors.
+
+ * font-mgr.h:
+ Move some XFT debug macros here from objects-x.c.
+
+ * general-slots.h:
+ Provide a few new symbols for the multi-stage font resolution
+ process.
+
+ * intl.c (init_intl):
+ Correct a comment.
+
+ * lisp.h:
+ Provide a macro to declare an inline lisp bit vector where the
+ size is fixed.
+ Make Qregistries available all over, not Qregistry.
+
+ * mule-charset.c:
+ * mule-charset.c (mark_charset):
+ * mule-charset.c (print_charset):
+ * mule-charset.c (make_charset):
+ * mule-charset.c (Fmake_charset):
+ * mule-charset.c (Fcharset_property):
+ * mule-charset.c (Fset_charset_ccl_program):
+ * mule-charset.c (syms_of_mule_charset):
+ * mule-charset.c (complex_vars_of_mule_charset):
+ * mule-charset.c (CHINESE_CNS_PLANE):
+ Prefer the charset-registries property to the charset-registry
+ property; accept the latter for compatibility, warning when its
+ regexp functionality is used.
+
+ * objects-gtk.c:
+ * objects-gtk.c (gtk_font_spec_matches_charset):
+ * objects-gtk.c (gtk_find_charset_font):
+ * objects-msw.c (mswindows_find_charset_font):
+ * objects-tty.c (tty_find_charset_font):
+ Redeclare various functions to work with the multi-stage lookup
+ process. Include objects-xlike-inc.
+
+ * objects-x.c:
+ Provide a DEBUG_OBJECTS macro; use it to make debugging output
+ available in debug builds.
+
+ * objects-x.c (x_initialize_font_instance):
+ * objects-x.c (x_print_font_instance):
+ * objects-x.c (xlistfonts_checking_charset):
+ * objects-x.c (vars_of_objects_x):
+ Don't regex match on the output of XListFonts; instead, use the
+ fixed strings of the charset-registries to comparatively limit the
+ IPC that will happen. Include objects-xlike-inc.c
+
+ * objects-xlike-inc.c:
+ * objects-xlike-inc.c (count_hyphens):
+ New. How many ASCII minus characters in a string?
+
+ * objects-xlike-inc.c (xlistfonts_checking_charset):
+ * objects-xlike-inc.c (mule_to_fc_charset):
+ * objects-xlike-inc.c (xft_find_charset_font):
+ * objects-x.c (x_find_charset_font):
+ Move some methods here to share them with GTK.
+
+ * objects.c (print_font_instance):
+ * objects.c (font_spec_matches_charset):
+ * objects.c (font_validate_matchspec):
+ * objects.c (font_instantiate):
+ Redeclare some methods to take enums rather than numeric stages.
+
+ * objects.h (EXFUN):
+ Make Fregexp_quote available to mule-charset.c
+
+ * redisplay-x.c:
+ * redisplay-x.c (separate_textual_runs):
+ Make this slightly faster, cleaner. Make it accept a face cachel
+ pointer argument, and check it as to whether a given charset
+ should be translated to UCS-2 before redisplay.
+
+ * specifier.c:
+ * specifier.c (charset_matches_specifier_tag_set_p):
+ * specifier.c (define_specifier_tag):
+ * specifier.c (Fdefine_specifier_tag):
+ * specifier.c (setup_device_initial_specifier_tags):
+ * specifier.c (setup_charset_initial_specifier_tags):
+ * specifier.c (specifier_instance_from_inst_list):
+ * specifier.c (syms_of_specifier):
+ * specifier.c (vars_of_specifier):
+ * specifier.h:
+ Extend specifiers to allow limiting their applicability by using
+ charset predicates. Document this.
+ Run indent-region on the file, at Stephen's suggestion.
+
+ * unicode.c (unicode_to_ichar):
+ * unicode.c (syms_of_unicode):
+ * unicode.c (vars_of_unicode):
+ Use unicode-registries, a dumped vector, as the charset-registries
+ of the on-the-fly JIT charsets.
+
2006-11-01 Adrian Aichner <adrian at xemacs.org>
* sysdep.c (wcslen): Check for NULL pointer.
1.15 +6 -4 XEmacs/xemacs/src/charset.h
Index: charset.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/charset.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -p -r1.14 -r1.15
--- charset.h 2006/07/07 23:01:11 1.14
+++ charset.h 2006/11/05 22:31:43 1.15
@@ -58,6 +58,8 @@ Boston, MA 02111-1307, USA. */
(byte1) = (ch); \
(byte2) = 0; \
} while (0)
+#define XCHARSET_CCL_PROGRAM(cs) Qnil
+#define XCHARSET_NAME(cs) Qascii
#else /* MULE */
@@ -186,7 +188,7 @@ struct Lisp_Charset
int id;
Lisp_Object name;
Lisp_Object doc_string;
- Lisp_Object registry;
+ Lisp_Object registries;
Lisp_Object short_name;
Lisp_Object long_name;
@@ -271,7 +273,7 @@ DECLARE_LRECORD (charset, Lisp_Charset);
#define CHARSET_DIRECTION(cs) ((cs)->direction)
#define CHARSET_FINAL(cs) ((cs)->final)
#define CHARSET_DOC_STRING(cs) ((cs)->doc_string)
-#define CHARSET_REGISTRY(cs) ((cs)->registry)
+#define CHARSET_REGISTRIES(cs) ((cs)->registries)
#define CHARSET_CCL_PROGRAM(cs) ((cs)->ccl_program)
#define CHARSET_DIMENSION(cs) ((cs)->dimension)
#define CHARSET_CHARS(cs) ((cs)->chars)
@@ -280,7 +282,6 @@ DECLARE_LRECORD (charset, Lisp_Charset);
#define CHARSET_FROM_UNICODE_TABLE(cs) ((cs)->from_unicode_table)
#define CHARSET_FROM_UNICODE_LEVELS(cs) ((cs)->from_unicode_levels)
-
#define CHARSET_PRIVATE_P(cs) leading_byte_private_p (CHARSET_LEADING_BYTE (cs))
#define XCHARSET_ID(cs) CHARSET_ID (XCHARSET (cs))
@@ -295,11 +296,12 @@ DECLARE_LRECORD (charset, Lisp_Charset);
#define XCHARSET_DIRECTION(cs) CHARSET_DIRECTION (XCHARSET (cs))
#define XCHARSET_FINAL(cs) CHARSET_FINAL (XCHARSET (cs))
#define XCHARSET_DOC_STRING(cs) CHARSET_DOC_STRING (XCHARSET (cs))
-#define XCHARSET_REGISTRY(cs) CHARSET_REGISTRY (XCHARSET (cs))
+#define XCHARSET_REGISTRIES(cs) CHARSET_REGISTRIES (XCHARSET (cs))
#define XCHARSET_LEADING_BYTE(cs) CHARSET_LEADING_BYTE (XCHARSET (cs))
#define XCHARSET_CCL_PROGRAM(cs) CHARSET_CCL_PROGRAM (XCHARSET (cs))
#define XCHARSET_DIMENSION(cs) CHARSET_DIMENSION (XCHARSET (cs))
#define XCHARSET_CHARS(cs) CHARSET_CHARS (XCHARSET (cs))
+
#define XCHARSET_PRIVATE_P(cs) CHARSET_PRIVATE_P (XCHARSET (cs))
#define XCHARSET_REVERSE_DIRECTION_CHARSET(cs) \
CHARSET_REVERSE_DIRECTION_CHARSET (XCHARSET (cs))
1.13 +8 -11 XEmacs/xemacs/src/console-impl.h
Index: console-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -p -r1.12 -r1.13
--- console-impl.h 2005/10/24 10:07:34 1.12
+++ console-impl.h 2006/11/05 22:31:43 1.13
@@ -26,6 +26,7 @@ Boston, MA 02111-1307, USA. */
#define INCLUDED_console_impl_h_
#include "console.h"
+#include "specifier.h"
extern const struct sized_memory_description cted_description;
extern const struct sized_memory_description console_methods_description;
@@ -212,17 +213,13 @@ struct console_methods
Lisp_Object (*font_list_method) (Lisp_Object pattern,
Lisp_Object device,
Lisp_Object maxnumber);
- Lisp_Object (*find_charset_font_method) (Lisp_Object device,
- Lisp_Object font,
- Lisp_Object charset,
- int stage);
- int (*font_spec_matches_charset_method) (struct device *d,
- Lisp_Object charset,
- const Ibyte *nonreloc,
- Lisp_Object reloc,
- Bytecount offset,
- Bytecount length,
- int stage);
+ Lisp_Object (*find_charset_font_method)
+ (Lisp_Object device, Lisp_Object font, Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage);
+ int (*font_spec_matches_charset_method)
+ (struct device *d, Lisp_Object charset, const Ibyte *nonreloc,
+ Lisp_Object reloc, Bytecount offset, Bytecount length,
+ enum font_specifier_matchspec_stages stage);
/* image methods */
void (*mark_image_instance_method) (Lisp_Image_Instance *);
1.50 +369 -202 XEmacs/xemacs/src/faces.c
Index: faces.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -p -r1.49 -r1.50
--- faces.c 2005/11/26 11:46:08 1.49
+++ faces.c 2006/11/05 22:31:43 1.50
@@ -72,7 +72,32 @@ Lisp_Object Vtemporary_faces_cache;
Lisp_Object Vbuilt_in_face_specifiers;
+#ifdef DEBUG_XEMACS
+Fixnum debug_x_faces;
+#endif
+
+#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901)
+
+#ifdef DEBUG_XEMACS
+# define DEBUG_FACES(FORMAT, ...) \
+ do { if (debug_x_faces) stderr_out(FORMAT, __VA_ARGS__); } while (0)
+#else /* DEBUG_XEMACS */
+# define DEBUG_FACES(format, ...)
+#endif /* DEBUG_XEMACS */
+
+#elif defined(__GNUC__)
+
+#ifdef DEBUG_XEMACS
+# define DEBUG_FACES(format, args...) \
+ do { if (debug_x_faces) stderr_out(format, args ); } while (0)
+#else /* DEBUG_XEMACS */
+# define DEBUG_FACES(format, args...)
+#endif /* DEBUG_XEMACS */
+#else /* defined(__STDC_VERSION__) [...] */
+# define DEBUG_FACES (void)
+#endif
+
static Lisp_Object
mark_face (Lisp_Object obj)
{
@@ -554,37 +579,31 @@ Lisp_Object
face_property_matching_instance (Lisp_Object face, Lisp_Object property,
Lisp_Object charset, Lisp_Object domain,
Error_Behavior errb, int no_fallback,
- Lisp_Object depth)
+ Lisp_Object depth,
+ enum font_specifier_matchspec_stages stage)
{
Lisp_Object retval;
Lisp_Object matchspec = Qunbound;
struct gcpro gcpro1;
if (!NILP (charset))
- matchspec = noseeum_cons (charset, Qnil);
+ matchspec = noseeum_cons (charset,
+ stage == initial ? Qinitial : Qfinal);
+
GCPRO1 (matchspec);
retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec,
domain, errb, no_fallback, depth);
- if (UNBOUNDP (retval))
- {
- if (CONSP (matchspec))
- Fsetcdr (matchspec, Qt);
- retval = specifier_instance_no_quit (Fget (face, property, Qnil),
- matchspec, domain, errb,
- no_fallback, depth);
- }
UNGCPRO;
if (CONSP (matchspec))
free_cons (matchspec);
- if (UNBOUNDP (retval) && !no_fallback)
+ if (UNBOUNDP (retval) && !no_fallback && final == stage)
{
if (EQ (property, Qfont))
{
if (NILP (memq_no_quit (charset,
XFACE (face)->charsets_warned_about)))
{
-#ifdef MULE
if (!UNBOUNDP (charset))
warn_when_safe
(Qfont, Qnotice,
@@ -593,12 +612,6 @@ face_property_matching_instance (Lisp_Ob
(XSYMBOL (XCHARSET_NAME (charset)))),
XSTRING_DATA (symbol_name
(XSYMBOL (XFACE (face)->name))));
- else
-#endif
- warn_when_safe (Qfont, Qnotice,
- "Unable to instantiate font for face %s",
- XSTRING_DATA (symbol_name
- (XSYMBOL (XFACE (face)->name))));
XFACE (face)->charsets_warned_about =
Fcons (charset, XFACE (face)->charsets_warned_about);
}
@@ -1071,11 +1084,11 @@ ensure_face_cachel_contains_charset (str
{
Lisp_Object new_val;
Lisp_Object face = cachel->face;
- int bound = 1;
+ int bound = 1, final_stage = 0;
int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
- if (!UNBOUNDP (cachel->font[offs])
- && cachel->font_updated[offs])
+ if (!UNBOUNDP (cachel->font[offs]) &&
+ bit_vector_bit(FACE_CACHEL_FONT_UPDATED (cachel), offs))
return cachel->font[offs];
if (UNBOUNDP (face))
@@ -1085,7 +1098,8 @@ ensure_face_cachel_contains_charset (str
struct window *w = XWINDOW (domain);
new_val = Qunbound;
- cachel->font_specified[offs] = 0;
+ set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 0);
+
for (i = 0; i < cachel->nfaces; i++)
{
struct face_cachel *oth;
@@ -1095,15 +1109,18 @@ ensure_face_cachel_contains_charset (str
/* Tout le monde aime la recursion */
ensure_face_cachel_contains_charset (oth, domain, charset);
- if (oth->font_specified[offs])
+ if (bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(oth), offs))
{
new_val = oth->font[offs];
- cachel->font_specified[offs] = 1;
+ set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1);
+ set_bit_vector_bit
+ (FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs,
+ bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(oth), offs));
break;
}
}
- if (!cachel->font_specified[offs])
+ if (!bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs))
/* need to do the default face. */
{
struct face_cachel *oth =
@@ -1113,31 +1130,108 @@ ensure_face_cachel_contains_charset (str
new_val = oth->font[offs];
}
- if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val))
+ if (!UNBOUNDP (cachel->font[offs]) &&
+ !EQ (cachel->font[offs], new_val))
cachel->dirty = 1;
- cachel->font_updated[offs] = 1;
+ set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1);
cachel->font[offs] = new_val;
+ DEBUG_FACES("just recursed on the unbound face, returning "
+ "something %s\n", UNBOUNDP(new_val) ? "not bound"
+ : "bound");
return new_val;
}
- new_val = face_property_matching_instance (face, Qfont, charset, domain,
- /* #### look into error flag */
- ERROR_ME_DEBUG_WARN, 1, Qzero);
- if (UNBOUNDP (new_val))
- {
- bound = 0;
- new_val = face_property_matching_instance (face, Qfont,
- charset, domain,
- /* #### look into error
- flag */
- ERROR_ME_DEBUG_WARN, 0,
- Qzero);
- }
+ do {
+
+ /* Lookup the face, specifying the initial stage and that fallbacks
+ shouldn't happen. */
+ new_val = face_property_matching_instance (face, Qfont, charset, domain,
+ /* ERROR_ME_DEBUG_WARN is
+ fine here. */
+ ERROR_ME_DEBUG_WARN, 1, Qzero,
+ initial);
+ DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
+ "result was something %s\n",
+ XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
+ XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
+ UNBOUNDP(new_val) ? "not bound" : "bound");
+
+ if (!UNBOUNDP (new_val)) break;
+
+ bound = 0;
+ /* Lookup the face again, this time allowing the fallback. If this
+ succeeds, it'll give a font intended for the script in question,
+ which is preferable to translating to ISO10646-1 and using the
+ fixed-with fallback. */
+ new_val = face_property_matching_instance (face, Qfont,
+ charset, domain,
+ ERROR_ME_DEBUG_WARN, 0,
+ Qzero,
+ initial);
+
+ DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
+ "allow fallback, result was something %s\n",
+ XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
+ XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
+ UNBOUNDP(new_val) ? "not bound" : "bound");
+
+ if (!UNBOUNDP(new_val))
+ {
+ break;
+ }
+
+ bound = 1;
+ /* Try the face itself with the final-stage specifiers. */
+ new_val = face_property_matching_instance (face, Qfont,
+ charset, domain,
+ ERROR_ME_DEBUG_WARN, 1,
+ Qzero,
+ final);
+
+ DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, "
+ "result was something %s\n",
+ XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
+ XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
+ UNBOUNDP(new_val) ? "not bound" : "bound");
+ /* Tell X11 redisplay that it should translate to iso10646-1. */
+ if (!UNBOUNDP(new_val))
+ {
+ final_stage = 1;
+ break;
+ }
+
+ bound = 0;
+
+ /* Lookup the face again, this time both allowing the fallback and
+ allowing its final stage to be used. */
+ new_val = face_property_matching_instance (face, Qfont,
+ charset, domain,
+ ERROR_ME_DEBUG_WARN, 0,
+ Qzero,
+ final);
+
+ DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
+ "allow fallback, result was something %s\n",
+ XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
+ XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
+ UNBOUNDP(new_val) ? "not bound" : "bound");
+ if (!UNBOUNDP(new_val))
+ {
+ /* Tell X11 redisplay that it should translate to iso10646-1. */
+ final_stage = 1;
+ break;
+ }
+ } while (0);
+
if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs]))
cachel->dirty = 1;
- cachel->font_updated[offs] = 1;
+
+ set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1);
+ set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs,
+ final_stage);
+ set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs,
+ (bound || EQ (face, Vdefault_face)));
cachel->font[offs] = new_val;
- cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face));
return new_val;
}
@@ -1372,6 +1466,8 @@ static void
merge_face_cachel_data (struct window *w, face_index findex,
struct face_cachel *cachel)
{
+ int offs;
+
#define FINDEX_FIELD(field) \
Dynarr_atp (w->face_cachels, findex)->field
@@ -1395,18 +1491,24 @@ merge_face_cachel_data (struct window *w
FROB (dim);
FROB (reverse);
FROB (blinking);
- /* And do ASCII, of course. */
- {
- int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
- if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs]))
- {
- cachel->font[offs] = FINDEX_FIELD (font[offs]);
- cachel->font_specified[offs] = 1;
- cachel->dirty = 1;
- }
- }
-
+ for (offs = 0; offs < NUM_LEADING_BYTES; ++offs)
+ {
+ if (!(bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs))
+ && bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED
+ (Dynarr_atp(w->face_cachels, findex)), offs))
+ {
+ cachel->font[offs] = FINDEX_FIELD (font[offs]);
+ set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1);
+ /* Also propagate whether we're translating to Unicode for the
+ given face. */
+ set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs,
+ bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE
+ (Dynarr_atp(w->face_cachels,
+ findex)), offs));
+ cachel->dirty = 1;
+ }
+ }
#undef FROB
#undef FINDEX_FIELD
@@ -1433,6 +1535,8 @@ reset_face_cachel (struct face_cachel *c
}
cachel->display_table = Qunbound;
cachel->background_pixmap = Qunbound;
+ FACE_CACHEL_FONT_SPECIFIED (cachel)->size = sizeof(cachel->font_specified);
+ FACE_CACHEL_FONT_UPDATED (cachel)->size = sizeof(cachel->font_updated);
}
/* Retrieve the index to a cachel for window W that corresponds to
@@ -1505,11 +1609,10 @@ mark_face_cachels_as_not_updated (struct
for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
{
struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt);
- int i;
cachel->updated = 0;
- for (i = 0; i < NUM_LEADING_BYTES; i++)
- cachel->font_updated[i] = 0;
+ memset(FACE_CACHEL_FONT_UPDATED(cachel)->bits, 0,
+ BIT_VECTOR_LONG_STORAGE (NUM_LEADING_BYTES));
}
}
@@ -1896,6 +1999,81 @@ LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD
return new_name;
}
+#ifdef MULE
+
+Lisp_Object Qone_dimensional, Qtwo_dimensional;
+
+DEFUN ("specifier-tag-one-dimensional-p",
+ Fspecifier_tag_one_dimensional_p,
+ 2, 2, 0, /*
+Return non-nil if (charset-dimension CHARSET) is 1.
+
+Used by the X11 platform font code; see `define-specifier-tag'. You
+shouldn't ever need to call this yourself.
+*/
+ (charset, UNUSED(stage)))
+{
+ CHECK_CHARSET(charset);
+ return (1 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil;
+}
+
+DEFUN ("specifier-tag-two-dimensional-p",
+ Fspecifier_tag_two_dimensional_p,
+ 2, 2, 0, /*
+Return non-nil if (charset-dimension CHARSET) is 2.
+
+Used by the X11 platform font code; see `define-specifier-tag'. You
+shouldn't ever need to call this yourself.
+*/
+ (charset, UNUSED(stage)))
+{
+ CHECK_CHARSET(charset);
+ return (2 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil;
+}
+
+DEFUN ("specifier-tag-final-stage-p",
+ Fspecifier_tag_final_stage_p,
+ 2, 2, 0, /*
+Return non-nil if STAGE is 'final.
+
+Used by the X11 platform font code for giving fallbacks; see
+`define-specifier-tag'. You shouldn't ever need to call this.
+*/
+ (UNUSED(charset), stage))
+{
+ return EQ(stage, Qfinal) ? Qt : Qnil;
+}
+
+DEFUN ("specifier-tag-initial-stage-p",
+ Fspecifier_tag_initial_stage_p,
+ 2, 2, 0, /*
+Return non-nil if STAGE is 'initial.
+
+Used by the X11 platform font code for giving fallbacks; see
+`define-specifier-tag'. You shouldn't ever need to call this.
+*/
+ (UNUSED(charset), stage))
+{
+ return EQ(stage, Qinitial) ? Qt : Qnil;
+}
+
+DEFUN ("specifier-tag-encode-as-utf-8-p",
+ Fspecifier_tag_encode_as_utf_8_p,
+ 2, 2, 0, /*
+Return t if and only if (charset-property CHARSET 'encode-as-utf-8)).
+
+Used by the X11 platform font code; see `define-specifier-tag'. You
+shouldn't ever need to call this.
+*/
+ (charset, UNUSED(stage)))
+{
+ /* Used to check that the stage was initial too. */
+ CHECK_CHARSET(charset);
+ return XCHARSET_ENCODE_AS_UTF_8(charset) ? Qt : Qnil;
+}
+
+#endif /* MULE */
+
void
syms_of_faces (void)
@@ -1917,6 +2095,17 @@ syms_of_faces (void)
DEFSUBR (Fmake_face);
DEFSUBR (Fcopy_face);
+#ifdef MULE
+ DEFSYMBOL (Qone_dimensional);
+ DEFSYMBOL (Qtwo_dimensional);
+ /* I would much prefer these were in Lisp. */
+ DEFSUBR (Fspecifier_tag_one_dimensional_p);
+ DEFSUBR (Fspecifier_tag_two_dimensional_p);
+ DEFSUBR (Fspecifier_tag_initial_stage_p);
+ DEFSUBR (Fspecifier_tag_final_stage_p);
+ DEFSUBR (Fspecifier_tag_encode_as_utf_8_p);
+#endif /* MULE */
+
DEFSYMBOL (Qfacep);
DEFSYMBOL (Qforeground);
DEFSYMBOL (Qbackground);
@@ -1980,6 +2169,13 @@ vars_of_faces (void)
staticpro (&Vpointer_face);
Vpointer_face = Qnil;
+#ifdef DEBUG_XEMACS
+ DEFVAR_INT ("debug-x-faces", &debug_x_faces /*
+If non-zero, display debug information about X faces
+*/ );
+ debug_x_faces = 0;
+#endif
+
{
Lisp_Object syms[20];
int n = 0;
@@ -2046,6 +2242,14 @@ complex_vars_of_faces (void)
#if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK)
+#ifdef HAVE_GTK
+ Lisp_Object device_symbol = Qgtk;
+#else
+ Lisp_Object device_symbol = Qx;
+#endif
+
+#ifdef MULE
+
const Ascbyte *fonts[] =
{
#ifdef USE_XFT
@@ -2053,165 +2257,128 @@ complex_vars_of_faces (void)
/* Note that fontconfig can search for several font families in one
call. We should use this facility. */
- "monospace-12", /* Western #### add encoding info? */
+ "Monospace-12",
/* do we need to worry about non-Latin characters for monospace?
No, at least in Debian's implementation of Xft.
We should recommend that "gothic" and "mincho" aliases be created? */
- "Sazanami Mincho-12", /* Japanese #### add encoding info? */
+ "Sazanami Mincho-12",
+ /* Japanese #### add encoding info? */
/* Arphic for Chinese? */
/* Korean */
#else
-
- /************** ISO-8859 fonts *************/
-
- "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
- /* under USE_XFT, we always succeed, so let's not waste the effort */
- "-*-fixed-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
- "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*",
- "-*-fixed-*-r-*-*-*-120-*-*-*-*-iso8859-*",
- /* Next try for any "medium" charcell or monospaced iso8859 font. */
- "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
- "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
- /* Next try for any charcell or monospaced iso8859 font. */
- "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
- "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
-
- /* Repeat, any size */
- "-*-courier-medium-r-*-*-*-*-*-*-*-*-iso8859-*",
- "-*-fixed-medium-r-*-*-*-*-*-*-*-*-iso8859-*",
- "-*-courier-*-r-*-*-*-*-*-*-*-*-iso8859-*",
- "-*-fixed-*-r-*-*-*-*-*-*-*-*-iso8859-*",
- /* Next try for any "medium" charcell or monospaced iso8859 font. */
- "-*-*-medium-r-*-*-*-*-*-*-m-*-iso8859-*",
- "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-*",
- /* Next try for any charcell or monospaced iso8859 font. */
- "-*-*-*-r-*-*-*-*-*-*-m-*-iso8859-*",
- "-*-*-*-r-*-*-*-*-*-*-c-*-iso8859-*",
-
- /* Non-proportional fonts -- last resort. */
- "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
- "-*-*-*-r-*-*-*-*-*-*-*-*-iso8859-*",
- "-*-*-*-*-*-*-*-*-*-*-*-*-iso8859-*",
-
- /************* Japanese fonts ************/
-
- /* Following 3 fonts proposed by Teruhiko.Kurosaka at Japan.eng.sun */
- "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0",
- "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0",
- "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0",
-
- /* Other Japanese fonts */
- "-*-fixed-medium-r-*--*-jisx0201.1976-*",
- "-*-fixed-medium-r-*--*-jisx0208.1983-*",
- "-*-fixed-medium-r-*--*-jisx0212*-*",
- "-*-*-*-r-*--*-jisx0201.1976-*",
- "-*-*-*-r-*--*-jisx0208.1983-*",
- "-*-*-*-r-*--*-jisx0212*-*",
-
- /************* Chinese fonts ************/
-
- "-*-*-medium-r-*--*-gb2312.1980-*",
- "-*-fixed-medium-r-*--*-cns11643*-*",
-
- "-*-fixed-medium-r-*--*-big5*-*,"
- "-*-fixed-medium-r-*--*-sisheng_cwnn-0",
-
- /************* Korean fonts *************/
-
- "-*-mincho-medium-r-*--*-ksc5601.1987-*",
-
- /************* Thai fonts **************/
-
- "-*-fixed-medium-r-*--*-tis620.2529-1",
-
- /************* Other fonts (nonstandard) *************/
-
- "-*-fixed-medium-r-*--*-viscii1.1-1",
- "-*-fixed-medium-r-*--*-mulearabic-*",
- "-*-fixed-medium-r-*--*-muleipa-*",
- "-*-fixed-medium-r-*--*-ethio-*",
-
- /************* Unicode fonts **************/
-
- /* #### We don't yet support Unicode fonts, but doing so would not be
- hard because all the machinery has already been added for Windows
- support. We need to do this:
-
- (1) Add "stage 2" support in find_charset_font()/etc.; this finds
- an appropriate Unicode font after all the charset-specific fonts
- have been checked. This should look at the per-char font info and
- check whether we have support for some of the chars in the
- charset. (#### Bogus, but that's the way it currently works)
-
- sjt sez: With Xft/fontconfig that information is available as a
- language support property. The character set (actually a bit
- vector) is also available. So what we need to do is to map charset
- -> language (Mule redesign Phase 1) and eventually use language
- information in the buffer, then map to charsets (Phase 2) at font
- instantiation time.
-
- (2) Record in the font instance a flag indicating when we're
- dealing with a Unicode font.
-
- (3) Notice this flag in separate_textual_runs() and translate the
- text into Unicode if so.
- */
-
- "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso10646-1",
- "-*-fixed-medium-r-*-*-*-120-*-*-*-*-iso10646-1",
- "-*-courier-*-r-*-*-*-120-*-*-*-*-iso10646-1",
- "-*-fixed-*-r-*-*-*-120-*-*-*-*-iso10646-1",
- /* Next try for any "medium" charcell or monospaced iso8859 font. */
- "-*-*-medium-r-*-*-*-120-*-*-m-*-iso10646-1",
- "-*-*-medium-r-*-*-*-120-*-*-c-*-iso10646-1",
- /* Next try for any charcell or monospaced iso8859 font. */
- "-*-*-*-r-*-*-*-120-*-*-m-*-iso10646-1",
- "-*-*-*-r-*-*-*-120-*-*-c-*-iso10646-1",
-
- /* Repeat, any size */
- "-*-courier-medium-r-*-*-*-*-*-*-*-*-iso10646-1",
- "-*-fixed-medium-r-*-*-*-*-*-*-*-*-iso10646-1",
- "-*-courier-*-r-*-*-*-*-*-*-*-*-iso10646-1",
- "-*-fixed-*-r-*-*-*-*-*-*-*-*-iso10646-1",
- /* Next try for any "medium" charcell or monospaced iso8859 font. */
- "-*-*-medium-r-*-*-*-*-*-*-m-*-iso10646-1",
- "-*-*-medium-r-*-*-*-*-*-*-c-*-iso10646-1",
- /* Next try for any charcell or monospaced iso8859 font. */
- "-*-*-*-r-*-*-*-*-*-*-m-*-iso10646-1",
- "-*-*-*-r-*-*-*-*-*-*-c-*-iso10646-1",
-
- /* Non-proportional fonts -- last resort. */
- "-*-*-*-r-*-*-*-120-*-*-*-*-iso10646-1",
- "-*-*-*-r-*-*-*-*-*-*-*-*-iso10646-1",
- "-*-*-*-*-*-*-*-*-*-*-*-*-iso10646-1",
-
- /*********** Last resort ***********/
-
- /* Boy, we sure are losing now. Try the above, but in any encoding. */
- "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
- "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
- "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
- "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
- /* Hello? Please? */
- "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
- "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
- "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
- "*"
+ /* The default Japanese fonts installed with XFree86 4.0 use this
+ point size, and the -misc-fixed fonts (which look really bad with
+ Han characters) don't. We need to prefer the former. */
+ "-*-*-medium-r-*-*-*-150-*-*-c-*-*-*",
+ /* And the Chinese ones, maddeningly, use this one. (But on 4.0, while
+ XListFonts returns them, XLoadQueryFont on the fully-specified XLFD
+ corresponding to one of them fails!) */
+ "-*-*-medium-r-*-*-*-160-*-*-c-*-*-*",
+ "-*-*-medium-r-*-*-*-170-*-*-c-*-*-*",
#endif
};
const Ascbyte **fontptr;
-#ifdef HAVE_X_WINDOWS
- for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
- inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)),
- inst_list);
-#endif /* HAVE_X_WINDOWS */
+ /* Define some specifier tags for classes of character sets. Combining
+ these allows for distinct fallback fonts for distinct dimensions of
+ character sets and stages. */
+
+ define_specifier_tag(Qtwo_dimensional, Qnil,
+ intern ("specifier-tag-two-dimensional-p"));
+
+ define_specifier_tag(Qone_dimensional, Qnil,
+ intern ("specifier-tag-one-dimensional-p"));
+
+ define_specifier_tag(Qinitial, Qnil,
+ intern ("specifier-tag-initial-stage-p"));
+
+ define_specifier_tag(Qfinal, Qnil,
+ intern ("specifier-tag-final-stage-p"));
+
+ define_specifier_tag (Qencode_as_utf_8, Qnil,
+ intern("specifier-tag-encode-as-utf-8-p"));
+
+#endif /* MULE */
+
+ inst_list =
+ Fcons
+ (Fcons
+ (list1 (device_symbol),
+ build_string ("*")),
+ inst_list);
+
+#ifdef MULE
+
+ /* For Han characters and Ethiopic, we want the misc-fixed font used to
+ be distinct from that for alphabetic scripts, because the font
+ specified below is distractingly ugly when used for Han characters
+ (this is slightly less so) and because its coverage isn't up to
+ handling them (well, chiefly, it's not up to handling Ethiopic--we do
+ have charset-specific fallbacks for the East Asian charsets.) */
+ inst_list =
+ Fcons
+ (Fcons
+ (list3(device_symbol, Qtwo_dimensional, Qfinal),
+ build_string
+ ("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")),
+ inst_list);
+
+ /* Use Markus Kuhn's version of misc-fixed as the font for the font for
+ when a given charset's registries can't be found and redisplay for
+ that charset falls back to iso10646-1. */
+
+ inst_list =
+ Fcons
+ (Fcons
+ (list3(device_symbol, Qone_dimensional, Qfinal),
+ build_string
+ ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
+ inst_list);
-#ifdef HAVE_GTK
for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
- inst_list = Fcons (Fcons (list1 (Qgtk), build_string (*fontptr)),
+ inst_list = Fcons (Fcons (list3 (device_symbol,
+ Qtwo_dimensional, Qinitial),
+ build_string (*fontptr)),
inst_list);
-#endif /* HAVE_GTK */
+
+ /* We need to set the font for the JIT-ucs-charsets separately from the
+ final stage, since otherwise it picks up the two-dimensional
+ specification (see specifier-tag-two-dimensional-initial-stage-p
+ above). They also use Markus Kuhn's ISO 10646-1 fixed fonts for
+ redisplay. */
+
+ inst_list =
+ Fcons
+ (Fcons
+ (list3(device_symbol, Qencode_as_utf_8, Qinitial),
+ build_string
+ ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
+ inst_list);
+
+#endif /* MULE */
+
+ /* Needed to make sure that charsets with non-specified fonts don't
+ use bold and oblique first if medium and regular are available. */
+ inst_list =
+ Fcons
+ (Fcons
+ (list1 (device_symbol),
+ build_string ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")),
+ inst_list);
+
+ /* With a Cygwin XFree86 install, this returns the best (clearest,
+ most readable) font I can find when scaling of bitmap fonts is
+ turned on, as it is by default. (WHO IN THE NAME OF CHRIST THOUGHT
+ THAT WAS A GOOD IDEA?!?!) The other fonts that used to be specified
+ here gave horrendous results. */
+
+ inst_list =
+ Fcons
+ (Fcons
+ (list1 (device_symbol),
+ build_string ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")),
+ inst_list);
+
#endif /* HAVE_X_WINDOWS || HAVE_GTK */
#ifdef HAVE_TTY
1.18 +28 -12 XEmacs/xemacs/src/faces.h
Index: faces.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -p -r1.17 -r1.18
--- faces.h 2006/02/27 16:29:25 1.17
+++ faces.h 2006/11/05 22:31:43 1.18
@@ -25,6 +25,7 @@ Boston, MA 02111-1307, USA. */
#define INCLUDED_faces_h_
#include "charset.h" /* for NUM_LEADING_BYTES */
+#include "specifier.h"
/* a Lisp_Face is the C object corresponding to a face. There is one
of these per face. It basically contains all of the specifiers for
@@ -181,8 +182,8 @@ struct face_cachel
/* Used when merging to tell if the above field represents an actual
value of this face or a fallback value. */
- /* #### Of course we should use a bit array or something. */
- unsigned char font_specified[NUM_LEADING_BYTES];
+ DECLARE_INLINE_LISP_BIT_VECTOR(NUM_LEADING_BYTES) font_specified;
+
unsigned int foreground_specified :1;
unsigned int background_specified :1;
unsigned int display_table_specified :1;
@@ -223,8 +224,13 @@ struct face_cachel
storing a "blank font" if the instantiation fails. */
unsigned int dirty :1;
unsigned int updated :1;
- /* #### Of course we should use a bit array or something. */
- unsigned char font_updated[NUM_LEADING_BYTES];
+
+ DECLARE_INLINE_LISP_BIT_VECTOR(NUM_LEADING_BYTES) font_updated;
+
+ /* Whether the font for the charset in question was determined in the
+ "final stage"; that is, the last stage Lisp code could specify it,
+ after the initial stage and before the fallback. */
+ DECLARE_INLINE_LISP_BIT_VECTOR(NUM_LEADING_BYTES) font_final_stage;
};
#ifdef NEW_GC
@@ -303,6 +309,13 @@ void default_face_height_and_width_1 (Li
#define FACE_CACHEL_FONT(cachel, charset) \
(cachel->font[XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE])
+#define FACE_CACHEL_FONT_UPDATED(x) \
+ ((struct Lisp_Bit_Vector *)(&((x)->font_updated)))
+#define FACE_CACHEL_FONT_SPECIFIED(x) \
+ ((struct Lisp_Bit_Vector *)(&((x)->font_specified)))
+#define FACE_CACHEL_FONT_FINAL_STAGE(x) \
+ ((struct Lisp_Bit_Vector *)(&((x)->font_final_stage)))
+
#define WINDOW_FACE_CACHEL(window, index) \
Dynarr_atp ((window)->face_cachels, index)
@@ -352,13 +365,15 @@ void default_face_height_and_width_1 (Li
FACE_PROPERTY_INSTANCE_1 (face, property, domain, ERROR_ME_DEBUG_WARN, \
no_fallback, depth)
-Lisp_Object face_property_matching_instance (Lisp_Object face,
- Lisp_Object property,
- Lisp_Object charset,
- Lisp_Object domain,
- Error_Behavior errb,
- int no_fallback,
- Lisp_Object depth);
+Lisp_Object face_property_matching_instance
+ (Lisp_Object face,
+ Lisp_Object property,
+ Lisp_Object charset,
+ Lisp_Object domain,
+ Error_Behavior errb,
+ int no_fallback,
+ Lisp_Object depth,
+ enum font_specifier_matchspec_stages stages);
#define FACE_PROPERTY_SPEC_LIST(face, property, locale) \
Fspecifier_spec_list (FACE_PROPERTY_SPECIFIER (face, property), \
@@ -373,7 +388,8 @@ Lisp_Object face_property_matching_insta
FACE_PROPERTY_INSTANCE (face, Qbackground, domain, 0, Qzero)
#define FACE_FONT(face, domain, charset) \
face_property_matching_instance (face, Qfont, charset, domain, \
- ERROR_ME_DEBUG_WARN, 0, Qzero)
+ ERROR_ME_DEBUG_WARN, 0, Qzero, \
+ initial)
#define FACE_DISPLAY_TABLE(face, domain) \
FACE_PROPERTY_INSTANCE (face, Qdisplay_table, domain, 0, Qzero)
#define FACE_BACKGROUND_PIXMAP(face, domain) \
1.3 +69 -0 XEmacs/xemacs/src/font-mgr.h
Index: font-mgr.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- font-mgr.h 2006/04/25 14:02:09 1.2
+++ font-mgr.h 2006/11/05 22:31:43 1.3
@@ -68,4 +68,73 @@ DECLARE_LRECORD(fc_pattern, struct fc_pa
#define CONCHECK_FCPATTERN(x) CONCHECK_RECORD (x, fc_pattern)
#define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr)
+#ifdef USE_XFT
+/*
+ The format of a fontname (as returned by fontconfig) is not well-documented,
+ But the character repertoire is represented in an ASCII-compatible way. See
+ fccharset.c (FcCharSetUnparse). So we can use UTF-8 for long names.
+
+ Currently we have a hack where different versions of the unparsed name are
+ used in different contexts fairly arbitrarily. I don't think this is close
+ to coherency; even without the charset and lang properties fontconfig names
+ are too unwieldy to use. We need to rethink the approach here. I think
+ probably Lisp_Font_Instance.name should contain the font name as specified
+ to Lisp (almost surely much shorter than shortname, even, and most likely
+ wildcarded), while Lisp_Font_Instance.truename should contain the longname.
+ For now, I'm going to #ifdef the return values defaulting to short. -- sjt
+*/
+
+/* DEBUGGING STUFF */
+
+/* print message to stderr: one internal-format string argument */
+#define DEBUG_XFT0(level,s) \
+ if (debug_xft > level) stderr_out (s)
+
+/* print message to stderr: one formatted argument */
+#define DEBUG_XFT1(level,format,x1) \
+ if (debug_xft > level) stderr_out (format, x1)
+
+/* print message to stderr: two formatted arguments */
+#define DEBUG_XFT2(level,format,x1,x2) \
+ if (debug_xft > level) stderr_out (format, x1, x2)
+
+/* print message to stderr: three formatted arguments */
+#define DEBUG_XFT3(level,format,x1,x2,x3) \
+ if (debug_xft > level) stderr_out (format, x1, x2, x3)
+
+/* print message to stderr: four formatted arguments */
+#define DEBUG_XFT4(level,format,x1,x2,x3,x4) \
+ if (debug_xft > level) stderr_out (format, x1, x2, x3, x4)
+
+/* print an Xft pattern to stderr
+ LEVEL is the debug level (to compare to debug_xft)
+ FORMAT is a newline-terminated printf format with one %s for the pattern
+ and must be internal format (eg, pure ASCII)
+ PATTERN is an FcPattern *. */
+#define PRINT_XFT_PATTERN(level,format,pattern) \
+ do { \
+ DECLARE_EISTRING (eistrpxft_name); \
+ FcChar8 *name = FcNameUnparse (pattern); \
+ \
+ eicpy_ext(eistrpxft_name, name, Qfc_font_name_encoding); \
+ DEBUG_XFT1 (level, format, eidata(eistrpxft_name)); \
+ free (name); \
+ } while (0)
+
+/* print a progress message
+ LEVEL is the debug level (to compare to debug_xft)
+ FONT is the Xft font name in UTF-8 (the native encoding of Xft)
+ LANG is the language being checked for support (must be ASCII). */
+#define CHECKING_LANG(level,font,lang) \
+ do { \
+ DECLARE_EISTRING (eistrcl_name); \
+ eicpy_ext(eistrcl_name, font, Qfc_font_name_encoding); \
+ DEBUG_XFT2 (level, "checking if %s handles %s\n", \
+ eidata(eistrcl_name), lang); \
+ } while (0)
+
+#else /* USE_XFT */
+
+#endif /* USE_XFT */
+
#endif /* INCLUDED_font_mgr_h_ */
1.18 +3 -0 XEmacs/xemacs/src/general-slots.h
Index: general-slots.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/general-slots.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -p -r1.17 -r1.18
--- general-slots.h 2006/06/03 17:50:54 1.17
+++ general-slots.h 2006/11/05 22:31:44 1.18
@@ -130,6 +130,7 @@ SYMBOL (Qfallback);
SYMBOL (Qfile);
SYMBOL_MODULE_API (Qfile_name);
SYMBOL_KEYWORD (Q_filter);
+SYMBOL (Qfinal);
SYMBOL (Qfixnum);
SYMBOL (Qfloat);
SYMBOL (Qfont);
@@ -157,6 +158,7 @@ SYMBOL (Qhorizontal);
SYMBOL (Qicon);
SYMBOL (Qid);
SYMBOL (Qignore);
+SYMBOL (Qinitial);
SYMBOL (Qimage);
SYMBOL_KEYWORD (Q_image);
SYMBOL_KEYWORD (Q_included);
@@ -286,6 +288,7 @@ SYMBOL (Qtype);
SYMBOL (Qundecided);
SYMBOL (Qundefined);
SYMBOL (Qunimplemented);
+SYMBOL (Qunicode_registries);
SYMBOL (Quser_default);
SYMBOL_KEYWORD (Q_value);
SYMBOL (Qvalue_assoc);
1.11 +1 -1 XEmacs/xemacs/src/intl.c
Index: intl.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/intl.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -p -r1.10 -r1.11
--- intl.c 2005/09/24 16:31:39 1.10
+++ intl.c 2006/11/05 22:31:44 1.11
@@ -167,7 +167,7 @@ This function does nothing if I18N3 was
void
init_intl (void)
{
- /* This function can GC */
+ /* This function cannot GC, because it explicitly prevents it. */
if (initialized)
{
int count = begin_gc_forbidden ();
1.144 +8 -1 XEmacs/xemacs/src/lisp.h
Index: lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.143
retrieving revision 1.144
diff -u -p -r1.143 -r1.144
--- lisp.h 2006/07/08 16:15:56 1.143
+++ lisp.h 2006/11/05 22:31:44 1.144
@@ -2623,6 +2623,13 @@ set_bit_vector_bit (Lisp_Bit_Vector *v,
#define BIT_VECTOR_LONG_STORAGE(len) \
(((len) + LONGBITS_POWER_OF_2 - 1) >> LONGBITS_LOG2)
+/* For when we want to include a bit vector in another structure, and we
+ know it's of a fixed size. */
+#define DECLARE_INLINE_LISP_BIT_VECTOR(numbits) struct { \
+ struct LCRECORD_HEADER lheader; \
+ Elemcount size; \
+ unsigned long bits[BIT_VECTOR_LONG_STORAGE(numbits)]; \
+}
/*------------------------------ symbol --------------------------------*/
@@ -5601,7 +5608,7 @@ extern Lisp_Object Qprint_string_length,
extern Lisp_Object Qprogn, Qquit, Qquote, Qrange_error;
extern Lisp_Object Qread_char, Qread_from_minibuffer;
extern Lisp_Object Qreally_early_error_handler, Qregion_beginning;
-extern Lisp_Object Qregion_end, Qregistry, Qreverse_direction_charset;
+extern Lisp_Object Qregion_end, Qregistries, Qreverse_direction_charset;
extern Lisp_Object Qrun_hooks, Qsans_modifiers, Qsave_buffers_kill_emacs;
extern Lisp_Object Qself_insert_command, Qself_insert_defer_undo, Qsequencep;
extern Lisp_Object Qset, Qsetting_constant, Qshort_name, Qsingularity_error;
1.48 +100 -51 XEmacs/xemacs/src/mule-charset.c
Index: mule-charset.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -p -r1.47 -r1.48
--- mule-charset.c 2006/06/03 17:50:54 1.47
+++ mule-charset.c 2006/11/05 22:31:44 1.48
@@ -35,6 +35,7 @@ Boston, MA 02111-1307, USA. */
#include "lstream.h"
#include "mule-ccl.h"
#include "objects.h"
+#include "specifier.h"
/* The various pre-defined charsets. */
@@ -79,7 +80,7 @@ static const struct sized_memory_descrip
Lisp_Object Qcharsetp;
/* Qdoc_string, Qdimension, Qchars defined in general.c */
-Lisp_Object Qregistry, Qfinal, Qgraphic;
+Lisp_Object Qregistries, Qfinal, Qgraphic, Qregistry;
Lisp_Object Qdirection;
Lisp_Object Qreverse_direction_charset;
Lisp_Object Qshort_name, Qlong_name;
@@ -128,7 +129,7 @@ mark_charset (Lisp_Object obj)
mark_object (cs->short_name);
mark_object (cs->long_name);
mark_object (cs->doc_string);
- mark_object (cs->registry);
+ mark_object (cs->registries);
mark_object (cs->ccl_program);
return cs->name;
}
@@ -158,7 +159,7 @@ print_charset (Lisp_Object obj, Lisp_Obj
CHARSET_COLUMNS (cs),
CHARSET_GRAPHIC (cs),
CHARSET_FINAL (cs));
- print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
+ print_internal (CHARSET_REGISTRIES (cs), printcharfun, 0);
write_fmt_string (printcharfun, " 0x%x>", cs->header.uid);
}
@@ -167,7 +168,7 @@ static const struct memory_description c
{ XD_INT, offsetof (Lisp_Charset, from_unicode_levels) },
{ XD_LISP_OBJECT, offsetof (Lisp_Charset, name) },
{ XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) },
- { XD_LISP_OBJECT, offsetof (Lisp_Charset, registry) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Charset, registries) },
{ XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) },
{ XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) },
{ XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) },
@@ -239,7 +240,8 @@ make_charset (int id, Lisp_Object name,
CHARSET_GRAPHIC (cs) = graphic;
CHARSET_FINAL (cs) = final;
CHARSET_DOC_STRING (cs) = doc;
- CHARSET_REGISTRY (cs) = reg;
+ CHECK_VECTOR(reg);
+ CHARSET_REGISTRIES (cs) = reg;
CHARSET_ENCODE_AS_UTF_8 (cs) = encode_as_utf_8 ? 1 : 0;
CHARSET_CCL_PROGRAM (cs) = Qnil;
CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
@@ -271,6 +273,8 @@ make_charset (int id, Lisp_Object name,
}
recalculate_unicode_precedence ();
+ setup_charset_initial_specifier_tags (obj);
+
return obj;
}
@@ -419,8 +423,8 @@ character set. Recognized properties ar
`short-name' Short version of the charset name (ex: Latin-1)
`long-name' Long version of the charset name (ex: ISO8859-1 (Latin-1))
-`registry' A regular expression matching the font registry field for
- this character set.
+`registries' A vector of possible XLFD REGISTRY-ENCODING combinations for
+ this character set. Note that this is not a regular expression.
`dimension' Number of octets used to index a character in this charset.
Either 1 or 2. Defaults to 1.
`columns' Number of columns used to display a character in this charset.
@@ -468,7 +472,7 @@ character set. Recognized properties ar
Ibyte final = 0;
int direction = CHARSET_LEFT_TO_RIGHT;
int type;
- Lisp_Object registry = Qnil;
+ Lisp_Object registries = Qnil;
Lisp_Object charset = Qnil;
Lisp_Object ccl_program = Qnil;
Lisp_Object short_name = Qnil, long_name = Qnil;
@@ -538,10 +542,27 @@ character set. Recognized properties ar
invalid_constant ("Invalid value for `graphic'", value);
}
+ else if (EQ (keyword, Qregistries))
+ {
+ CHECK_VECTOR (value);
+ registries = value;
+ }
+
else if (EQ (keyword, Qregistry))
{
+ Lisp_Object quoted_registry;
+
CHECK_STRING (value);
- registry = value;
+ quoted_registry = Fregexp_quote(value);
+ if (strcmp(XSTRING_DATA(quoted_registry),
+ XSTRING_DATA(value)))
+ {
+ warn_when_safe
+ (Qregistry, Qwarning,
+ "Regexps no longer allowed for charset-registry. "
+ "Treating %s as string", XSTRING_DATA(value));
+ }
+ registries = vector1(value);
}
else if (EQ (keyword, Qdirection))
@@ -613,8 +634,8 @@ character set. Recognized properties ar
}
if (NILP (doc_string))
doc_string = build_string ("");
- if (NILP (registry))
- registry = build_string ("");
+ if (NILP (registries))
+ registries = make_vector(0, Qnil);
if (NILP (short_name))
short_name = XSYMBOL (name)->name;
if (NILP (long_name))
@@ -624,7 +645,7 @@ character set. Recognized properties ar
charset = make_charset (id, name, dimension + 2, type, columns, graphic,
final, direction, short_name, long_name,
- doc_string, registry, !NILP (existing_charset),
+ doc_string, registries, !NILP (existing_charset),
encode_as_utf_8);
XCHARSET (charset)->temporary = temporary;
@@ -657,7 +678,7 @@ NEW-NAME is the name of the new charset.
int id, dimension, columns, graphic, encode_as_utf_8;
Ibyte final;
int direction, type;
- Lisp_Object registry, doc_string, short_name, long_name;
+ Lisp_Object registries, doc_string, short_name, long_name;
Lisp_Charset *cs;
charset = Fget_charset (charset);
@@ -684,12 +705,12 @@ NEW-NAME is the name of the new charset.
doc_string = CHARSET_DOC_STRING (cs);
short_name = CHARSET_SHORT_NAME (cs);
long_name = CHARSET_LONG_NAME (cs);
- registry = CHARSET_REGISTRY (cs);
+ registries = CHARSET_REGISTRIES (cs);
encode_as_utf_8 = CHARSET_ENCODE_AS_UTF_8 (cs);
new_charset = make_charset (id, new_name, dimension + 2, type, columns,
graphic, final, direction, short_name, long_name,
- doc_string, registry, 0, encode_as_utf_8);
+ doc_string, registries, 0, encode_as_utf_8);
CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
@@ -820,7 +841,7 @@ Recognized properties are those listed i
if (EQ (prop, Qgraphic)) return make_int (CHARSET_GRAPHIC (cs));
if (EQ (prop, Qfinal)) return make_char (CHARSET_FINAL (cs));
if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs));
- if (EQ (prop, Qregistry)) return CHARSET_REGISTRY (cs);
+ if (EQ (prop, Qregistries)) return CHARSET_REGISTRIES (cs);
if (EQ (prop, Qencode_as_utf_8))
return CHARSET_ENCODE_AS_UTF_8 (cs) ? Qt : Qnil;
if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
@@ -862,15 +883,39 @@ Set the `ccl-program' property of CHARSE
return Qnil;
}
-/* Japanese folks may want to (set-charset-registry 'ascii "jisx0201") */
-DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
-Set the `registry' property of CHARSET to REGISTRY.
+DEFUN ("set-charset-registries", Fset_charset_registries, 2, 2, 0, /*
+Set the `registries' property of CHARSET to REGISTRIES.
+
+REGISTRIES is an ordered vector of strings that describe the X11
+CHARSET_REGISTRY and the CHARSET_ENCODINGs appropriate for this charset.
+Separate each registry from the corresponding encoding with a dash. The
+strings are not regular expressions, in contrast to the old behavior of
+the `charset-registry' property.
+
+One reason to call this function might be if you're in Japan and you'd
+prefer the backslash to display as a Yen sign; the corresponding syntax
+would be:
+
+(set-charset-registries 'ascii ["jisx0201.1976-0"])
+
*/
- (charset, registry))
+ (charset, registries))
{
+ int i;
charset = Fget_charset (charset);
- CHECK_STRING (registry);
- XCHARSET_REGISTRY (charset) = registry;
+ CHECK_VECTOR (registries);
+
+ for (i = 0; i < XVECTOR_LENGTH(registries); ++i)
+ {
+ CHECK_STRING (XVECTOR_DATA(registries)[i]);
+ if (NULL == qxestrchr(XSTRING_DATA(XVECTOR_DATA(registries)[i]), '-'))
+ {
+ invalid_argument("Not an X11 REGISTRY-ENCODING combination",
+ XVECTOR_DATA(registries)[i]);
+ }
+ }
+
+ XCHARSET_REGISTRIES (charset) = registries;
invalidate_charset_font_caches (charset);
face_property_was_changed (Vdefault_face, Qfont, Qglobal);
return Qnil;
@@ -967,16 +1012,17 @@ syms_of_mule_charset (void)
DEFSUBR (Fcharset_property);
DEFSUBR (Fcharset_id);
DEFSUBR (Fset_charset_ccl_program);
- DEFSUBR (Fset_charset_registry);
+ DEFSUBR (Fset_charset_registries);
#ifdef MEMORY_USAGE_STATS
DEFSUBR (Fcharset_memory_usage);
#endif
DEFSYMBOL (Qcharsetp);
- DEFSYMBOL (Qregistry);
+ DEFSYMBOL (Qregistries);
DEFSYMBOL (Qfinal);
DEFSYMBOL (Qgraphic);
+ DEFSYMBOL (Qregistry);
DEFSYMBOL (Qdirection);
DEFSYMBOL (Qreverse_direction_charset);
DEFSYMBOL (Qshort_name);
@@ -1056,7 +1102,7 @@ complex_vars_of_mule_charset (void)
build_string ("ASCII"),
build_msg_string ("ASCII"),
build_msg_string ("ASCII (ISO646 IRV)"),
- build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"), 0, 0);
+ vector1(build_string("iso8859-1")), 0, 0);
staticpro (&Vcharset_control_1);
Vcharset_control_1 =
make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 2,
@@ -1065,7 +1111,7 @@ complex_vars_of_mule_charset (void)
build_string ("C1"),
build_msg_string ("Control characters"),
build_msg_string ("Control characters 128-191"),
- build_string (""), 0, 0);
+ vector1(build_string("iso8859-1")), 0, 0);
staticpro (&Vcharset_latin_iso8859_1);
Vcharset_latin_iso8859_1 =
make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 2,
@@ -1074,7 +1120,7 @@ complex_vars_of_mule_charset (void)
build_string ("Latin-1"),
build_msg_string ("ISO8859-1 (Latin-1)"),
build_msg_string ("ISO8859-1 (Latin-1)"),
- build_string ("iso8859-1"), 0, 0);
+ vector1(build_string("iso8859-1")), 0, 0);
staticpro (&Vcharset_latin_iso8859_2);
Vcharset_latin_iso8859_2 =
make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 2,
@@ -1083,7 +1129,7 @@ complex_vars_of_mule_charset (void)
build_string ("Latin-2"),
build_msg_string ("ISO8859-2 (Latin-2)"),
build_msg_string ("ISO8859-2 (Latin-2)"),
- build_string ("iso8859-2"), 0, 0);
+ vector1(build_string("iso8859-2")), 0, 0);
staticpro (&Vcharset_latin_iso8859_3);
Vcharset_latin_iso8859_3 =
make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 2,
@@ -1092,7 +1138,7 @@ complex_vars_of_mule_charset (void)
build_string ("Latin-3"),
build_msg_string ("ISO8859-3 (Latin-3)"),
build_msg_string ("ISO8859-3 (Latin-3)"),
- build_string ("iso8859-3"), 0, 0);
+ vector1(build_string("iso8859-3")), 0, 0);
staticpro (&Vcharset_latin_iso8859_4);
Vcharset_latin_iso8859_4 =
make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 2,
@@ -1101,7 +1147,7 @@ complex_vars_of_mule_charset (void)
build_string ("Latin-4"),
build_msg_string ("ISO8859-4 (Latin-4)"),
build_msg_string ("ISO8859-4 (Latin-4)"),
- build_string ("iso8859-4"), 0, 0);
+ vector1(build_string("iso8859-2")), 0, 0);
staticpro (&Vcharset_thai_tis620);
Vcharset_thai_tis620 =
make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 2,
@@ -1110,7 +1156,7 @@ complex_vars_of_mule_charset (void)
build_string ("TIS620"),
build_msg_string ("TIS620 (Thai)"),
build_msg_string ("TIS620.2529 (Thai)"),
- build_string ("tis620"), 0, 0);
+ vector1(build_string("tis620.2529-1")), 0, 0);
staticpro (&Vcharset_greek_iso8859_7);
Vcharset_greek_iso8859_7 =
make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 2,
@@ -1119,7 +1165,7 @@ complex_vars_of_mule_charset (void)
build_string ("ISO8859-7"),
build_msg_string ("ISO8859-7 (Greek)"),
build_msg_string ("ISO8859-7 (Greek)"),
- build_string ("iso8859-7"), 0, 0);
+ vector1(build_string("iso8859-7")), 0, 0);
staticpro (&Vcharset_arabic_iso8859_6);
Vcharset_arabic_iso8859_6 =
make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 2,
@@ -1128,7 +1174,7 @@ complex_vars_of_mule_charset (void)
build_string ("ISO8859-6"),
build_msg_string ("ISO8859-6 (Arabic)"),
build_msg_string ("ISO8859-6 (Arabic)"),
- build_string ("iso8859-6"), 0, 0);
+ vector1(build_string ("iso8859-6")), 0, 0);
staticpro (&Vcharset_hebrew_iso8859_8);
Vcharset_hebrew_iso8859_8 =
make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 2,
@@ -1137,7 +1183,7 @@ complex_vars_of_mule_charset (void)
build_string ("ISO8859-8"),
build_msg_string ("ISO8859-8 (Hebrew)"),
build_msg_string ("ISO8859-8 (Hebrew)"),
- build_string ("iso8859-8"), 0, 0);
+ vector1(build_string ("iso8859-8")), 0, 0);
staticpro (&Vcharset_katakana_jisx0201);
Vcharset_katakana_jisx0201 =
make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 2,
@@ -1146,7 +1192,7 @@ complex_vars_of_mule_charset (void)
build_string ("JISX0201 Kana"),
build_msg_string ("JISX0201.1976 (Japanese Kana)"),
build_msg_string ("JISX0201.1976 Japanese Kana"),
- build_string ("jisx0201.1976"), 0, 0);
+ vector1(build_string ("jisx0201.1976-0")), 0, 0);
staticpro (&Vcharset_latin_jisx0201);
Vcharset_latin_jisx0201 =
make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 2,
@@ -1155,7 +1201,7 @@ complex_vars_of_mule_charset (void)
build_string ("JISX0201 Roman"),
build_msg_string ("JISX0201.1976 (Japanese Roman)"),
build_msg_string ("JISX0201.1976 Japanese Roman"),
- build_string ("jisx0201.1976"), 0, 0);
+ vector1(build_string ("jisx0201.1976-0")), 0, 0);
staticpro (&Vcharset_cyrillic_iso8859_5);
Vcharset_cyrillic_iso8859_5 =
make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 2,
@@ -1164,7 +1210,7 @@ complex_vars_of_mule_charset (void)
build_string ("ISO8859-5"),
build_msg_string ("ISO8859-5 (Cyrillic)"),
build_msg_string ("ISO8859-5 (Cyrillic)"),
- build_string ("iso8859-5"), 0, 0);
+ vector1(build_string ("iso8859-5")), 0, 0);
staticpro (&Vcharset_latin_iso8859_9);
Vcharset_latin_iso8859_9 =
make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 2,
@@ -1173,7 +1219,7 @@ complex_vars_of_mule_charset (void)
build_string ("Latin-5"),
build_msg_string ("ISO8859-9 (Latin-5)"),
build_msg_string ("ISO8859-9 (Latin-5)"),
- build_string ("iso8859-9"), 0, 0);
+ vector1(build_string ("iso8859-9")), 0, 0);
staticpro (&Vcharset_latin_iso8859_15);
Vcharset_latin_iso8859_15 =
make_charset (LEADING_BYTE_LATIN_ISO8859_15, Qlatin_iso8859_15, 2,
@@ -1182,7 +1228,7 @@ complex_vars_of_mule_charset (void)
build_string ("Latin-9"),
build_msg_string ("ISO8859-15 (Latin-9)"),
build_msg_string ("ISO8859-15 (Latin-9)"),
- build_string ("iso8859-15"), 0, 0);
+ vector1(build_string ("iso8859-15")), 0, 0);
staticpro (&Vcharset_japanese_jisx0208_1978);
Vcharset_japanese_jisx0208_1978 =
make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978, 3,
@@ -1192,7 +1238,8 @@ complex_vars_of_mule_charset (void)
build_msg_string ("JISX0208.1978 (Japanese)"),
build_msg_string
("JISX0208.1978 Japanese Kanji (so called \"old JIS\")"),
- build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"), 0, 0);
+ vector2(build_string("jisx0208.1978-0"),
+ build_string("jisc6226.1978-0")), 0, 0);
staticpro (&Vcharset_chinese_gb2312);
Vcharset_chinese_gb2312 =
make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 3,
@@ -1201,7 +1248,8 @@ complex_vars_of_mule_charset (void)
build_string ("GB2312"),
build_msg_string ("GB2312)"),
build_msg_string ("GB2312 Chinese simplified"),
- build_string ("gb2312"), 0, 0);
+ vector2(build_string("gb2312.1980-0"),
+ build_string("gb2312.80&gb8565.88-0")), 0, 0);
staticpro (&Vcharset_japanese_jisx0208);
Vcharset_japanese_jisx0208 =
make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 3,
@@ -1210,7 +1258,8 @@ complex_vars_of_mule_charset (void)
build_string ("JISX0208"),
build_msg_string ("JISX0208.1983/1990 (Japanese)"),
build_msg_string ("JISX0208.1983/1990 Japanese Kanji"),
- build_string ("jisx0208.19\\(83\\|90\\)"), 0, 0);
+ vector2(build_string("jisx0208.1983-0"),
+ build_string("jisx0208.1990-0")), 0, 0);
staticpro (&Vcharset_korean_ksc5601);
Vcharset_korean_ksc5601 =
make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 3,
@@ -1219,7 +1268,7 @@ complex_vars_of_mule_charset (void)
build_string ("KSC5601"),
build_msg_string ("KSC5601 (Korean"),
build_msg_string ("KSC5601 Korean Hangul and Hanja"),
- build_string ("ksc5601"), 0, 0);
+ vector1(build_string("ksc5601.1987-0")), 0, 0);
staticpro (&Vcharset_japanese_jisx0212);
Vcharset_japanese_jisx0212 =
make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 3,
@@ -1228,9 +1277,9 @@ complex_vars_of_mule_charset (void)
build_string ("JISX0212"),
build_msg_string ("JISX0212 (Japanese)"),
build_msg_string ("JISX0212 Japanese Supplement"),
- build_string ("jisx0212"), 0, 0);
+ vector1(build_string("jisx0212.1990-0")), 0, 0);
-#define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
+#define CHINESE_CNS_PLANE(n) "cns11643.1992-" n
staticpro (&Vcharset_chinese_cns11643_1);
Vcharset_chinese_cns11643_1 =
make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 3,
@@ -1240,7 +1289,7 @@ complex_vars_of_mule_charset (void)
build_msg_string ("CNS11643-1 (Chinese traditional)"),
build_msg_string
("CNS 11643 Plane 1 Chinese traditional"),
- build_string (CHINESE_CNS_PLANE_RE("1")), 0, 0);
+ vector1(build_string (CHINESE_CNS_PLANE("1"))), 0, 0);
staticpro (&Vcharset_chinese_cns11643_2);
Vcharset_chinese_cns11643_2 =
make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 3,
@@ -1250,7 +1299,7 @@ complex_vars_of_mule_charset (void)
build_msg_string ("CNS11643-2 (Chinese traditional)"),
build_msg_string
("CNS 11643 Plane 2 Chinese traditional"),
- build_string (CHINESE_CNS_PLANE_RE("2")), 0, 0);
+ vector1(build_string (CHINESE_CNS_PLANE("2"))), 0, 0);
staticpro (&Vcharset_chinese_big5_1);
Vcharset_chinese_big5_1 =
make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 3,
@@ -1260,7 +1309,7 @@ complex_vars_of_mule_charset (void)
build_msg_string ("Big5 (Level-1)"),
build_msg_string
("Big5 Level-1 Chinese traditional"),
- build_string ("big5"), 0, 0);
+ vector1(build_string ("big5.eten-0")), 0, 0);
staticpro (&Vcharset_chinese_big5_2);
Vcharset_chinese_big5_2 =
make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 3,
@@ -1270,7 +1319,7 @@ complex_vars_of_mule_charset (void)
build_msg_string ("Big5 (Level-2)"),
build_msg_string
("Big5 Level-2 Chinese traditional"),
- build_string ("big5"), 0, 0);
+ vector1(build_string ("big5.eten-0")), 0, 0);
#ifdef ENABLE_COMPOSITE_CHARS
@@ -1285,7 +1334,7 @@ complex_vars_of_mule_charset (void)
build_string ("Composite"),
build_msg_string ("Composite characters"),
build_msg_string ("Composite characters"),
- build_string (""), 0, 0);
+ vector1(build_string ("")), 0, 0);
#else
/* We create a hack so that we have a way of storing ESC 0 and ESC 1
sequences as "characters", so that they will be output correctly. */
@@ -1297,6 +1346,6 @@ complex_vars_of_mule_charset (void)
build_string ("Composite hack"),
build_msg_string ("Composite characters hack"),
build_msg_string ("Composite characters hack"),
- build_string (""), 0, 0);
+ vector1(build_string ("")), 0, 0);
#endif /* ENABLE_COMPOSITE_CHARS */
}
1.18 +17 -115 XEmacs/xemacs/src/objects-gtk.c
Index: objects-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -p -r1.17 -r1.18
--- objects-gtk.c 2005/12/24 17:33:34 1.17
+++ objects-gtk.c 2006/11/05 22:31:44 1.18
@@ -40,6 +40,14 @@ Boston, MA 02111-1307, USA. */
/* sigh */
#include <gdk/gdkx.h>
+/* XListFonts doesn't allocate memory unconditionally based on this. (For
+ XFree86 in 2005, at least. */
+#define MAX_FONT_COUNT INT_MAX
+
+#ifdef DEBUG_XEMACS
+Fixnum debug_x_objects;
+#endif /* DEBUG_XEMACS */
+
/************************************************************************/
/* color instances */
@@ -378,68 +386,11 @@ gtk_font_list (Lisp_Object pattern, Lisp
return (__gtk_font_list_internal (patternext));
}
-
-#ifdef MULE
-
-static int
-gtk_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset,
- const Ibyte *nonreloc, Lisp_Object reloc,
- Bytecount offset, Bytecount length,
- int stage)
-{
- if (stage)
- return 0;
-
- if (UNBOUNDP (charset))
- return 1;
- /* Hack! Short font names don't have the registry in them,
- so we just assume the user knows what they're doing in the
- case of ASCII. For other charsets, you gotta give the
- long form; sorry buster.
- */
- if (EQ (charset, Vcharset_ascii))
- {
- const Ibyte *the_nonreloc = nonreloc;
- int i;
- Bytecount the_length = length;
-
- if (!the_nonreloc)
- the_nonreloc = XSTRING_DATA (reloc);
- fixup_internal_substring (nonreloc, reloc, offset, &the_length);
- the_nonreloc += offset;
- if (!memchr (the_nonreloc, '*', the_length))
- {
- for (i = 0;; i++)
- {
- const Ibyte *new_nonreloc = (const Ibyte *)
- memchr (the_nonreloc, '-', the_length);
- if (!new_nonreloc)
- break;
- new_nonreloc++;
- the_length -= new_nonreloc - the_nonreloc;
- the_nonreloc = new_nonreloc;
- }
-
- /* If it has less than 5 dashes, it's a short font.
- Of course, long fonts always have 14 dashes or so, but short
- fonts never have more than 1 or 2 dashes, so this is some
- sort of reasonable heuristic. */
- if (i < 5)
- return 1;
- }
- }
-
- return (fast_string_match (XCHARSET_REGISTRY (charset),
- nonreloc, reloc, offset, length, 1,
- ERROR_ME, 0) >= 0);
-}
-/* find a font spec that matches font spec FONT and also matches
- (the registry of) CHARSET. */
-static Lisp_Object gtk_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset, int stage);
+/* Include the charset support, shared, for the moment, with X11. */
+#define THIS_IS_GTK
+#include "objects-xlike-inc.c"
-#endif /* MULE */
-
/************************************************************************/
/* initialization */
@@ -478,63 +429,14 @@ console_type_create_objects_gtk (void)
void
vars_of_objects_gtk (void)
-{
-}
-
-/* #### BILL!!! Try to make this go away eventually */
-/* X Specific stuff */
-#include <X11/Xatom.h>
-
-#define MAX_FONT_COUNT INT_MAX
-
-#ifdef MULE
-/* find a font spec that matches font spec FONT and also matches
- (the registry of) CHARSET. */
-static Lisp_Object
-gtk_find_charset_font (Lisp_Object device, Lisp_Object font,
- Lisp_Object charset, int stage)
{
- char **names;
- int count = 0;
- Lisp_Object result = Qnil;
- const char *patternext;
- int i;
-
- if (stage)
- return Qnil;
-
- TO_EXTERNAL_FORMAT (LISP_STRING, font, C_STRING_ALLOCA, patternext, Qbinary);
-
- names = XListFonts (GDK_DISPLAY (),
- patternext, MAX_FONT_COUNT, &count);
- /* #### This code seems awfully bogus -- mrb */
- for (i = 0; i < count; i ++)
- {
- const Ibyte *intname;
- Bytecount intlen;
-
- TO_INTERNAL_FORMAT (C_STRING, names[i], ALLOCA, (intname, intlen),
- Qctext);
- if (gtk_font_spec_matches_charset (XDEVICE (device), charset,
- intname, Qnil, 0, -1, 0))
- {
- result = make_string (intname, intlen);
- break;
- }
- }
-
- if (names)
- XFreeFontNames (names);
-
- /* Check for a short font name. */
- if (NILP (result)
- && gtk_font_spec_matches_charset (XDEVICE (device), charset, 0,
- font, 0, -1, 0))
- return font;
-
- return result;
+#ifdef DEBUG_XEMACS
+ DEFVAR_INT ("debug-x-objects", &debug_x_objects /*
+If non-zero, display debug information about X objects
+*/ );
+ debug_x_objects = 0;
+#endif
}
-#endif /* MULE */
static int
valid_font_name_p (Display *dpy, char *name)
1.48 +2 -1 XEmacs/xemacs/src/objects-msw.c
Index: objects-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -p -r1.47 -r1.48
--- objects-msw.c 2005/01/28 02:58:51 1.47
+++ objects-msw.c 2006/11/05 22:31:44 1.48
@@ -2182,7 +2182,8 @@ mswindows_font_spec_matches_charset (str
static Lisp_Object
mswindows_find_charset_font (Lisp_Object device, Lisp_Object font,
- Lisp_Object charset, int stage)
+ Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
{
Lisp_Object fontlist, fonttail;
1.18 +2 -1 XEmacs/xemacs/src/objects-tty.c
Index: objects-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -p -r1.17 -r1.18
--- objects-tty.c 2005/11/25 01:42:06 1.17
+++ objects-tty.c 2006/11/05 22:31:45 1.18
@@ -367,7 +367,8 @@ tty_font_spec_matches_charset (struct de
(the registry of) CHARSET. */
static Lisp_Object
tty_find_charset_font (Lisp_Object device, Lisp_Object font,
- Lisp_Object charset, int stage)
+ Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
{
Ibyte *fontname = XSTRING_DATA (font);
1.44 +27 -598 XEmacs/xemacs/src/objects-x.c
Index: objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -p -r1.43 -r1.44
--- objects-x.c 2006/06/23 15:45:03 1.43
+++ objects-x.c 2006/11/05 22:31:45 1.44
@@ -37,6 +37,7 @@ Boston, MA 02111-1307, USA. */
#include "console-x-impl.h"
#include "objects-x-impl.h"
+#include "elhash.h"
#ifdef USE_XFT
#include "font-mgr.h"
@@ -44,6 +45,10 @@ Boston, MA 02111-1307, USA. */
int x_handle_non_fully_specified_fonts;
+#ifdef DEBUG_XEMACS
+Fixnum debug_x_objects;
+#endif /* DEBUG_XEMACS */
+
/************************************************************************/
/* color instances */
@@ -205,75 +210,7 @@ x_color_list (void)
/* font instances */
/************************************************************************/
-#ifdef USE_XFT
-/* #### all these #defines should probably move to font-mgr.h */
-
-/*
- The format of a fontname (as returned by fontconfig) is not well-documented,
- But the character repertoire is represented in an ASCII-compatible way. See
- fccharset.c (FcCharSetUnparse). So we can use UTF-8 for long names.
-
- Currently we have a hack where different versions of the unparsed name are
- used in different contexts fairly arbitrarily. I don't think this is close
- to coherency; even without the charset and lang properties fontconfig names
- are too unwieldy to use. We need to rethink the approach here. I think
- probably Lisp_Font_Instance.name should contain the font name as specified
- to Lisp (almost surely much shorter than shortname, even, and most likely
- wildcarded), while Lisp_Font_Instance.truename should contain the longname.
- For now, I'm going to #ifdef the return values defaulting to short. -- sjt
-*/
-
-/* DEBUGGING STUFF */
-
-/* print message to stderr: one internal-format string argument */
-#define DEBUG_XFT0(level,s) \
- if (debug_xft > level) stderr_out (s)
-
-/* print message to stderr: one formatted argument */
-#define DEBUG_XFT1(level,format,x1) \
- if (debug_xft > level) stderr_out (format, x1)
-
-/* print message to stderr: two formatted arguments */
-#define DEBUG_XFT2(level,format,x1,x2) \
- if (debug_xft > level) stderr_out (format, x1, x2)
-
-/* print message to stderr: three formatted arguments */
-#define DEBUG_XFT3(level,format,x1,x2,x3) \
- if (debug_xft > level) stderr_out (format, x1, x2, x3)
-
-/* print message to stderr: four formatted arguments */
-#define DEBUG_XFT4(level,format,x1,x2,x3,x4) \
- if (debug_xft > level) stderr_out (format, x1, x2, x3, x4)
-
-/* print an Xft pattern to stderr
- LEVEL is the debug level (to compare to debug_xft)
- FORMAT is a newline-terminated printf format with one %s for the pattern
- and must be internal format (eg, pure ASCII)
- PATTERN is an FcPattern *. */
-#define PRINT_XFT_PATTERN(level,format,pattern) \
- do { \
- DECLARE_EISTRING (eistrpxft_name); \
- Extbyte *name = (Extbyte *) FcNameUnparse (pattern); \
- \
- eicpy_ext(eistrpxft_name, name, Qfc_font_name_encoding); \
- DEBUG_XFT1 (level, format, eidata(eistrpxft_name)); \
- free (name); \
- } while (0)
-
-/* print a progress message
- LEVEL is the debug level (to compare to debug_xft)
- FONT is the Xft font name in UTF-8 (the native encoding of Xft)
- LANG is the language being checked for support (must be ASCII). */
-#define CHECKING_LANG(level,font,lang) \
- do { \
- DECLARE_EISTRING (eistrcl_name); \
- eicpy_ext(eistrcl_name, (Extbyte *) font, Qfc_font_name_encoding); \
- DEBUG_XFT2 (level, "checking if %s handles %s\n", \
- eidata(eistrcl_name), lang); \
- } while (0)
-#endif /* USE_XFT */
-
static int
x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object UNUSED (name),
Lisp_Object device, Error_Behavior errb)
@@ -299,6 +236,12 @@ x_initialize_font_instance (Lisp_Font_In
rf = xft_open_font_by_name (dpy, extname);
#endif
LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding);
+ /* With XFree86 4.0's fonts, XListFonts returns an entry for
+ -isas-fangsong ti-medium-r-normal--16-160-72-72-c-160-gb2312.1980-0 but
+ an XLoadQueryFont on the corresponding XLFD returns NULL.
+
+ XListFonts is not trustworthy (of course, this is news to exactly
+ no-one used to reading XEmacs source.) */
fs = XLoadQueryFont (dpy, extname);
if (!fs && !rf)
@@ -461,9 +404,13 @@ x_print_font_instance (Lisp_Font_Instanc
Lisp_Object printcharfun,
int UNUSED (escapeflag))
{
+ /* We should print information here about initial vs. final stages; we
+ can't rely on the device charset stage cache for that,
+ unfortunately. */
if (FONT_INSTANCE_X_FONT (f))
- write_fmt_string (printcharfun, " font id: 0x%lx",
- (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
+ write_fmt_string (printcharfun, " font id: 0x%lx,",
+ (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
+
#ifdef USE_XFT
/* #### What should we do here? For now, print the address. */
if (FONT_INSTANCE_X_XFTFONT (f))
@@ -943,536 +890,11 @@ x_font_list (Lisp_Object pattern, Lisp_O
XFreeFontNames (names);
return result;
}
-
-#ifdef MULE
-
-static int
-x_font_spec_matches_charset (struct device * USED_IF_XFT (d),
- Lisp_Object charset,
- const Ibyte *nonreloc, Lisp_Object reloc,
- Bytecount offset, Bytecount length,
- int stage)
-{
- if (stage)
-#ifdef USE_XFT
- {
- Display *dpy = DEVICE_X_DISPLAY (d);
- Extbyte *extname;
- XftFont *rf;
- const Ibyte *the_nonreloc;
- if (!NILP(reloc))
- {
- the_nonreloc = XSTRING_DATA (reloc);
- LISP_STRING_TO_EXTERNAL (reloc, extname, Qx_font_name_encoding);
- rf = xft_open_font_by_name (dpy, extname);
- return 0; /* #### maybe this will compile and run ;) */
- }
- }
-#else
- return 0;
-#endif
-
- if (UNBOUNDP (charset))
- return 1;
- /* Hack! Short font names don't have the registry in them,
- so we just assume the user knows what they're doing in the
- case of ASCII. For other charsets, you gotta give the
- long form; sorry buster.
- #### FMH: this screws fontconfig/Xft?
- STRATEGY: use fontconfig's ability to hack languages and character
- sets (lang and charset properties).
- #### Maybe we can use the fontconfig model to eliminate the difference
- between faces and fonts? No - it looks like that would be an abuse
- (fontconfig doesn't know about colors, although Xft does).
- */
- if (EQ (charset, Vcharset_ascii))
- {
- const Ibyte *the_nonreloc = nonreloc;
- int i;
- Bytecount the_length = length;
-
- if (!the_nonreloc)
- the_nonreloc = XSTRING_DATA (reloc);
- fixup_internal_substring (nonreloc, reloc, offset, &the_length);
- the_nonreloc += offset;
- if (!memchr (the_nonreloc, '*', the_length))
- {
- for (i = 0;; i++)
- {
- const Ibyte *new_nonreloc = (const Ibyte *)
- memchr (the_nonreloc, '-', the_length);
- if (!new_nonreloc)
- break;
- new_nonreloc++;
- the_length -= new_nonreloc - the_nonreloc;
- the_nonreloc = new_nonreloc;
- }
-
- /* If it has less than 5 dashes, it's a short font.
- Of course, long fonts always have 14 dashes or so, but short
- fonts never have more than 1 or 2 dashes, so this is some
- sort of reasonable heuristic. */
- if (i < 5)
- return 1;
- }
- }
-
- return (fast_string_match (XCHARSET_REGISTRY (charset),
- nonreloc, reloc, offset, length, 1,
- ERROR_ME, 0) >= 0);
-}
-
-#ifdef USE_XFT
-/* #### debug functions: find a better place for us */
-const char *FcResultToString (FcResult r);
-const char *
-FcResultToString (FcResult r)
-{
- static char buffer[256];
- switch (r)
- {
- case FcResultMatch:
- return "FcResultMatch";
- case FcResultNoMatch:
- return "FcResultNoMatch";
- case FcResultTypeMismatch:
- return "FcResultTypeMismatch";
- case FcResultNoId:
- return "FcResultNoId";
- default:
- snprintf (buffer, 255, "FcResultUndocumentedValue (%d)", r);
- return buffer;
- }
-}
-
-const char *FcTypeOfValueToString (FcValue v);
-const char *
-FcTypeOfValueToString (FcValue v)
-{
- static char buffer[256];
- switch (v.type)
- {
- case FcTypeMatrix:
- return "FcTypeMatrix";
- case FcTypeString:
- return "FcTypeString";
- case FcTypeVoid:
- return "FcTypeVoid";
- case FcTypeDouble:
- return "FcTypeDouble";
- case FcTypeInteger:
- return "FcTypeInteger";
- case FcTypeBool:
- return "FcTypeBool";
- case FcTypeCharSet:
- return "FcTypeCharSet";
- case FcTypeLangSet:
- return "FcTypeLangSet";
- /* #### There is no union member of this type, but there are void* and
- FcPattern* members, as of fontconfig.h FC_VERSION 10002 */
- case FcTypeFTFace:
- return "FcTypeFTFace";
- default:
- snprintf (buffer, 255, "FcTypeUndocumentedType (%d)", v.type);
- return buffer;
- }
-}
-
-static FcCharSet *
-mule_to_fc_charset (Lisp_Object cs)
-{
- int ucode, i, j;
- FcCharSet *fccs;
-
- CHECK_CHARSET (cs);
- fccs = FcCharSetCreate ();
- /* #### do we also need to deal with 94 vs. 96 charsets?
- ie, how are SP and DEL treated in ASCII? non-graphic should return -1 */
- if (1 == XCHARSET_DIMENSION (cs))
- /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */
- for (i = 0; i < 96; i++)
- {
- ucode = ((int *) XCHARSET_TO_UNICODE_TABLE (cs))[i];
- if (ucode >= 0)
- /* #### should check for allocation failure */
- FcCharSetAddChar (fccs, (FcChar32) ucode);
- }
- else if (2 == XCHARSET_DIMENSION (cs))
- /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */
- for (i = 0; i < 96; i++)
- for (j = 0; j < 96; j++)
- {
- ucode = ((int **) XCHARSET_TO_UNICODE_TABLE (cs))[i][j];
- if (ucode >= 0)
- /* #### should check for allocation failure */
- FcCharSetAddChar (fccs, (FcChar32) ucode);
- }
- else
- {
- FcCharSetDestroy (fccs);
- fccs = NULL;
- }
- return fccs;
-}
-
-struct charset_reporter {
- Lisp_Object *charset;
- /* This is a debug facility, require ASCII. */
- Extbyte *language; /* ASCII, please */
- /* Technically this is FcChar8, but fsckin' GCC 4 bitches. */
- Extbyte *rfc3066; /* ASCII, please */
-};
-
-static struct charset_reporter charset_table[] =
- {
- /* #### It's my branch, my favorite charsets get checked first!
- That's a joke, Son.
- Ie, I don't know what I'm doing, so my charsets first is as good as
- any other arbitrary order. If you have a better idea, speak up! */
- { &Vcharset_ascii, "English", "en" },
- { &Vcharset_japanese_jisx0208, "Japanese", "ja" },
- { &Vcharset_japanese_jisx0212, "Japanese", "ja" },
- { &Vcharset_katakana_jisx0201, "Japanese", "ja" },
- { &Vcharset_latin_jisx0201, "Japanese", "ja" },
- { &Vcharset_japanese_jisx0208_1978, "Japanese", "ja" },
- { &Vcharset_greek_iso8859_7, "Greek", "el" },
- /* #### all the Chinese need checking
- Damn the blood-sucking ISO anyway. */
- { &Vcharset_chinese_gb2312, "simplified Chinese", "zh-CN" },
- { &Vcharset_korean_ksc5601, "Korean", "ko" },
- { &Vcharset_chinese_cns11643_1, "traditional Chinese", "zh-TW" },
- { &Vcharset_chinese_cns11643_2, "traditional Chinese", "zh-TW" },
- { &Vcharset_latin_iso8859_1, NULL, NULL },
- { &Vcharset_latin_iso8859_2, NULL, NULL },
- { &Vcharset_latin_iso8859_3, NULL, NULL },
- { &Vcharset_latin_iso8859_4, NULL, NULL },
- { &Vcharset_latin_iso8859_9, NULL, NULL },
- { &Vcharset_latin_iso8859_15, NULL, NULL },
- { &Vcharset_thai_tis620, NULL, NULL },
- { &Vcharset_arabic_iso8859_6, NULL, NULL },
- { &Vcharset_hebrew_iso8859_8, "Hebrew", "he" },
- { &Vcharset_cyrillic_iso8859_5, NULL, NULL },
- /* #### these probably are not quite right */
- { &Vcharset_chinese_big5_1, "traditional Chinese", "zh-TW" },
- { &Vcharset_chinese_big5_2, "traditional Chinese", "zh-TW" },
- { NULL, NULL, NULL }
- };
-
-/* Choose appropriate font name for debug messages.
- Use only in the top half of next function (enforced with #undef). */
-#define DECLARE_DEBUG_FONTNAME(__xemacs_name) \
- Eistring *__xemacs_name; \
- do \
- { \
- __xemacs_name = debug_xft > 2 ? eistr_fullname \
- : debug_xft > 1 ? eistr_longname \
- : eistr_shortname; \
- } while (0)
-
-#endif /* USE_XFT */
-
-/* find a font spec that matches font spec FONT and also matches
- (the registry of) CHARSET. */
-static Lisp_Object
-x_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset,
- int stage)
-{
- Extbyte **names;
- int count = 0;
- const Extbyte *patternext;
- Lisp_Object result = Qnil;
- int i;
-
- /* #### with Xft need to handle second stage here -- sjt
- Hm. Or maybe not. That would be cool. :-) */
- if (stage)
- return Qnil;
-
-#ifdef USE_XFT
- /* Fontconfig converts all FreeType names to UTF-8 before passing them
- back to callers---see fcfreetype.c (FcFreeTypeQuery).
- I don't believe this is documented. */
-
- DEBUG_XFT1 (1, "confirming charset for font instance %s\n",
- XSTRING_DATA(font));
-
- /* #### this looks like a fair amount of work, but the basic design
- has never been rethought, and it should be
-
- what really should happen here is that we use FcFontSort (FcFontList?)
- to get a list of matching fonts, then pick the first (best) one that
- gives language or repertoire coverage.
- */
-
- FcInit (); /* No-op if already initialized.
- In fontconfig 2.3.2, this cannot return
- failure, but that looks like a bug. We
- check for it with FcGetCurrentConfig(),
- which *can* fail. */
- if (!FcConfigGetCurrent()) /* #### We should expose FcInit* interfaces
- to LISP and decide when to reinitialize
- intelligently. */
- stderr_out ("Failed fontconfig initialization\n");
- else
- {
- FcPattern *fontxft; /* long-lived, freed at end of this block */
- FcResult fcresult;
- FcConfig *fcc;
- FcChar8 *lang = (FcChar8 *) "en"; /* #### fix this bogus hack! */
- FcCharSet *fccs = NULL;
- DECLARE_EISTRING (eistr_shortname); /* user-friendly nickname */
- DECLARE_EISTRING (eistr_longname); /* omit FC_LANG and FC_CHARSET */
- DECLARE_EISTRING (eistr_fullname); /* everything */
+/* Include the charset support, shared, for the moment, with GTK. */
+#define THIS_IS_X
+#include "objects-xlike-inc.c"
- LISP_STRING_TO_EXTERNAL (font, patternext, Qfc_font_name_encoding);
- fcc = FcConfigGetCurrent ();
-
- /* parse the name, do the substitutions, and match the font */
-
- {
- FcPattern *p = FcNameParse ((FcChar8 *) patternext);
- PRINT_XFT_PATTERN (3, "FcNameParse'ed name is %s\n", p);
- /* #### Next two return FcBool, but what does the return mean? */
- /* The order is correct according the fontconfig docs. */
- FcConfigSubstitute (fcc, p, FcMatchPattern);
- PRINT_XFT_PATTERN (2, "FcConfigSubstitute'ed name is %s\n", p);
- FcDefaultSubstitute (p);
- PRINT_XFT_PATTERN (3, "FcDefaultSubstitute'ed name is %s\n", p);
- /* #### check fcresult of following match? */
- fontxft = FcFontMatch (fcc, p, &fcresult);
- /* this prints the long fontconfig name */
- PRINT_XFT_PATTERN (1, "FcFontMatch'ed name is %s\n", fontxft);
- FcPatternDestroy (p);
- }
-
- /* heuristic to give reasonable-length names for debug reports
-
- I considered #ifdef SUPPORT_FULL_FONTCONFIG_NAME etc but that's
- pointless. We're just going to remove this code once the font/
- face refactoring is done, but until then it could be very useful.
- */
- {
- FcPattern *p = FcFontRenderPrepare (fcc, fontxft, fontxft);
- FcChar8 *name;
-
- /* full name, including language coverage and repertoire */
- name = FcNameUnparse (p);
- eicpy_ext (eistr_fullname, (Extbyte *) name, Qfc_font_name_encoding);
- free (name);
-
- /* long name, omitting coverage and repertoire, plus a number
- of rarely useful properties */
- FcPatternDel (p, FC_CHARSET);
- FcPatternDel (p, FC_LANG);
- FcPatternDel (p, FC_WIDTH);
- FcPatternDel (p, FC_SPACING);
- FcPatternDel (p, FC_HINTING);
- FcPatternDel (p, FC_VERTICAL_LAYOUT);
- FcPatternDel (p, FC_AUTOHINT);
- FcPatternDel (p, FC_GLOBAL_ADVANCE);
- FcPatternDel (p, FC_INDEX);
- FcPatternDel (p, FC_SCALE);
- FcPatternDel (p, FC_FONTVERSION);
- name = FcNameUnparse (p);
- eicpy_ext (eistr_longname, (Extbyte *) name, Qfc_font_name_encoding);
- free (name);
-
- /* nickname, just family and size, but
- "family" names usually have style, slant, and weight */
- FcPatternDel (p, FC_FOUNDRY);
- FcPatternDel (p, FC_STYLE);
- FcPatternDel (p, FC_SLANT);
- FcPatternDel (p, FC_WEIGHT);
- FcPatternDel (p, FC_PIXEL_SIZE);
- FcPatternDel (p, FC_OUTLINE);
- FcPatternDel (p, FC_SCALABLE);
- FcPatternDel (p, FC_DPI);
- name = FcNameUnparse (p);
- eicpy_ext (eistr_shortname, (Extbyte *) name, Qfc_font_name_encoding);
- free (name);
-
- FcPatternDestroy (p);
- }
-
- /* The language approach may better in the long run, but we can't use
- it based on Mule charsets; fontconfig doesn't provide a way to test
- for unions of languages, etc. That will require support from the
- text module.
-
- Optimization: cache the generated FcCharSet in the Mule charset.
- Don't forget to destroy it if the Mule charset gets deallocated. */
-
- {
- /* This block possibly should be a function, but it generates
- multiple values. I find the "pass an address to return the
- value in" idiom opaque, so prefer a block. */
- struct charset_reporter *cr;
- for (cr = charset_table;
- cr->charset && !EQ (*(cr->charset), charset);
- cr++)
- ;
-
- if (cr->rfc3066)
- {
- DECLARE_DEBUG_FONTNAME (name);
- CHECKING_LANG (0, eidata(name), cr->language);
- lang = (FcChar8 *) cr->rfc3066;
- }
- else if (cr->charset)
- {
- /* what the hey, build 'em on the fly */
- /* #### in the case of error this could return NULL! */
- fccs = mule_to_fc_charset (charset);
- lang = (FcChar8 *) XSTRING_DATA (XSYMBOL
- (XCHARSET_NAME (charset))-> name);
- }
- else
- {
- /* OK, we fell off the end of the table */
- warn_when_safe_lispobj (intern ("xft"), intern ("alert"),
- list2 (build_string ("unchecked charset"),
- charset));
- /* default to "en"
- #### THIS IS WRONG, WRONG, WRONG!!
- It is why we never fall through to XLFD-checking. */
- }
-
- ASSERT_ASCTEXT_ASCII((Extbyte *) lang);
- }
-
- if (fccs)
- {
- /* check for character set coverage */
- int i = 0;
- FcCharSet *v;
- FcResult r = FcPatternGetCharSet (fontxft, FC_CHARSET, i, &v);
-
- if (r == FcResultTypeMismatch)
- {
- DEBUG_XFT0 (0, "Unexpected type return in charset value\n");
- result = Qnil;
- }
- else if (r == FcResultMatch && FcCharSetIsSubset (fccs, v))
- {
- /* The full pattern with the bitmap coverage is massively
- unwieldy, but the shorter names are's just *wrong*. We
- should have the full thing internally as truename, and
- filter stuff the client doesn't want to see on output.
- Should we just store it into the truename right here? */
- DECLARE_DEBUG_FONTNAME (name);
- DEBUG_XFT2 (0, "Xft font %s supports %s\n",
- eidata(name), lang);
-#ifdef RETURN_LONG_FONTCONFIG_NAMES
- result = eimake_string(eistr_fullname);
-#else
- result = eimake_string(eistr_longname);
-#endif
- }
- else
- {
- DECLARE_DEBUG_FONTNAME (name);
- DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n",
- eidata(name), lang);
- result = Qnil;
- }
-
- /* clean up */
- FcCharSetDestroy (fccs);
- }
- else
- {
- /* check for language coverage */
- int i = 0;
- FcValue v;
- /* the main event */
- FcResult r = FcPatternGet (fontxft, FC_LANG, i, &v);
-
- if (r == FcResultMatch)
- {
- if (v.type != FcTypeLangSet) /* excessive paranoia */
- {
- ASSERT_ASCTEXT_ASCII(FcTypeOfValueToString(v));
- /* Urk! Fall back and punt to core font. */
- DEBUG_XFT1 (0, "Unexpected type of lang value (%s)\n",
- FcTypeOfValueToString (v));
- result = Qnil;
- }
- else if (FcLangSetHasLang (v.u.l, lang) != FcLangDifferentLang)
- {
- DECLARE_DEBUG_FONTNAME (name);
- DEBUG_XFT2 (0, "Xft font %s supports %s\n",
- eidata(name), lang);
-#ifdef RETURN_LONG_FONTCONFIG_NAMES
- result = eimake_string(eistr_fullname);
-#else
- result = eimake_string(eistr_longname);
-#endif
- }
- else
- {
- DECLARE_DEBUG_FONTNAME (name);
- DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n",
- eidata(name), lang);
- result = Qnil;
- }
- }
- else
- {
- ASSERT_ASCTEXT_ASCII(FcResultToString(r));
- DEBUG_XFT1 (0, "Getting lang: unexpected result=%s\n",
- FcResultToString (r));
- result = Qnil;
- }
- }
-
- /* clean up and maybe return */
- FcPatternDestroy (fontxft);
- if (!UNBOUNDP (result))
- return result;
- }
-
- DEBUG_XFT1 (0, "shit happens, try X11 charset match for %s\n",
- XSTRING_DATA(font));
-#undef DECLARE_DEBUG_FONTNAME
-#endif /* USE_XFT */
-
- LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding);
- names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
- patternext, MAX_FONT_COUNT, &count);
- /* #### This code seems awfully bogus -- mrb */
- /* #### fontconfig does it better -- sjt */
- for (i = 0; i < count; i ++)
- {
- const Ibyte *intname;
- Bytecount intlen;
-
- TO_INTERNAL_FORMAT (C_STRING, names[i],
- ALLOCA, (intname, intlen),
- Qx_font_name_encoding);
- if (x_font_spec_matches_charset (XDEVICE (device), charset,
- intname, Qnil, 0, -1, 0))
- {
- result = build_ext_string ((const Extbyte *) intname,
- Qx_font_name_encoding);
- break;
- }
- }
-
- if (names)
- XFreeFontNames (names);
-
- /* Check for a short font name. */
- if (NILP (result)
- && x_font_spec_matches_charset (XDEVICE (device), charset, 0,
- font, 0, -1, 0))
- return font;
-
- return result;
-}
-
-#endif /* MULE */
-
/************************************************************************/
/* initialization */
@@ -1512,6 +934,13 @@ console_type_create_objects_x (void)
void
vars_of_objects_x (void)
{
+#ifdef DEBUG_XEMACS
+ DEFVAR_INT ("debug-x-objects", &debug_x_objects /*
+If non-zero, display debug information about X objects
+*/ );
+ debug_x_objects = 0;
+#endif
+
DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",
&x_handle_non_fully_specified_fonts /*
If this is true then fonts which do not have all characters specified
1.32 +50 -8 XEmacs/xemacs/src/objects.c
Index: objects.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -p -r1.31 -r1.32
--- objects.c 2005/11/26 11:46:10 1.31
+++ objects.c 2006/11/05 22:31:45 1.32
@@ -323,8 +323,11 @@ print_font_instance (Lisp_Object obj, Li
write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name);
write_fmt_string_lisp (printcharfun, " on %s", 1, f->device);
if (!NILP (f->device))
- MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
- (f, printcharfun, escapeflag));
+ {
+ MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
+ (f, printcharfun, escapeflag));
+
+ }
write_fmt_string (