[PATCH] fix mule build
17 years, 5 months
Robert Pluim
Robert Pluim
Aidan, I think this was caused by your latest changes.
src/ChangeLog addition:
2006-11-07 Robert Pluim <rpluim(a)gmail.com>
* mule-charset.c: Remove Qfinal, it's in general-slots.h now
XEmacs source patch:
Diff command: cvs -q diff -u
Files affected: src/mule-charset.c
Index: src/mule-charset.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v
retrieving revision 1.49
diff -u -u -r1.49 mule-charset.c
--- src/mule-charset.c 2006/11/06 19:35:45 1.49
+++ src/mule-charset.c 2006/11/07 09:35:12
＠＠ -79,8 +79,8 ＠＠
Lisp_Object Qcharsetp;
-/* Qdoc_string, Qdimension, Qchars defined in general.c */
-Lisp_Object Qregistries, Qfinal, Qgraphic, Qregistry;
+/* Qdoc_string, Qdimension, Qchars, Qfinal defined in general.c */
+Lisp_Object Qregistries, Qgraphic, Qregistry;
Lisp_Object Qdirection;
Lisp_Object Qreverse_direction_charset;
Lisp_Object Qshort_name, Qlong_name;
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
Re: [PATCH] (Draft3) Make X11 server-side fonts and Mule suck less.
17 years, 5 months
Aidan Kehoe
Aidan Kehoe
Ar an séiú lá de mí na Samhain, scríobh stephen(a)xemacs.org:
> > They’re already commented out--they’re just commentary on GNU Emacs’
> > approach to implementing Unicode. I’ve replaced them with a clearer
> > description of GNU’s approach and how ours differs.
>
> I know they're commented out, but as I said, I've seen code that uses
> those charsets in the wild. If and when we get a bug report on that,
> I'd rather have that code in an obvious place.
Then checking the below into FSF-Compat would be a better approach, I
think. Though the correspondence with their unicode code points is not
exact--that’s something I need to look into and to solve.
> Something's weird, then, because in the patch you posted there were a
> lot of repeated braces at the same indent level, as
>
> code;
> }
> }
>
> Are you saying you've since reformatted that to
>
> code;
> }
> }
>
> ?
Well, I didn’t see the symptom, despite looking at the original, and I
didn’t see the cure, despite looking at the diff, but indent-region should
have taken care of it. Or maybe it’s a question of tab stops.
Anyway, here’s that code mentioned above:
;;; BEGIN compat-mule-unicode-charsets.el
(define-ccl-program fsf-compat-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.")
(defun fsf-compat-init-mule-unicode-charsets ()
"Make some Mule character sets that the FSF uses available in XEmacs.
These character sets cover some Unicode code space explicitly; we use a
different solution to the same problem, so you should only need these
character sets if you're editing FSF source. "
(let (ku ten charset-symbol)
(loop
for (first-ucs last-ucs final) in '((#x0100 #x24FF ?1)
(#x2500 #x33ff ?2)
(#xE000 #xFFFF ?3))
do
(setq charset-symbol
(intern (format "mule-unicode-%04x-%04x"
first-ucs last-ucs)))
(make-charset charset-symbol
(format
"Unicode subset (U+%04X..U+%04X) for FSF compatibility."
first-ucs last-ucs)
(list 'dimension 2
'registries ["iso10646-1"]
'chars 96
'columns 1
'direction 'l2r
'final final
'graphic 0
'short-name (format "Unicode subset %c" final)
'long-name (format "Unicode subset (U+%04X..U+%04X)"
first-ucs last-ucs)
'ccl-program 'fsf-compat-ccl-encode-to-ucs-2))
(setq ten 32)
;; The names of the character sets lie, at least as of GNU Emacs
;; 22.0.50.3. The difference appears to be that they keep assigning
;; code points until the end of the 96x96 space of the character sets.
(loop for ku from 32 to 127 do
(set-unicode-conversion (make-char charset-symbol ku ten) first-ucs)
(incf first-ucs)
(incf ten)
(when (= ten 128) (setq ten 32))))))
;;; BEGIN compat-mule-unicode-charsets.el
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Fix the Windows build
17 years, 5 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
src/ChangeLog addition:
2006-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* mule-charset.c (Fmake_charset):
* objects-msw.c (mswindows_font_spec_matches_charset):
* specifier.c (syms_of_specifier):
Three changes to prevent the build dying with MSVC--thank you
Vin.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: src/specifier.c
===================================================================
RCS src/objects-msw.c
===================================================================
RCS src/mule-charset.c
===================================================================
RCS
Index: src/mule-charset.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v
retrieving revision 1.48
diff -u -u -r1.48 mule-charset.c
--- src/mule-charset.c 2006/11/05 22:31:44 1.48
+++ src/mule-charset.c 2006/11/06 19:30:59
＠＠ -554,7 +554,7 ＠＠
CHECK_STRING (value);
quoted_registry = Fregexp_quote(value);
- if (strcmp(XSTRING_DATA(quoted_registry),
+ if (qxestrcmp(XSTRING_DATA(quoted_registry),
XSTRING_DATA(value)))
{
warn_when_safe
Index: src/objects-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v
retrieving revision 1.48
diff -u -u -r1.48 objects-msw.c
--- src/objects-msw.c 2006/11/05 22:31:44 1.48
+++ src/objects-msw.c 2006/11/06 19:31:02
＠＠ -2167,7 +2167,7 ＠＠
const Ibyte *nonreloc,
Lisp_Object reloc,
Bytecount offset, Bytecount length,
- int stage)
+ enum font_specifier_matchspec_stages stage)
{
return stage ?
mswindows_font_spec_matches_charset_stage_2 (d, charset, nonreloc,
Index: src/specifier.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v
retrieving revision 1.45
diff -u -u -r1.45 specifier.c
--- src/specifier.c 2006/11/05 22:31:46 1.45
+++ src/specifier.c 2006/11/06 19:31:08
＠＠ -3809,7 +3809,9 ＠＠
DEFSUBR (Fcanonicalize_tag_set);
DEFSUBR (Fdevice_matches_specifier_tag_set_p);
DEFSUBR (Fdefine_specifier_tag);
+#ifdef DEBUG_XEMACS
DEFSUBR (Fdevice_matching_specifier_tag_list);
+#endif /* DEBUG_XEMACS */
DEFSUBR (Fspecifier_tag_list);
DEFSUBR (Fspecifier_tag_device_predicate);
DEFSUBR (Fspecifier_tag_charset_predicate);
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[PATCH] (Draft3) Make X11 server-side fonts and Mule suck less.
17 years, 5 months
Aidan Kehoe
Aidan Kehoe
SUPERSEDES 17735.53546.619702.311182(a)parhasard.net
In comparison to that, the changes it makes are applied to the GTK port (not
as ideally as one might like, the GTK port’s Lisp initialisation is still
screwy, but that’s sufficiently a separate issue for me that I’d prefer to
make a separate commit). The odd behaviour that happens when non-ASCII text
is selected has been eliminated.
In the absence of objections, I intend committing this tomorrow.
lisp/ChangeLog addition:
2006-11-04 Aidan Kehoe <kehoea(a)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-04 Aidan Kehoe <kehoea(a)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.
* 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.
src/ChangeLog addition:
2006-11-04 Aidan Kehoe <kehoea(a)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.
* 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.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: src/unicode.c
===================================================================
RCS src/specifier.h
===================================================================
RCS src/specifier.c
===================================================================
RCS src/redisplay.c
===================================================================
RCS src/redisplay-x.c
===================================================================
RCS src/objects.h
===================================================================
RCS src/objects.c
===================================================================
RCS src/objects-xlike-inc.c
===================================================================
RCS src/objects-x.c
===================================================================
RCS src/objects-tty.c
===================================================================
RCS src/objects-msw.c
===================================================================
RCS src/objects-gtk.c
===================================================================
RCS src/mule-charset.c
===================================================================
RCS src/lisp.h
===================================================================
RCS src/intl.c
===================================================================
RCS src/general-slots.h
===================================================================
RCS src/font-mgr.h
===================================================================
RCS src/faces.h
===================================================================
RCS src/faces.c
===================================================================
RCS src/console-impl.h
===================================================================
RCS src/charset.h
===================================================================
RCS lisp/mule/vietnamese.el
===================================================================
RCS lisp/mule/tibetan.el
===================================================================
RCS lisp/mule/thai-xtis.el
===================================================================
RCS lisp/mule/mule-charset.el
===================================================================
RCS lisp/mule/misc-lang.el
===================================================================
RCS lisp/mule/lao.el
===================================================================
RCS lisp/mule/japanese.el
===================================================================
RCS lisp/mule/indian.el
===================================================================
RCS lisp/mule/european.el
===================================================================
RCS lisp/mule/ethiopic.el
===================================================================
RCS lisp/mule/english.el
===================================================================
RCS lisp/mule/chinese.el
===================================================================
RCS lisp/mule/arabic.el
===================================================================
RCS lisp/x-font-menu.el
===================================================================
RCS lisp/x-faces.el
===================================================================
RCS lisp/unicode.el
===================================================================
RCS lisp/faces.el
===================================================================
RCS
Index: lisp/faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v
retrieving revision 1.38
diff -u -u -r1.38 faces.el
--- lisp/faces.el 2006/04/25 14:01:52 1.38
+++ lisp/faces.el 2006/11/04 22:11:40
＠＠ -250,19 +250,9 ＠＠
(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 ＠＠
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"))
Index: lisp/unicode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/unicode.el,v
retrieving revision 1.14
diff -u -u -r1.14 unicode.el
--- lisp/unicode.el 2006/07/13 20:45:49 1.14
+++ lisp/unicode.el 2006/11/04 22:11:44
＠＠ -29,54 +29,6 ＠＠
;;; Code:
-; ;; Subsets of Unicode.
-
-; #### 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)"
-; ))
-
-
;; 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,14 +257,14 ＠＠
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. ")
＠＠ -343,12 +295,6 ＠＠
"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
Index: lisp/x-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v
retrieving revision 1.25
diff -u -u -r1.25 x-faces.el
--- lisp/x-faces.el 2006/04/25 14:01:54 1.25
+++ lisp/x-faces.el 2006/11/04 22:11:44
＠＠ -782,7 +782,28 ＠＠
;; 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.
Index: lisp/x-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v
retrieving revision 1.17
diff -u -u -r1.17 x-font-menu.el
--- lisp/x-font-menu.el 2006/05/11 14:57:05 1.17
+++ lisp/x-font-menu.el 2006/11/04 22:11:44
＠＠ -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 ＠＠
;; #### - 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)
Index: lisp/mule/arabic.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/arabic.el,v
retrieving revision 1.7
diff -u -u -r1.7 arabic.el
--- lisp/mule/arabic.el 2002/03/16 10:39:05 1.7
+++ lisp/mule/arabic.el 2006/11/04 22:11:44
＠＠ -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
Index: lisp/mule/chinese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/chinese.el,v
retrieving revision 1.12
diff -u -u -r1.12 chinese.el
--- lisp/mule/chinese.el 2005/12/24 22:31:51 1.12
+++ lisp/mule/chinese.el 2006/11/04 22:11:45
＠＠ -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
Index: lisp/mule/english.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/english.el,v
retrieving revision 1.6
diff -u -u -r1.6 english.el
--- lisp/mule/english.el 2002/03/29 04:46:41 1.6
+++ lisp/mule/english.el 2006/11/04 22:11:45
＠＠ -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
Index: lisp/mule/ethiopic.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/ethiopic.el,v
retrieving revision 1.6
diff -u -u -r1.6 ethiopic.el
--- lisp/mule/ethiopic.el 2002/03/16 10:39:06 1.6
+++ lisp/mule/ethiopic.el 2006/11/04 22:11:45
＠＠ -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
Index: lisp/mule/european.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/european.el,v
retrieving revision 1.12
diff -u -u -r1.12 european.el
--- lisp/mule/european.el 2005/05/10 17:02:59 1.12
+++ lisp/mule/european.el 2006/11/04 22:11:45
＠＠ -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
Index: lisp/mule/indian.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/indian.el,v
retrieving revision 1.3
diff -u -u -r1.3 indian.el
--- lisp/mule/indian.el 2002/03/16 10:39:06 1.3
+++ lisp/mule/indian.el 2006/11/04 22:11:45
＠＠ -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
Index: lisp/mule/japanese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/japanese.el,v
retrieving revision 1.11
diff -u -u -r1.11 japanese.el
--- lisp/mule/japanese.el 2004/01/29 05:22:40 1.11
+++ lisp/mule/japanese.el 2006/11/04 22:11:45
＠＠ -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
Index: lisp/mule/lao.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/lao.el,v
retrieving revision 1.4
diff -u -u -r1.4 lao.el
--- lisp/mule/lao.el 2002/03/18 10:07:37 1.4
+++ lisp/mule/lao.el 2006/11/04 22:11:45
＠＠ -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
Index: lisp/mule/misc-lang.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/misc-lang.el,v
retrieving revision 1.5
diff -u -u -r1.5 misc-lang.el
--- lisp/mule/misc-lang.el 2002/03/16 10:39:07 1.5
+++ lisp/mule/misc-lang.el 2006/11/04 22:11:45
＠＠ -34,7 +34,7 ＠＠
(make-charset 'ipa "IPA (International Phonetic Association)"
'(dimension
1
- registry "MuleIPA"
+ registries ["MuleIPA"]
chars 96
columns 1
direction l2r
Index: lisp/mule/mule-charset.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-charset.el,v
retrieving revision 1.18
diff -u -u -r1.18 mule-charset.el
--- lisp/mule/mule-charset.el 2005/12/23 11:42:35 1.18
+++ lisp/mule/mule-charset.el 2006/11/04 22:11:46
＠＠ -106,12 +106,31 ＠＠
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.
Index: lisp/mule/thai-xtis.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/thai-xtis.el,v
retrieving revision 1.4
diff -u -u -r1.4 thai-xtis.el
--- lisp/mule/thai-xtis.el 2002/03/18 10:07:37 1.4
+++ lisp/mule/thai-xtis.el 2006/11/04 22:11:46
＠＠ -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)
Index: lisp/mule/tibetan.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/tibetan.el,v
retrieving revision 1.3
diff -u -u -r1.3 tibetan.el
--- lisp/mule/tibetan.el 2002/03/16 10:39:07 1.3
+++ lisp/mule/tibetan.el 2006/11/04 22:11:46
＠＠ -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
Index: lisp/mule/vietnamese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/vietnamese.el,v
retrieving revision 1.6
diff -u -u -r1.6 vietnamese.el
--- lisp/mule/vietnamese.el 2002/03/21 07:30:24 1.6
+++ lisp/mule/vietnamese.el 2006/11/04 22:11:47
＠＠ -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
Index: src/charset.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/charset.h,v
retrieving revision 1.14
diff -u -u -r1.14 charset.h
--- src/charset.h 2006/07/07 23:01:11 1.14
+++ src/charset.h 2006/11/04 22:11:47
＠＠ -58,6 +58,8 ＠＠
(byte1) = (ch); \
(byte2) = 0; \
} while (0)
+#define XCHARSET_CCL_PROGRAM(cs) Qnil
+#define XCHARSET_NAME(cs) Qascii
#else /* MULE */
＠＠ -186,7 +188,7 ＠＠
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 ＠＠
#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 ＠＠
#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 ＠＠
#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))
Index: src/console-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v
retrieving revision 1.12
diff -u -u -r1.12 console-impl.h
--- src/console-impl.h 2005/10/24 10:07:34 1.12
+++ src/console-impl.h 2006/11/04 22:11:47
＠＠ -26,6 +26,7 ＠＠
#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 ＠＠
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 *);
Index: src/faces.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v
retrieving revision 1.49
diff -u -u -r1.49 faces.c
--- src/faces.c 2005/11/26 11:46:08 1.49
+++ src/faces.c 2006/11/04 22:11:48
＠＠ -72,7 +72,32 ＠＠
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 ＠＠
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 ＠＠
(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 ＠＠
{
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 ＠＠
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 ＠＠
/* 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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
}
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
#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 ＠＠
/* 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(a)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
Index: src/faces.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.h,v
retrieving revision 1.17
diff -u -u -r1.17 faces.h
--- src/faces.h 2006/02/27 16:29:25 1.17
+++ src/faces.h 2006/11/04 22:11:48
＠＠ -25,6 +25,7 ＠＠
#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 ＠＠
/* 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 ＠＠
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 ＠＠
#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 ＠＠
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 ＠＠
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) \
Index: src/font-mgr.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.h,v
retrieving revision 1.2
diff -u -u -r1.2 font-mgr.h
--- src/font-mgr.h 2006/04/25 14:02:09 1.2
+++ src/font-mgr.h 2006/11/04 22:11:48
＠＠ -68,4 +68,73 ＠＠
#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_ */
Index: src/general-slots.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/general-slots.h,v
retrieving revision 1.17
diff -u -u -r1.17 general-slots.h
--- src/general-slots.h 2006/06/03 17:50:54 1.17
+++ src/general-slots.h 2006/11/04 22:11:48
＠＠ -130,6 +130,7 ＠＠
SYMBOL (Qfile);
SYMBOL_MODULE_API (Qfile_name);
SYMBOL_KEYWORD (Q_filter);
+SYMBOL (Qfinal);
SYMBOL (Qfixnum);
SYMBOL (Qfloat);
SYMBOL (Qfont);
＠＠ -157,6 +158,7 ＠＠
SYMBOL (Qicon);
SYMBOL (Qid);
SYMBOL (Qignore);
+SYMBOL (Qinitial);
SYMBOL (Qimage);
SYMBOL_KEYWORD (Q_image);
SYMBOL_KEYWORD (Q_included);
＠＠ -286,6 +288,7 ＠＠
SYMBOL (Qundecided);
SYMBOL (Qundefined);
SYMBOL (Qunimplemented);
+SYMBOL (Qunicode_registries);
SYMBOL (Quser_default);
SYMBOL_KEYWORD (Q_value);
SYMBOL (Qvalue_assoc);
Index: src/intl.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/intl.c,v
retrieving revision 1.10
diff -u -u -r1.10 intl.c
--- src/intl.c 2005/09/24 16:31:39 1.10
+++ src/intl.c 2006/11/04 22:11:49
＠＠ -167,7 +167,7 ＠＠
void
init_intl (void)
{
- /* This function can GC */
+ /* This function cannot GC, because it explicitly prevents it. */
if (initialized)
{
int count = begin_gc_forbidden ();
Index: src/lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.143
diff -u -u -r1.143 lisp.h
--- src/lisp.h 2006/07/08 16:15:56 1.143
+++ src/lisp.h 2006/11/04 22:11:51
＠＠ -2623,6 +2623,13 ＠＠
#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 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;
Index: src/mule-charset.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v
retrieving revision 1.47
diff -u -u -r1.47 mule-charset.c
--- src/mule-charset.c 2006/06/03 17:50:54 1.47
+++ src/mule-charset.c 2006/11/04 22:11:51
＠＠ -35,6 +35,7 ＠＠
#include "lstream.h"
#include "mule-ccl.h"
#include "objects.h"
+#include "specifier.h"
/* The various pre-defined charsets. */
＠＠ -79,7 +80,7 ＠＠
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_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 ＠＠
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 ＠＠
{ 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 ＠＠
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 ＠＠
}
recalculate_unicode_precedence ();
+ setup_charset_initial_specifier_tags (obj);
+
return obj;
}
＠＠ -419,8 +423,8 ＠＠
`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 ＠＠
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 ＠＠
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 ＠＠
}
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 */
}
Index: src/objects-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v
retrieving revision 1.17
diff -u -u -r1.17 objects-gtk.c
--- src/objects-gtk.c 2005/12/24 17:33:34 1.17
+++ src/objects-gtk.c 2006/11/04 22:11:52
＠＠ -40,6 +40,14 ＠＠
/* 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 ＠＠
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 ＠＠
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)
Index: src/objects-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v
retrieving revision 1.47
diff -u -u -r1.47 objects-msw.c
--- src/objects-msw.c 2005/01/28 02:58:51 1.47
+++ src/objects-msw.c 2006/11/04 22:11:53
＠＠ -2182,7 +2182,8 ＠＠
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;
Index: src/objects-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v
retrieving revision 1.17
diff -u -u -r1.17 objects-tty.c
--- src/objects-tty.c 2005/11/25 01:42:06 1.17
+++ src/objects-tty.c 2006/11/04 22:11:53
＠＠ -367,7 +367,8 ＠＠
(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);
Index: src/objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.43
diff -u -u -r1.43 objects-x.c
--- src/objects-x.c 2006/06/23 15:45:03 1.43
+++ src/objects-x.c 2006/11/04 22:11:53
＠＠ -37,6 +37,7 ＠＠
#include "console-x-impl.h"
#include "objects-x-impl.h"
+#include "elhash.h"
#ifdef USE_XFT
#include "font-mgr.h"
＠＠ -44,6 +45,10 ＠＠
int x_handle_non_fully_specified_fonts;
+#ifdef DEBUG_XEMACS
+Fixnum debug_x_objects;
+#endif /* DEBUG_XEMACS */
+
/************************************************************************/
/* color instances */
＠＠ -205,75 +210,7 ＠＠
/* 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 ＠＠
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 ＠＠
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 ＠＠
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;
- FcCharSe
- 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 ＠＠
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
Index: src/objects-xlike-inc.c
===================================================================
RCS file: objects-xlike-inc.c
diff -N objects-xlike-inc.c
--- /dev/null Sat Nov 4 23:12:14 2006
+++ objects-xlike-inc.c Sat Nov 4 23:11:54 2006
＠＠ -0,0 +1,776 ＠＠
+/* Shared object code between X and GTK -- include file.
+ Copyright (C) 1991-5, 1997 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+ Copyright (C) 1996, 2001, 2002, 2003 Ben Wing.
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not in FSF. */
+
+/* Pango is ready for prime-time now, as far as I understand it. The GTK
+ people should be using that. Oh well. (Aidan Kehoe, Sat Nov 4 12:41:12
+ CET 2006) */
+
+#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901)
+
+#ifdef DEBUG_XEMACS
+# define DEBUG_OBJECTS(FORMAT, ...) \
+ do { if (debug_x_objects) stderr_out(FORMAT, __VA_ARGS__); } while (0)
+#else /* DEBUG_XEMACS */
+# define DEBUG_OBJECTS(format, ...)
+#endif /* DEBUG_XEMACS */
+
+#elif defined(__GNUC__)
+
+#ifdef DEBUG_XEMACS
+# define DEBUG_OBJECTS(format, args...) \
+ do { if (debug_x_objects) stderr_out(format, args ); } while (0)
+#else /* DEBUG_XEMACS */
+# define DEBUG_OBJECTS(format, args...)
+#endif /* DEBUG_XEMACS */
+
+#else /* defined(__STDC_VERSION__) [...] */
+# define DEBUG_OBJECTS (void)
+#endif
+
+#ifdef MULE
+
+/* For some code it's reasonable to have only one copy and conditionalize
+ at run-time. For other code it isn't. */
+
+static int
+count_hyphens(const Ibyte *str, Bytecount length, Ibyte **last_hyphen)
+{
+ int hyphen_count = 0;
+ const Ibyte *hyphening = str;
+ const Ibyte *new_hyphening;
+
+ for (hyphen_count = 0;
+ NULL != (new_hyphening = memchr((const void *)hyphening, '-', length));
+ hyphen_count++)
+ {
+ ++new_hyphening;
+ length -= new_hyphening - hyphening;
+ hyphening = new_hyphening;
+ }
+
+ if (NULL != last_hyphen)
+ {
+ *last_hyphen = (Ibyte *)hyphening;
+ }
+
+ return hyphen_count;
+}
+
+static int
+#ifdef THIS_IS_GTK
+gtk_font_spec_matches_charset (struct device * USED_IF_XFT (d),
+ Lisp_Object charset,
+ const Ibyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount length,
+ enum font_specifier_matchspec_stages stage)
+#else
+x_font_spec_matches_charset (struct device * USED_IF_XFT (d),
+ Lisp_Object charset,
+ const Ibyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount length,
+ enum font_specifier_matchspec_stages stage)
+#endif
+{
+ Lisp_Object registries = Qnil;
+ long i, registries_len;
+ const Ibyte *the_nonreloc;
+ Bytecount the_length;
+
+ the_nonreloc = nonreloc;
+ the_length = length;
+
+ if (!the_nonreloc)
+ the_nonreloc = XSTRING_DATA (reloc);
+ fixup_internal_substring (nonreloc, reloc, offset, &the_length);
+ the_nonreloc += offset;
+
+#ifdef USE_XFT
+ if (stage)
+ {
+ 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 ;) */
+ /* Jesus, Stephen, what the fuck? */
+ }
+ }
+#endif
+
+ /* Hmm, this smells bad. */
+ 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) &&
+ (!memchr (the_nonreloc, '*', the_length))
+ && (5 > (count_hyphens(the_nonreloc, the_length, NULL))))
+ {
+ return 1;
+ }
+
+ if (final == stage)
+ {
+ registries = Qunicode_registries;
+ }
+ else if (initial == stage)
+ {
+ registries = XCHARSET_REGISTRIES (charset);
+ if (NILP(registries))
+ {
+ return 0;
+ }
+ }
+ else assert(0);
+
+ CHECK_VECTOR (registries);
+ registries_len = XVECTOR_LENGTH(registries);
+
+ for (i = 0; i < registries_len; ++i)
+ {
+ if (!(STRINGP(XVECTOR_DATA(registries)[i]))
+ || (XSTRING_LENGTH(XVECTOR_DATA(registries)[i]) > the_length))
+ {
+ continue;
+ }
+
+ /* Check if the font spec ends in the registry specified. X11 says
+ this comparison is case insensitive: XLFD, section 3.11:
+
+ "Alphabetic case distinctions are allowed but are for human
+ readability concerns only. Conforming X servers will perform
+ matching on font name query or open requests independent of case." */
+ if (0 == qxestrcasecmp(XSTRING_DATA(XVECTOR_DATA(registries)[i]),
+ the_nonreloc + (the_length -
+ XSTRING_LENGTH
+ (XVECTOR_DATA(registries)[i]))))
+ {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static Lisp_Object
+xlistfonts_checking_charset (Lisp_Object device, const Extbyte *xlfd,
+ Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
+{
+ Extbyte **names;
+ Lisp_Object result = Qnil;
+ int count = 0, i;
+ DECLARE_EISTRING(ei_single_result);
+
+ names = XListFonts (
+#ifdef THIS_IS_GTK
+ GDK_DISPLAY (),
+#else
+ DEVICE_X_DISPLAY (XDEVICE (device)),
+#endif
+ xlfd, MAX_FONT_COUNT, &count);
+
+ for (i = 0; i < count; ++i)
+ {
+ eireset(ei_single_result);
+ eicpy_ext(ei_single_result, names[i], Qx_font_name_encoding);
+
+ if (DEVMETH_OR_GIVEN(XDEVICE (device), font_spec_matches_charset,
+ (XDEVICE (device), charset,
+ eidata(ei_single_result), Qnil, 0,
+ -1, stage), 0))
+ {
+ result = eimake_string(ei_single_result);
+ DEBUG_OBJECTS ("in xlistfonts_checking_charset, returning %s\n",
+ eidata(ei_single_result));
+ break;
+ }
+ }
+
+ if (names)
+ {
+ XFreeFontNames (names);
+ }
+
+ return result;
+}
+
+#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)
+
+static Lisp_Object
+xft_find_charset_font (Lisp_Object font, Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
+{
+ const Extbyte *patternext;
+ Lisp_Object result = Qnil;
+
+ /* #### with Xft need to handle second stage here -- sjt
+ Hm. Or maybe not. That would be cool. :-) */
+ if (stage)
+ return Qnil;
+
+ /* 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 */
+
+ 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 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;
+ }
+ }
+ return Qnil;
+}
+#undef DECLARE_DEBUG_FONTNAME
+
+#endif /* USE_XFT */
+
+/* find a font spec that matches font spec FONT and also matches
+ (the registry of) CHARSET. */
+static Lisp_Object
+#ifdef THIS_IS_GTK
+gtk_find_charset_font (Lisp_Object device, Lisp_Object font,
+ Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
+#else
+x_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
+#endif
+{
+ Lisp_Object result = Qnil, registries = Qnil;
+ int j, hyphen_count, registries_len = 0;
+ Ibyte *hyphening, *new_hyphening;
+ Bytecount xlfd_length;
+
+ DECLARE_EISTRING(ei_xlfd_without_registry);
+ DECLARE_EISTRING(ei_xlfd);
+
+#ifdef USE_XFT
+ result = xft_find_charset_font(font, charset, stage);
+ if (!NILP(result))
+ {
+ return result;
+ }
+#endif
+
+ switch (stage)
+ {
+ case initial:
+ {
+ if (!(NILP(XCHARSET_REGISTRIES(charset)))
+ && VECTORP(XCHARSET_REGISTRIES(charset)))
+ {
+ registries_len = XVECTOR_LENGTH(XCHARSET_REGISTRIES(charset));
+ registries = XCHARSET_REGISTRIES(charset);
+ }
+ break;
+ }
+ case final:
+ {
+ registries_len = 1;
+ registries = Qunicode_registries;
+ break;
+ }
+ default:
+ {
+ assert(0);
+ break;
+ }
+ }
+
+ eicpy_lstr(ei_xlfd, font);
+ hyphening = eidata(ei_xlfd);
+ xlfd_length = eilen(ei_xlfd);
+
+ /* Count the hyphens in the string, moving new_hyphening to just after the
+ last one. */
+ hyphen_count = count_hyphens(hyphening, xlfd_length, &new_hyphening);
+
+ if (0 == registries_len || (5 > hyphen_count &&
+ !(1 == xlfd_length && '*' == *hyphening)))
+ {
+ /* No proper XLFD specified, or we can't modify the pattern to change
+ the registry and encoding to match what we want, or we have no
+ information on the registry needed. */
+ eito_external(ei_xlfd, Qx_font_name_encoding);
+ DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n",
+ eidata(ei_xlfd));
+ result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd),
+ charset, stage);
+ /* No need to loop through the available registries; return
+ immediately. */
+ return result;
+ }
+ else if (1 == xlfd_length && '*' == *hyphening)
+ {
+ /* It's a single asterisk. We can add the registry directly to the
+ end. */
+ eicpy_ch(ei_xlfd_without_registry, '*');
+ }
+ else
+ {
+ /* It's a fully-specified XLFD. Work out where the registry and
+ encoding are, and initialise ei_xlfd_without_registry to the string
+ without them. */
+
+ /* count_hyphens has set new_hyphening to just after the last
+ hyphen. Move back to just after the hyphen before it. */
+
+ for (new_hyphening -= 2; new_hyphening > hyphening
+ && '-' != *new_hyphening; --new_hyphening)
+ ;
+ ++new_hyphening;
+
+ eicpy_ei(ei_xlfd_without_registry, ei_xlfd);
+
+ /* Manipulate ei_xlfd_without_registry, using the information about
+ ei_xlfd, to which it's identical. */
+ eidel(ei_xlfd_without_registry, new_hyphening - hyphening, -1,
+ eilen(ei_xlfd) - (new_hyphening - hyphening), -1);
+
+ }
+
+ /* Now, loop through the registries and encodings defined for this
+ charset, doing an XListFonts each time with the pattern modified to
+ specify the regisry and encoding. This avoids huge amounts of IPC and
+ duplicated searching; now we use the searching the X server was doing
+ anyway, where before the X server did its search, transferred huge
+ amounts of data, and then we proceeded to do a regexp search on that
+ data. */
+ for (j = 0; j < registries_len && NILP(result); ++j)
+ {
+ eireset(ei_xlfd);
+ eicpy_ei(ei_xlfd, ei_xlfd_without_registry);
+
+ eicat_lstr(ei_xlfd, XVECTOR_DATA(registries)[j]);
+
+ eito_external(ei_xlfd, Qx_font_name_encoding);
+
+ DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n",
+ eidata(ei_xlfd));
+ result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd),
+ charset, stage);
+ }
+
+ /* This function used to return the font spec, in the case where a font
+ didn't exist on the X server but it did match the charset. We're not
+ doing that any more, because none of the other platform code does, and
+ the old behaviour was badly-judged in other respects, so I don't trust
+ the original author to have had a good reason for it. */
+
+ return result;
+}
+
+#endif /* MULE */
Index: src/objects.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v
retrieving revision 1.31
diff -u -u -r1.31 objects.c
--- src/objects.c 2005/11/26 11:46:10 1.31
+++ src/objects.c 2006/11/04 22:11:54
＠＠ -323,8 +323,11 ＠＠
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 (printcharfun, " 0x%x>", f->header.uid);
}
＠＠ -776,7 +779,7 ＠＠
font_spec_matches_charset (struct device *d, Lisp_Object charset,
const Ibyte *nonreloc, Lisp_Object reloc,
Bytecount offset, Bytecount length,
- int stage)
+ enum font_specifier_matchspec_stages stage)
{
return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
(d, charset, nonreloc, reloc, offset, length,
＠＠ -789,6 +792,21 ＠＠
{
CHECK_CONS (matchspec);
Fget_charset (XCAR (matchspec));
+
+ do
+ {
+ if (EQ(XCDR(matchspec), Qinitial))
+ {
+ break;
+ }
+ if (EQ(XCDR(matchspec), Qfinal))
+ {
+ break;
+ }
+
+ invalid_argument("Invalid font matchspec stage",
+ XCDR(matchspec));
+ } while (0);
}
void
＠＠ -836,12 +854,23 ＠＠
Lisp_Object instance;
Lisp_Object charset = Qnil;
#ifdef MULE
- int stage = 0;
+ enum font_specifier_matchspec_stages stage = initial;
if (!UNBOUNDP (matchspec))
{
charset = Fget_charset (XCAR (matchspec));
- stage = NILP (XCDR (matchspec)) ? 0 : 1;
+
+#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \
+ { \
+ stage = new_stage; \
+ }
+
+ FROB(initial)
+ else FROB(final)
+ else assert(0);
+
+#undef FROB
+
}
#endif
＠＠ -864,6 +893,7 ＠＠
if (STRINGP (instantiator))
{
#ifdef MULE
+ /* #### rename these caches. */
Lisp_Object cache = stage ? d->charset_font_cache_stage_2 :
d->charset_font_cache_stage_1;
#else
＠＠ -921,10 +951,22 ＠＠
}
else if (VECTORP (instantiator))
{
+ Lisp_Object match_inst = Qunbound;
assert (XVECTOR_LENGTH (instantiator) == 1);
- return (face_property_matching_instance
- (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
- charset, domain, ERROR_ME, 0, depth));
+
+ match_inst = face_property_matching_instance
+ (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
+ charset, domain, ERROR_ME, 0, depth, initial);
+
+ if (UNBOUNDP(match_inst))
+ {
+ match_inst = face_property_matching_instance
+ (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
+ charset, domain, ERROR_ME, 0, depth, final);
+ }
+
+ return match_inst;
+
}
else if (NILP (instantiator))
return Qunbound;
Index: src/objects.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.h,v
retrieving revision 1.11
diff -u -u -r1.11 objects.h
--- src/objects.h 2005/11/26 11:46:10 1.11
+++ src/objects.h 2006/11/04 22:11:55
＠＠ -76,4 +76,8 ＠＠
void set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
Lisp_Object property);
+/* Defined in search.c, used in mule-charset.c; slightly ugly to declare it
+ here, but oh well. */
+EXFUN (Fregexp_quote, 1);
+
#endif /* INCLUDED_objects_h_ */
Index: src/redisplay-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-x.c,v
retrieving revision 1.43
diff -u -u -r1.43 redisplay-x.c
--- src/redisplay-x.c 2006/06/27 22:59:40 1.43
+++ src/redisplay-x.c 2006/11/04 22:11:55
＠＠ -41,9 +41,8 ＠＠
#include "sysdep.h"
#include "window.h"
-#ifdef MULE
#include "mule-ccl.h"
-#endif
+#include "charset.h"
#include "console-x-impl.h"
#include "glyphs-x.h"
＠＠ -154,138 +153,148 ＠＠
static int
separate_textual_runs (unsigned char *text_storage,
struct textual_run *run_storage,
- const Ichar *str, Charcount len)
+ const Ichar *str, Charcount len,
+ struct face_cachel *cachel)
{
Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a
possible valid charset when
MULE is not defined */
- int runs_so_far = 0;
- int i;
-#ifdef MULE
+ int runs_so_far = 0, i;
+ Ibyte charset_leading_byte = LEADING_BYTE_ASCII;
+ int dimension = 1, graphic = 0, need_ccl_conversion = 0;
+ Lisp_Object ccl_prog;
struct ccl_program char_converter;
- int need_ccl_conversion = 0;
-#endif
+
+#ifdef USE_XFT
+#define translate_to_ucs_2 1 /* Translate to UTF-16 unconditionally. */
+#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) (void)(arg) /* Empty,
+ may avoid some
+ warnings. */
+#else /* USE_XFT */
+#ifndef MULE
+#define translate_to_ucs_2 0 /* We don't support falling back to
+ iso10646-1 without MULE */
+#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) (void)(arg)
+#else /* if MULE */
+ int translate_to_ucs_2 = 0;
+#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) translate_to_ucs_2 = (arg)
+#endif /* MULE */
+#endif /* !USE_XFT */
for (i = 0; i < len; i++)
{
Ichar ch = str[i];
Lisp_Object charset;
- int byte1, byte2; /* #### why aren't these UExtbytes? */
- int dimension;
- int graphic;
-
+ int byte1, byte2; /* Not UExbytes because BREAKUP_ICHAR takes
+ the addresses of its arguments and
+ dereferences those addresses as integer
+ pointers. */
BREAKUP_ICHAR (ch, charset, byte1, byte2);
- dimension = XCHARSET_DIMENSION (charset);
- graphic = XCHARSET_GRAPHIC (charset);
if (!EQ (charset, prev_charset))
{
run_storage[runs_so_far].ptr = text_storage;
run_storage[runs_so_far].charset = charset;
-#ifdef USE_XFT
- run_storage[runs_so_far].dimension = 2;
-#else
- run_storage[runs_so_far].dimension = dimension;
-#endif
if (runs_so_far)
{
run_storage[runs_so_far - 1].len =
text_storage - run_storage[runs_so_far - 1].ptr;
- if (run_storage[runs_so_far - 1].dimension == 2)
- run_storage[runs_so_far - 1].len >>= 1;
+ /* Checks the value for dimension from the previous run. */
+ if (2 == dimension) run_storage[runs_so_far - 1].len >>= 1;
}
- runs_so_far++;
- prev_charset = charset;
+
+ charset_leading_byte = XCHARSET_LEADING_BYTE(charset);
+
+ MAYBE_ASSIGN_TRANSLATE_TO_UCS_2
+ (bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE
+ (cachel),
+ charset_leading_byte - MIN_LEADING_BYTE));
+
+ if (translate_to_ucs_2)
+ {
+ dimension = 2;
+ run_storage[runs_so_far].dimension = 2;
+ }
+ else
+ {
+ dimension = XCHARSET_DIMENSION (charset);
+ run_storage[runs_so_far].dimension = dimension;
#ifdef MULE
- {
- Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset);
- if ((!NILP (ccl_prog))
+ ccl_prog = XCHARSET_CCL_PROGRAM (charset);
+ if ((!NILP (ccl_prog))
&& (setup_ccl_program (&char_converter, ccl_prog) >= 0))
- need_ccl_conversion = 1;
- }
-#endif
- }
+ {
+ need_ccl_conversion = 1;
+ }
+ else
+ {
+ /* The graphic property is only relevant if we're neither
+ doing the CCL conversion nor doing the UTF-16
+ conversion; it's irrelevant otherwise. */
+ graphic = XCHARSET_GRAPHIC (charset);
+ need_ccl_conversion = 0;
+ }
+#endif /* MULE */
+ }
+ prev_charset = charset;
-#ifndef USE_XFT
- if (graphic == 0)
- {
- byte1 &= 0x7F;
- byte2 &= 0x7F;
- }
- else if (graphic == 1)
+ runs_so_far++;
+ }
+
+ if (translate_to_ucs_2)
{
- byte1 |= 0x80;
- byte2 |= 0x80;
+ UINT_16_BIT ucs2;
+ int ucs = ichar_to_unicode(ch);
+
+ /* If UCS is less than zero or greater than 0xFFFF, set ucs2 to
+ REPLACMENT CHARACTER. */
+ ucs2 = (ucs & ~0xFFFF) ? 0xFFFD : ucs;
+
+ /* Ignoring the "graphic" handling. */
+#ifdef USE_XFT
+ byte1 = ((unsigned char *) (&ucs2))[0];
+ byte2 = ((unsigned char *) (&ucs2))[1];
+#else
+ byte1 = ((unsigned char *) (&ucs2))[1];
+ byte2 = ((unsigned char *) (&ucs2))[0];
+#endif /* USE_XFT */
}
#ifdef MULE
- if (need_ccl_conversion)
+ else if (need_ccl_conversion)
{
- char_converter.reg[0] = XCHARSET_ID (charset);
+ char_converter.reg[0] = charset_leading_byte;
char_converter.reg[1] = byte1;
char_converter.reg[2] = byte2;
ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING);
byte1 = char_converter.reg[1];
byte2 = char_converter.reg[2];
}
+ else if (graphic == 0)
+ {
+ byte1 &= 0x7F;
+ byte2 &= 0x7F;
+ }
+ else
+ {
+ byte1 |= 0x80;
+ byte2 |= 0x80;
+ }
#endif /* MULE */
- *text_storage++ = (unsigned char) byte1;
- /* This dimension stuff is broken if you want to use a two-dimensional
- X11 font to display a single-dimensional character set, as is
- appropriate for the IPA (use one of the -iso10646-1 fonts) or some
- of the other non-standard character sets. */
- if (dimension == 2)
- *text_storage++ = (unsigned char) byte2;
-#else /* USE_XFT */
- /* #### This is bogus as hell. XftChar16, aka FcChar16, is actually
- unsigned short, and therefore is not suitable for indexing matrix
- fonts such as the JIS fonts supplied with X11. But if this were
- consistent, the XftDraw*8 and XftDraw*16 functions are pretty
- incoherent, as then we not should allow anything but ISO 8859/1
- (ie, the first 256 code points of Unicode) in XftDraw*8. So it
- looks like this depends on the font, not the charset. */
- {
- XftChar16 xftchar16 = 0xFFFD; /* unsigned short */
-#ifndef MULE
- int unicode = ch;
-#else
- int unicode = ichar_to_unicode (ch);
- if (unicode < 0)
- /* abort(); */ /* #### serious error, tables are corrupt
- Unfortunately, not a valid assumption; this can happen with
- composite characters. Fake it. */
- unicode = 0xFFFD; /* REPLACEMENT CHARACTER, can't represent */
- else if (need_ccl_conversion)
- /* #### maybe we should just ignore this and hope the font wins? */
- unicode = 0xFFFD; /* REPLACEMENT CHARACTER, can't represent */
- else if (unicode > 65535)
- unicode = 0xFFFD; /* REPLACEMENT CHARACTER, can't represent */
- else
-#endif
- xftchar16 = (XftChar16) unicode;
- /* #### endianness dependency? No,
- apparently xft handles endianness for us;
- the "big-endian" code works on Intel and PPC */
-#if 1
- /* big-endian or auto-endian */
- byte1 = ((unsigned char *) (&xftchar16))[0];
- byte2 = ((unsigned char *) (&xftchar16))[1];
-#else
- /* little-endian */
- byte1 = ((unsigned char *) (&xftchar16))[1];
- byte2 = ((unsigned char *) (&xftchar16))[0];
-#endif
- }
- *text_storage++ = (unsigned char) byte1;
- *text_storage++ = (unsigned char) byte2;
-#endif /* USE_XFT */
+
+ *text_storage++ = (unsigned char)byte1;
+
+ /* dimension can be two in non-Mule if we're translating to
+ Unicode. */
+ if (2 == dimension) *text_storage++ = (unsigned char)byte2;
}
if (runs_so_far)
{
run_storage[runs_so_far - 1].len =
text_storage - run_storage[runs_so_far - 1].ptr;
- if (run_storage[runs_so_far - 1].dimension == 2)
+ /* Dimension retains the relevant value for the run before it. */
+ if (2 == dimension)
run_storage[runs_so_far - 1].len >>= 1;
}
＠＠ -361,7 +370,8 ＠＠
int nruns;
int i;
- nruns = separate_textual_runs (text_storage, runs, str, len);
+ nruns = separate_textual_runs (text_storage, runs, str, len,
+ cachel);
for (i = 0; i < nruns; i++)
width_so_far += x_text_width_single_run (f, cachel, runs + i);
＠＠ -1014,7 +1024,7 ＠＠
}
nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0),
- Dynarr_length (buf));
+ Dynarr_length (buf), cachel);
for (i = 0; i < nruns; i++)
{
Index: src/redisplay.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v
retrieving revision 1.100
diff -u -u -r1.100 redisplay.c
--- src/redisplay.c 2006/07/08 16:15:56 1.100
+++ src/redisplay.c 2006/11/04 22:11:59
＠＠ -760,7 +760,7 ＠＠
static int
space_width (struct window *w)
{
- /* While tabs are traditional composed of spaces, for variable-width
+ /* While tabs are traditionally composed of spaces, for variable-width
fonts the space character tends to give too narrow a value. So
we use 'n' instead. Except that we don't. We use the default
character width for the default face. If this is actually
Index: src/specifier.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v
retrieving revision 1.44
diff -u -u -r1.44 specifier.c
--- src/specifier.c 2006/02/27 16:29:28 1.44
+++ src/specifier.c 2006/11/04 22:12:00
＠＠ -47,6 +47,7 ＠＠
Lisp_Object Qconsole_type, Qdevice_class;
static Lisp_Object Vuser_defined_tags;
+static Lisp_Object Vcharset_tag_lists;
typedef struct specifier_type_entry specifier_type_entry;
struct specifier_type_entry
＠＠ -834,10 +835,10 ＠＠
DEFUN ("valid-specifier-tag-set-p", Fvalid_specifier_tag_set_p, 1, 1, 0, /*
Return non-nil if TAG-SET is a valid specifier tag set.
-A specifier tag set is an entity that is attached to an instantiator
-and can be used to restrict the scope of that instantiator to a
-particular device class or device type and/or to mark instantiators
-added by a particular package so that they can be later removed.
+A specifier tag set is an entity that is attached to an instantiator and can
+be used to restrict the scope of that instantiator to a particular device
+class, device type, or charset. It can also be used to mark instantiators
+added by a particular package so that they can be later removed as a group.
A specifier tag set consists of a list of zero of more specifier tags,
each of which is a symbol that is recognized by XEmacs as a tag.
＠＠ -846,13 +847,20 ＠＠
\(as opposed to a list) because the order of the tags or the number of
times a particular tag occurs does not matter.
-Each tag has a predicate associated with it, which specifies whether
-that tag applies to a particular device. The tags which are device types
-and classes match devices of that type or class. User-defined tags can
-have any predicate, or none (meaning that all devices match). When
-attempting to instantiate a specifier, a particular instantiator is only
-considered if the device of the domain being instantiated over matches
-all tags in the tag set attached to that instantiator.
+Each tag has two predicates associated with it, which specify, respectively,
+whether that tag applies to a particular device and whether it applies to a
+particular character set. The predefined tags which are device types and
+classes match devices of that type or class. User-defined tags can have any
+device predicate, or none (meaning that all devices match). When attempting
+to instantiate a specifier, a particular instantiator is only considered if
+the device of the domain being instantiated over matches all tags in the tag
+set attached to that instantiator.
+
+If a charset is to be considered--which is only the case for face
+instantiators--this consideration may be done twice. The first iteration
+pays attention to the character set predicates; if no instantiator can be
+found in that case, the search is repeated ignoring the character set
+predicates.
Most of the time, a tag set is not specified, and the instantiator
gets a null tag set, which matches all devices.
＠＠ -973,6 +981,63 ＠＠
return 1;
}
+static int
+charset_matches_specifier_tag_set_p (Lisp_Object charset,
+ Lisp_Object tag_set,
+ enum font_specifier_matchspec_stages
+ stage)
+{
+ Lisp_Object rest;
+ int res = 0;
+
+ assert(stage != impossible);
+
+ LIST_LOOP (rest, tag_set)
+ {
+ Lisp_Object tag = XCAR (rest);
+ Lisp_Object assoc;
+
+ /* This function will not ever be called with a charset for which the
+ relevant information hasn't been calculated (the information is
+ calculated with the creation of every charset). */
+ assert (!NILP(XVECTOR_DATA
+ (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset)
+ - MIN_LEADING_BYTE]));
+
+ /* Now, find out what the pre-calculated value is. */
+ assoc = assq_no_quit(tag,
+ XVECTOR_DATA(Vcharset_tag_lists)
+ [XCHARSET_LEADING_BYTE(charset)
+ - MIN_LEADING_BYTE]);
+
+ if (!(NILP(assoc)) && !(NILP(XCDR(assoc))))
+ {
+ assert(VECTORP(XCDR(assoc)));
+
+ /* In the event that a tag specifies a charset, then the specifier
+ must match for (this stage and this charset) for all
+ charset-specifying tags. */
+ if (NILP(XVECTOR_DATA(XCDR(assoc))[stage]))
+ {
+ /* It doesn't match for this tag, even though the tag
+ specifies a charset. Return 0. */
+ return 0;
+ }
+
+ /* This tag specifies charset limitations, and this charset and
+ stage match those charset limitations.
+
+ In the event that a later tag specifies charset limitations
+ that don't match, the return 0 above prevents us giving a
+ positive match. */
+ res = 1;
+ }
+ }
+
+ return res;
+}
+
+
DEFUN ("device-matches-specifier-tag-set-p",
Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /*
Return non-nil if DEVICE matches specifier tag set TAG-SET.
＠＠ -990,56 +1055,71 ＠＠
return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
}
-DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /*
-Define a new specifier tag.
-If PREDICATE is specified, it should be a function of one argument
-\(a device) that specifies whether the tag matches that particular
-device. If PREDICATE is omitted, the tag matches all devices.
-
-You can redefine an existing user-defined specifier tag. However,
-you cannot redefine the built-in specifier tags (the device types
-and classes) or the symbols nil, t, `all', or `global'.
-*/
- (tag, predicate))
+Lisp_Object
+define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate,
+ Lisp_Object charset_predicate)
{
- Lisp_Object assoc, devcons, concons;
- int recompute = 0;
+ Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags),
+ concons, devcons, charpres = Qnil;
+ int recompute_devices = 0, recompute_charsets = 0, i, max_args = -1;
- CHECK_SYMBOL (tag);
- if (valid_device_class_p (tag) ||
- valid_console_type_p (tag))
- invalid_change ("Cannot redefine built-in specifier tags", tag);
- /* Try to prevent common instantiators and locales from being
- redefined, to reduce ambiguity */
- if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
- invalid_change ("Cannot define nil, t, `all', or `global'", tag);
- assoc = assq_no_quit (tag, Vuser_defined_tags);
if (NILP (assoc))
{
- recompute = 1;
- Vuser_defined_tags = Fcons (Fcons (tag, predicate), Vuser_defined_tags);
+ recompute_devices = recompute_charsets = 1;
+ Vuser_defined_tags = Fcons (list3 (tag, device_predicate,
+ charset_predicate),
+ Vuser_defined_tags);
DEVICE_LOOP_NO_BREAK (devcons, concons)
{
struct device *d = XDEVICE (XCAR (devcons));
/* Initially set the value to t in case of error
- in predicate */
+ in device_predicate */
DEVICE_USER_DEFINED_TAGS (d) =
Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d));
}
+
+ if (!NILP (charset_predicate))
+ {
+ max_args = XINT(Ffunction_max_args(charset_predicate));
+ if (max_args < 1)
+ {
+ invalid_argument
+ ("Charset predicate must be able to take an argument", tag);
+ }
+ }
}
- else if (!NILP (predicate) && !NILP (XCDR (assoc)))
+ else if (!NILP (device_predicate) && !NILP (XCADR (assoc)))
{
- recompute = 1;
- XCDR (assoc) = predicate;
+ recompute_devices = 1;
+ XCDR (assoc) = list2(device_predicate, charset_predicate);
+ }
+ else if (!NILP (charset_predicate) || !NILP(XCADDR (assoc)))
+ {
+ max_args = XINT(Ffunction_max_args(charset_predicate));
+ if (max_args < 1)
+ {
+ invalid_argument
+ ("Charset predicate must be able to take an argument", tag);
+ }
+
+ /* If there exists a charset_predicate for the tag currently (even if
+ the new charset_predicate is nil), or if we're adding one, we need
+ to recompute. This contrasts with the device predicates, where we
+ don't need to recompute if the old and new device predicates are
+ both nil. */
+
+ recompute_charsets = 1;
+ XCDR (assoc) = list2(device_predicate, charset_predicate);
}
- /* recompute the tag values for all devices. However, in the special
- case where both the old and new predicates are nil, we know that
- we don't have to do this. (It's probably common for people to
- call (define-specifier-tag) more than once on the same tag,
- and the most common case is where PREDICATE is not specified.) */
+ /* Recompute the tag values for all devices and charsets, if necessary. In
+ the special case where both the old and new device_predicates are nil,
+ we know that we don't have to do it for the device. (It's probably
+ common for people to call (define-specifier-tag) more than once on the
+ same tag, and the most common case is where DEVICE_PREDICATE is not
+ specified.) */
- if (recompute)
+ if (recompute_devices)
{
DEVICE_LOOP_NO_BREAK (devcons, concons)
{
＠＠ -1047,14 +1127,156 ＠＠
assoc = assq_no_quit (tag,
DEVICE_USER_DEFINED_TAGS (XDEVICE (device)));
assert (CONSP (assoc));
- if (NILP (predicate))
+ if (NILP (device_predicate))
XCDR (assoc) = Qt;
else
- XCDR (assoc) = !NILP (call1 (predicate, device)) ? Qt : Qnil;
+ XCDR (assoc) = !NILP (call1 (device_predicate, device)) ? Qt
+ : Qnil;
}
}
- return Qnil;
+ if (recompute_charsets)
+ {
+ if (NILP(charset_predicate))
+ {
+ charpres = Qnil;
+ }
+
+ for (i = 0; i < NUM_LEADING_BYTES; ++i)
+ {
+ if (NILP(charset_by_leading_byte(MIN_LEADING_BYTE + i)))
+ {
+ continue;
+ }
+
+ assoc = assq_no_quit (tag,
+ XVECTOR_DATA(Vcharset_tag_lists)[i]);
+
+ if (!NILP(charset_predicate))
+ {
+ static int line_1147_calls;
+ ++line_1147_calls;
+ charpres = make_vector(impossible, Qnil);
+
+ /* If you want to extend the number of stages available, here
+ in setup_charset_initial_specifier_tags, and in specifier.h
+ is where you want to go. */
+
+#define DEFINE_SPECIFIER_TAG_FROB(stage) do { \
+ if (max_args > 1) \
+ { \
+ XVECTOR_DATA(charpres)[stage] = \
+ call2_trapping_problems \
+ ("Error during specifier tag charset predicate," \
+ " stage " #stage, charset_predicate, \
+ charset_by_leading_byte(MIN_LEADING_BYTE + i), \
+ Q##stage, 0); \
+ } \
+ else \
+ { \
+ XVECTOR_DATA(charpres)[stage] = \
+ call1_trapping_problems \
+ ("Error during specifier tag charset predicate," \
+ " stage " #stage, charset_predicate, \
+ charset_by_leading_byte(MIN_LEADING_BYTE + i), \
+ 0); \
+ } \
+ \
+ if (UNBOUNDP(XVECTOR_DATA(charpres)[stage])) \
+ { \
+ XVECTOR_DATA(charpres)[stage] = Qnil; \
+ } \
+ else if (!NILP(XVECTOR_DATA(charpres)[stage])) \
+ { \
+ /* Don't want refs to random other objects. */ \
+ XVECTOR_DATA(charpres)[stage] = Qt; \
+ } \
+ } while (0)
+
+ DEFINE_SPECIFIER_TAG_FROB (initial);
+ DEFINE_SPECIFIER_TAG_FROB (final);
+
+#undef DEFINE_SPECIFIER_TAG_FROB
+
+ }
+
+ if (!NILP(assoc))
+ {
+ assert(CONSP(assoc));
+ XCDR (assoc) = charpres;
+ }
+ else
+ {
+ XVECTOR_DATA(Vcharset_tag_lists)[i]
+ = Fcons(Fcons(tag, charpres),
+ XVECTOR_DATA (Vcharset_tag_lists)[i]);
+ }
+ }
+ }
+ return Qt;
+}
+
+DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 3, 0, /*
+Define a new specifier tag.
+
+If DEVICE-PREDICATE is specified, it should be a function of one argument
+\(a device) that specifies whether the tag matches that particular device.
+If DEVICE-PREDICATE is omitted, the tag matches all devices.
+
+If CHARSET-PREDICATE is supplied, it should be a function taking a single
+Lisp character set argument. A tag's charset predicate is primarily used to
+determine what font to use for a given \(set of) charset\(s) when that tag
+is used in a set-face-font call; a non-nil return value indicates that the
+tag matches the charset.
+
+The font matching process also has a concept of stages; the defined stages
+are currently `initial' and `final', and there exist specifier tags
+with those names that correspond to those stages. On X11, 'initial is used
+when the font matching process is looking for fonts that match the desired
+registries of the charset--see the `charset-registries' function. If that
+match process fails, then the 'final tag becomes relevant; this means that a
+more general lookup is desired, and that a font doesn't necessarily have to
+match the desired XLFD for the face, just the charset repertoire for this
+charset. It also means that the charset registry and encoding used will be
+`iso10646-1', and the characters will be converted to display using that
+registry.
+
+If a tag set matches no character set; the two-stage match process will
+ignore the tag on its first pass, but if no match is found, it will respect
+it on the second pass, where character set information is ignored.
+
+You can redefine an existing user-defined specifier tag. However, you cannot
+redefine most of the built-in specifier tags \(the device types and classes,
+`initial', and `final') or the symbols nil, t, `all', or `global'. Note that
+if a device type is not supported in this XEmacs, it will not be available
+as a built-in specifier tag; this is probably something we should change.
+*/
+ (tag, device_predicate, charset_predicate))
+{
+ int max_args;
+
+ CHECK_SYMBOL (tag);
+ if (valid_device_class_p (tag) ||
+ valid_console_type_p (tag) ||
+ EQ (tag, Qinitial) || EQ (tag, Qfinal))
+ invalid_change ("Cannot redefine built-in specifier tags", tag);
+ /* Try to prevent common instantiators and locales from being
+ redefined, to reduce ambiguity */
+ if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
+ invalid_change ("Cannot define nil, t, `all', or `global'", tag);
+
+ if (!NILP (charset_predicate))
+ {
+ max_args = XINT(Ffunction_max_args(charset_predicate));
+ if (max_args != 1)
+ {
+ /* We only allow the stage argument to be specifed from C. */
+ invalid_change ("Charset predicate must take one argument",
+ tag);
+ }
+ }
+
+ return define_specifier_tag(tag, device_predicate, charset_predicate);
}
/* Called at device-creation time to initialize the user-defined
＠＠ -1065,6 +1287,8 ＠＠
{
Lisp_Object rest, rest2;
Lisp_Object device = wrap_device (d);
+ Lisp_Object device_predicate, charset_predicate;
+ int list_len;
DEVICE_USER_DEFINED_TAGS (d) = Fcopy_alist (Vuser_defined_tags);
＠＠ -1075,15 +1299,83 ＠＠
for (rest = Vuser_defined_tags, rest2 = DEVICE_USER_DEFINED_TAGS (d);
!NILP (rest); rest = XCDR (rest), rest2 = XCDR (rest2))
{
- Lisp_Object predicate = XCDR (XCAR (rest));
- if (NILP (predicate))
- XCDR (XCAR (rest2)) = Qt;
+ GET_LIST_LENGTH(XCAR(rest), list_len);
+
+ assert(3 == list_len);
+
+ device_predicate = XCADR(XCAR (rest));
+ charset_predicate = XCADDR(XCAR (rest));
+
+ if (NILP (device_predicate))
+ {
+ XCDR (XCAR (rest2)) = list2(Qt, charset_predicate);
+ }
else
- XCDR (XCAR (rest2)) =
- !NILP (call_critical_lisp_code (d, predicate, device)) ? Qt : Qnil;
+ {
+ device_predicate = !NILP (call_critical_lisp_code
+ (d, device_predicate, device))
+ ? Qt : Qnil;
+ XCDR (XCAR (rest2)) = list2(device_predicate, charset_predicate);
+ }
+ }
+}
+
+void
+setup_charset_initial_specifier_tags (Lisp_Object charset)
+{
+ Lisp_Object rest, charset_predicate, tag, new_value;
+ Lisp_Object charset_tag_list = Qnil;
+
+ LIST_LOOP (rest, Vuser_defined_tags)
+ {
+ tag = XCAR(XCAR(rest));
+ charset_predicate = XCADDR(XCAR (rest));
+
+ if (NILP(charset_predicate))
+ {
+ continue;
+ }
+
+ new_value = make_vector(impossible, Qnil);
+
+#define SETUP_CHARSET_TAGS_FROB(stage) do { \
+ \
+ XVECTOR_DATA(new_value)[stage] = call2_trapping_problems \
+ ("Error during specifier tag charset predicate," \
+ " stage " #stage, \
+ charset_predicate, charset, Q##stage, 0); \
+ \
+ if (UNBOUNDP(XVECTOR_DATA(new_value)[stage])) \
+ { \
+ XVECTOR_DATA(new_value)[stage] = Qnil; \
+ } \
+ else if (!NILP(XVECTOR_DATA(new_value)[stage])) \
+ { \
+ /* Don't want random other objects hanging around. */ \
+ XVECTOR_DATA(new_value)[stage] = Qt; \
+ } \
+ \
+ } while (0)
+
+ SETUP_CHARSET_TAGS_FROB (initial);
+ SETUP_CHARSET_TAGS_FROB (final);
+ /* More later? */
+
+#undef SETUP_CHARSET_TAGS_FROB
+
+ charset_tag_list = Fcons(Fcons(tag, new_value), charset_tag_list);
}
+
+ XVECTOR_DATA
+ (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) - MIN_LEADING_BYTE]
+ = charset_tag_list;
}
+#ifdef DEBUG_XEMACS
+
+/* Nothing's calling this, I see no reason to keep it in the production
+ builds. */
+
DEFUN ("device-matching-specifier-tag-list",
Fdevice_matching_specifier_tag_list,
0, 1, 0, /*
＠＠ -1100,7 +1392,7 ＠＠
LIST_LOOP (rest, DEVICE_USER_DEFINED_TAGS (d))
{
- if (!NILP (XCDR (XCAR (rest))))
+ if (!NILP (XCADR (XCAR (rest))))
list = Fcons (XCAR (XCAR (rest)), list);
}
＠＠ -1111,6 +1403,8 ＠＠
RETURN_UNGCPRO (list);
}
+#endif /* DEBUG_XEMACS */
+
DEFUN ("specifier-tag-list", Fspecifier_tag_list, 0, 0, 0, /*
Return a list of all currently-defined specifier tags.
This includes the built-in ones (the device types and classes).
＠＠ -1132,8 +1426,9 ＠＠
RETURN_UNGCPRO (list);
}
-DEFUN ("specifier-tag-predicate", Fspecifier_tag_predicate, 1, 1, 0, /*
-Return the predicate for the given specifier tag.
+DEFUN ("specifier-tag-device-predicate", Fspecifier_tag_device_predicate,
+ 1, 1, 0, /*
+Return the device predicate for the given specifier tag.
*/
(tag))
{
＠＠ -1156,9 +1451,25 ＠＠
list3 (Qeq, list2 (Qquote, tag),
list2 (Qdevice_class, Qdevice)));
- return XCDR (assq_no_quit (tag, Vuser_defined_tags));
+ return XCADR (assq_no_quit (tag, Vuser_defined_tags));
}
+DEFUN ("specifier-tag-charset-predicate", Fspecifier_tag_charset_predicate,
+ 1, 1, 0, /*
+Return the charset predicate for the given specifier tag.
+*/
+ (tag))
+{
+ /* The return value of this function must be GCPRO'd. */
+ CHECK_SYMBOL (tag);
+
+ if (NILP (Fvalid_specifier_tag_p (tag)))
+ invalid_argument ("Invalid specifier tag",
+ tag);
+
+ return XCADDR (assq_no_quit (tag, Vuser_defined_tags));
+}
+
/* Return true if A "matches" B. If EXACT_P is 0, A must be a subset of B.
Otherwise, A must be `equal' to B. The sets must be canonicalized. */
static int
＠＠ -2496,10 +2807,13 ＠＠
{
/* This function can GC */
Lisp_Specifier *sp;
- Lisp_Object device;
- Lisp_Object rest;
- int count = specpdl_depth ();
+ Lisp_Object device, charset = Qnil, rest;
+ int count = specpdl_depth (), respected_charsets = 0;
struct gcpro gcpro1, gcpro2;
+ enum font_specifier_matchspec_stages stage = initial;
+#ifdef DEBUG_XEMACS
+ int non_ascii;
+#endif
GCPRO2 (specifier, inst_list);
＠＠ -2513,31 +2827,119 ＠＠
Fsignal will abort. */
specbind (Qinhibit_quit, Qt);
+#ifdef MULE
+ if (CONSP(matchspec) && (CHARSETP(XCAR(matchspec))))
+ {
+ charset = Ffind_charset(XCAR(matchspec));
+
+#ifdef DEBUG_XEMACS
+ /* This is mostly to have somewhere to set debug breakpoints. */
+ if (!EQ(charset, Vcharset_ascii))
+ {
+ non_ascii = 1;
+ }
+#endif /* DEBUG_XEMACS */
+
+ if (!NILP(XCDR(matchspec)))
+ {
+
+#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \
+ { \
+ stage = new_stage; \
+ }
+
+ FROB(initial)
+ else FROB(final)
+ else assert(0);
+#undef FROB
+
+ }
+ }
+#endif /* MULE */
+
+ LIST_LOOP(rest, inst_list)
+ {
+ Lisp_Object tagged_inst = XCAR (rest);
+ Lisp_Object tag_set = XCAR (tagged_inst);
+ Lisp_Object val, the_instantiator;
+
+ if (!device_matches_specifier_tag_set_p (device, tag_set))
+ {
+ continue;
+ }
+
+ val = XCDR (tagged_inst);
+ the_instantiator = val;
+
+ if (!NILP(charset) &&
+ !(charset_matches_specifier_tag_set_p (charset, tag_set, stage)))
+ {
+ ++respected_charsets;
+ continue;
+ }
+
+ if (HAS_SPECMETH_P (sp, instantiate))
+ val = call_with_suspended_errors
+ ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
+ Qunbound, Qspecifier, errb, 5, specifier,
+ matchspec, domain, val, depth);
+
+ if (!UNBOUNDP (val))
+ {
+ unbind_to (count);
+ UNGCPRO;
+ if (instantiator)
+ *instantiator = the_instantiator;
+ return val;
+ }
+ }
+
+ /* We've checked all the tag sets, and checking the charset part of the
+ specifier never returned 0 (preventing the attempted instantiation), so
+ there's no need to loop for the second time to avoid checking the
+ charsets. */
+ if (!respected_charsets)
+ {
+ unbind_to (count);
+ UNGCPRO;
+ return Qunbound;
+ }
+
+ /* Right, didn't instantiate a specifier last time, perhaps because we
+ paid attention to the charset-specific aspects of the specifier. Try
+ again without checking the charset information.
+
+ We can't emulate the approach for devices, defaulting to matching all
+ character sets for a given specifier, because $random font instantiator
+ cannot usefully show all character sets, and indeed having it try is a
+ failure on our part. */
LIST_LOOP (rest, inst_list)
{
Lisp_Object tagged_inst = XCAR (rest);
Lisp_Object tag_set = XCAR (tagged_inst);
+ Lisp_Object val, the_instantiator;
- if (device_matches_specifier_tag_set_p (device, tag_set))
+ if (!device_matches_specifier_tag_set_p (device, tag_set))
{
- Lisp_Object val = XCDR (tagged_inst);
- Lisp_Object the_instantiator = val;
+ continue;
+ }
+ val = XCDR (tagged_inst);
+ the_instantiator = val;
- if (HAS_SPECMETH_P (sp, instantiate))
- val = call_with_suspended_errors
- ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
- Qunbound, Qspecifier, errb, 5, specifier,
- matchspec, domain, val, depth);
+ if (HAS_SPECMETH_P (sp, instantiate))
+ val = call_with_suspended_errors
+ ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
+ Qunbound, Qspecifier, errb, 5, specifier,
+ matchspec, domain, val, depth);
- if (!UNBOUNDP (val))
- {
- unbind_to (count);
- UNGCPRO;
- if (instantiator)
- *instantiator = the_instantiator;
- return val;
- }
+ if (!UNBOUNDP (val))
+ {
+ unbind_to (count);
+ UNGCPRO;
+ if (instantiator)
+ *instantiator = the_instantiator;
+ return val;
}
}
＠＠ -3408,7 +3810,8 ＠＠
DEFSUBR (Fdefine_specifier_tag);
DEFSUBR (Fdevice_matching_specifier_tag_list);
DEFSUBR (Fspecifier_tag_list);
- DEFSUBR (Fspecifier_tag_predicate);
+ DEFSUBR (Fspecifier_tag_device_predicate);
+ DEFSUBR (Fspecifier_tag_charset_predicate);
DEFSUBR (Fcheck_valid_instantiator);
DEFSUBR (Fvalid_instantiator_p);
＠＠ -3509,4 +3912,7 ＠＠
Vunlock_ghost_specifiers = Qnil;
staticpro (&Vunlock_ghost_specifiers);
+
+ Vcharset_tag_lists = make_vector(NUM_LEADING_BYTES, Qnil);
+ staticpro (&Vcharset_tag_lists);
}
Index: src/specifier.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.h,v
retrieving revision 1.19
diff -u -u -r1.19 specifier.h
--- src/specifier.h 2005/11/25 01:42:06 1.19
+++ src/specifier.h 2006/11/04 22:12:00
＠＠ -535,6 +535,7 ＠＠
void cleanup_specifiers (void);
void prune_specifiers (void);
void setup_device_initial_specifier_tags (struct device *d);
+void setup_charset_initial_specifier_tags (Lisp_Object charset);
void kill_specifier_buffer_locals (Lisp_Object buffer);
DECLARE_SPECIFIER_TYPE (generic);
＠＠ -566,5 +567,19 ＠＠
#define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table)
#define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table)
#define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table)
+
+/* The various stages of font instantiation; initial means "find a font for
+ CHARSET that matches the charset's registries" and final means "find a
+ font for CHARSET that matches iso10646-1, since we haven't found a font
+ that matches its registry." */
+enum font_specifier_matchspec_stages {
+ initial,
+ final,
+ impossible,
+};
+
+Lisp_Object define_specifier_tag(Lisp_Object tag,
+ Lisp_Object device_predicate,
+ Lisp_Object charset_predicate);
#endif /* INCLUDED_specifier_h_ */
Index: src/unicode.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/unicode.c,v
retrieving revision 1.34
diff -u -u -r1.34 unicode.c
--- src/unicode.c 2006/06/14 06:10:10 1.34
+++ src/unicode.c 2006/11/04 22:12:01
＠＠ -1115,9 +1115,8 ＠＠
Ibyte setname[32];
Lisp_Object charset_descr = build_string
("Mule charset for otherwise unknown Unicode code points.");
- Lisp_Object charset_regr = build_string("iso10646-1");
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1;
if ('\0' == last_jit_charset_final)
{
＠＠ -1138,7 +1137,7 ＠＠
Lisp reader. We GCPRO in case it GCs in the future and no-one
checks all the C callers. */
- GCPRO2 (charset_descr, charset_regr);
+ GCPRO1 (charset_descr);
Vcurrent_jit_charset = Fmake_charset
(intern((const CIbyte *)setname), charset_descr,
/* Set encode-as-utf-8 to t, to have this character set written
＠＠ -1148,7 +1147,7 ＠＠
nconc2 (list2(Qencode_as_utf_8, Qt),
nconc2 (list6(Qcolumns, make_int(1), Qchars, make_int(96),
Qdimension, make_int(2)),
- list6(Qregistry, charset_regr,
+ list6(Qregistries, Qunicode_registries,
Qfinal, make_char(last_jit_charset_final++),
/* This CCL program is initialised in
unicode.el. */
＠＠ -2539,6 +2538,8 ＠＠
DEFSYMBOL (Qccl_encode_to_ucs_2);
DEFSYMBOL (Qlast_allocated_character);
DEFSYMBOL (Qignore_first_column);
+
+ DEFSYMBOL (Qunicode_registries);
#endif /* MULE */
DEFSUBR (Fchar_to_unicode);
＠＠ -2611,6 +2612,8 ＠＠
dump_add_root_block_ptr (&unicode_precedence_dynarr,
&lisp_object_dynarr_description);
+
+
init_blank_unicode_tables ();
staticpro (&Vcurrent_jit_charset);
＠＠ -2636,5 +2639,16 ＠＠
from_unicode_level_3_desc_1);
dump_add_root_block (&from_unicode_blank_4, sizeof (void *),
from_unicode_level_4_desc_1);
+
+ DEFVAR_LISP ("unicode-registries", &Qunicode_registries /*
+Vector describing the X11 registries searched when using fallback fonts.
+
+"Fallback fonts" here includes by default those fonts used by redisplay when
+displaying charsets for which the `encode-as-utf-8' property is true, and
+those used when no font matching the charset's registries property has been
+found (that is, they're probably Mule-specific charsets like Ethiopic or
+IPA.)
+*/ );
+ Qunicode_registries = vector1(build_string("iso10646-1"));
#endif /* MULE */
}
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 4 comments
Re: [PATCH] (Draft2) Make X11 server-side fonts and Mule suck less.
17 years, 5 months
Stephen J. Turnbull
Stephen J. Turnbull
Aidan Kehoe writes:
> No, GNU use fontsets and their Mule charsets have no registry
> property.
*X* Font Sets? eeeeeeeeewwwwwww! Tell me it ain't so!
> My first inclination was to throw out the old way entirely, since it
> involves much use of our under-performing regex engine at redisplay,
And you think much round-tripping to the server is a better idea in
the midst of redisplay? ;-) Neither is acceptable. If regex is
actually being called from redisplay, we should fix that.
> [CCL #defines] makes code in redisplay-x.c more readable (less
> #ifdef MULE happening) without impacting its performance.
Ah, right, this is all internal anyway.
> > > * console-impl.h:
> > > * console-impl.h (struct console_methods):
> > > Rename the last parameter to a couple of methods; reformat their
> > > declarations.
> >
> > The above will cause some annoyance to CHISE, Carbon XEmacs, and
> > possibly SXEmacs someday. Is it a good idea?
>
> Yes; it moves the last parameter to being an enum with descriptive possible
> values, rather than just an integer.
Well, yes, but is it such a good idea that we should make work for
others? That's one of my pet peeves with GNU.
> > Can the rest of these be split out? I want them!
>
> I want the whole thing in! :-) .
Yeah, well, you're likely to get more of it faster if it comes in
bite-size pieces most of which have no question-able (note the
hyphen!) hunks.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 3 comments
[PATCH] (Draft2) Make X11 server-side fonts and Mule suck less.
17 years, 5 months
Aidan Kehoe
Aidan Kehoe
Andrey, this is the patch I mentioned that will make GHE WITH UPTURN display
properly on X11. There remains more work to be done on it than I thought :-(
SUPERSEDES 17622.10738.650649.122673(a)parhasard.net
Remaining to do as listed in that message:
[...]
3. Mechanical copying of the X11-specific code to the GTK port; perhaps a
move to something like event-xlike-inc.c
[...]
Also the XFT heuristics, but I’ll do that separately if I do it at all.
Apart from that, I need to look into some odd behaviour that happens when
non-ASCII text is selected
lisp/ChangeLog addition:
2006-10-31 Aidan Kehoe <kehoea(a)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.
* mule/mule-charset.el (set-charset-registry): New.
charset-registries returns the registries of a charset;
2006-10-31 Aidan Kehoe <kehoea(a)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.
* 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.
src/ChangeLog addition:
2006-10-31 Aidan Kehoe <kehoea(a)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.
* objects-x.c:
Provide a DEBUG_OBJECTS macro; use it to make debugging output
available in debug builds.
* objects-x.c (count_hyphens):
New. How many ASCII minus characters in a string?
* objects-x.c (x_initialize_font_instance):
* objects-x.c (x_print_font_instance):
* objects-x.c (x_font_spec_matches_charset):
* objects-x.c (xlistfonts_checking_charset):
* objects-x.c (x_find_charset_font):
* 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.
* 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.
* 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.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: src/unicode.c src/specifier.h src/specifier.c src/redisplay.c src/redisplay-x.c src/objects.h src/objects.c src/objects-x.c src/objects-tty.c src/objects-msw.c src/objects-gtk.c src/mule-charset.c src/lisp.h src/intl.c src/general-slots.h src/font-mgr.h src/fileio.c src/faces.h src/faces.c src/console-impl.h src/charset.h lisp/mule/vietnamese.el lisp/mule/tibetan.el lisp/mule/thai-xtis.el lisp/mule/mule-charset.el lisp/mule/misc-lang.el lisp/mule/lao.el lisp/mule/japanese.el lisp/mule/indian.el lisp/mule/european.el lisp/mule/ethiopic.el lisp/mule/english.el lisp/mule/chinese.el lisp/mule/arabic.el lisp/x-font-menu.el lisp/x-faces.el lisp/unicode.el lisp/faces.el
Index: lisp/faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v
retrieving revision 1.38
diff -u -u -r1.38 faces.el
--- lisp/faces.el 2006/04/25 14:01:52 1.38
+++ lisp/faces.el 2006/10/31 22:06:50
＠＠ -250,19 +250,9 ＠＠
(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 ＠＠
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"))
Index: lisp/unicode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/unicode.el,v
retrieving revision 1.14
diff -u -u -r1.14 unicode.el
--- lisp/unicode.el 2006/07/13 20:45:49 1.14
+++ lisp/unicode.el 2006/10/31 22:06:56
＠＠ -29,54 +29,6 ＠＠
;;; Code:
-; ;; Subsets of Unicode.
-
-; #### 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)"
-; ))
-
-
;; 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,14 +257,14 ＠＠
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. ")
＠＠ -343,12 +295,6 ＠＠
"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
Index: lisp/x-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v
retrieving revision 1.25
diff -u -u -r1.25 x-faces.el
--- lisp/x-faces.el 2006/04/25 14:01:54 1.25
+++ lisp/x-faces.el 2006/10/31 22:06:57
＠＠ -782,7 +782,27 ＠＠
;; 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 encode-as-utf-8 final)
+ (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 (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.
Index: lisp/x-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v
retrieving revision 1.17
diff -u -u -r1.17 x-font-menu.el
--- lisp/x-font-menu.el 2006/05/11 14:57:05 1.17
+++ lisp/x-font-menu.el 2006/10/31 22:06:57
＠＠ -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 ＠＠
;; #### - 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)
Index: lisp/mule/arabic.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/arabic.el,v
retrieving revision 1.7
diff -u -u -r1.7 arabic.el
--- lisp/mule/arabic.el 2002/03/16 10:39:05 1.7
+++ lisp/mule/arabic.el 2006/10/31 22:06:57
＠＠ -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
Index: lisp/mule/chinese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/chinese.el,v
retrieving revision 1.12
diff -u -u -r1.12 chinese.el
--- lisp/mule/chinese.el 2005/12/24 22:31:51 1.12
+++ lisp/mule/chinese.el 2006/10/31 22:06:58
＠＠ -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
Index: lisp/mule/english.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/english.el,v
retrieving revision 1.6
diff -u -u -r1.6 english.el
--- lisp/mule/english.el 2002/03/29 04:46:41 1.6
+++ lisp/mule/english.el 2006/10/31 22:06:58
＠＠ -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
Index: lisp/mule/ethiopic.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/ethiopic.el,v
retrieving revision 1.6
diff -u -u -r1.6 ethiopic.el
--- lisp/mule/ethiopic.el 2002/03/16 10:39:06 1.6
+++ lisp/mule/ethiopic.el 2006/10/31 22:06:58
＠＠ -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
Index: lisp/mule/european.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/european.el,v
retrieving revision 1.12
diff -u -u -r1.12 european.el
--- lisp/mule/european.el 2005/05/10 17:02:59 1.12
+++ lisp/mule/european.el 2006/10/31 22:06:58
＠＠ -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
Index: lisp/mule/indian.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/indian.el,v
retrieving revision 1.3
diff -u -u -r1.3 indian.el
--- lisp/mule/indian.el 2002/03/16 10:39:06 1.3
+++ lisp/mule/indian.el 2006/10/31 22:06:58
＠＠ -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
Index: lisp/mule/japanese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/japanese.el,v
retrieving revision 1.11
diff -u -u -r1.11 japanese.el
--- lisp/mule/japanese.el 2004/01/29 05:22:40 1.11
+++ lisp/mule/japanese.el 2006/10/31 22:06:58
＠＠ -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
＠＠ -130,6 +60,28 ＠＠
long-name "JISX0213-2"
))
+(when nil
+
+(when (and (memq 'x (device-type-list)) (not (featurep 'xft)))
+ ;; X11 fonts; these are available in XFree86 4.0.
+ (loop
+ for (character-set default-font) in
+ '((japanese-jisx0208
+ "-jis-fixed-medium-r-normal--16-150-75-75-c-160-jisx0208.1983-0"))
+ do
+ (define-specifier-tag character-set nil
+ (list 'lambda '(charset stage)
+ (list 'eq 'charset
+ (list 'find-charset (list 'quote character-set)))))
+ (set-face-font 'default default-font 'global
+ (list 'x character-set) 'append)))
+
+;; japanese-jisx0213-1
+;;japanese-jisx0213-2
+;; katakana-jisx0201
+;; latin-jisx0201
+
+)
;;; Syntax of Japanese characters.
(modify-syntax-entry 'katakana-jisx0201 "w")
(modify-syntax-entry 'japanese-jisx0212 "w")
Index: lisp/mule/lao.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/lao.el,v
retrieving revision 1.4
diff -u -u -r1.4 lao.el
--- lisp/mule/lao.el 2002/03/18 10:07:37 1.4
+++ lisp/mule/lao.el 2006/10/31 22:06:58
＠＠ -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
Index: lisp/mule/misc-lang.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/misc-lang.el,v
retrieving revision 1.5
diff -u -u -r1.5 misc-lang.el
--- lisp/mule/misc-lang.el 2002/03/16 10:39:07 1.5
+++ lisp/mule/misc-lang.el 2006/10/31 22:06:58
＠＠ -34,7 +34,7 ＠＠
(make-charset 'ipa "IPA (International Phonetic Association)"
'(dimension
1
- registry "MuleIPA"
+ registries ["MuleIPA"]
chars 96
columns 1
direction l2r
Index: lisp/mule/mule-charset.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-charset.el,v
retrieving revision 1.18
diff -u -u -r1.18 mule-charset.el
--- lisp/mule/mule-charset.el 2005/12/23 11:42:35 1.18
+++ lisp/mule/mule-charset.el 2006/10/31 22:06:58
＠＠ -106,12 +106,31 ＠＠
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.
Index: lisp/mule/thai-xtis.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/thai-xtis.el,v
retrieving revision 1.4
diff -u -u -r1.4 thai-xtis.el
--- lisp/mule/thai-xtis.el 2002/03/18 10:07:37 1.4
+++ lisp/mule/thai-xtis.el 2006/10/31 22:06:58
＠＠ -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)
Index: lisp/mule/tibetan.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/tibetan.el,v
retrieving revision 1.3
diff -u -u -r1.3 tibetan.el
--- lisp/mule/tibetan.el 2002/03/16 10:39:07 1.3
+++ lisp/mule/tibetan.el 2006/10/31 22:06:59
＠＠ -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
Index: lisp/mule/vietnamese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/vietnamese.el,v
retrieving revision 1.6
diff -u -u -r1.6 vietnamese.el
--- lisp/mule/vietnamese.el 2002/03/21 07:30:24 1.6
+++ lisp/mule/vietnamese.el 2006/10/31 22:06:59
＠＠ -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
Index: src/charset.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/charset.h,v
retrieving revision 1.14
diff -u -u -r1.14 charset.h
--- src/charset.h 2006/07/07 23:01:11 1.14
+++ src/charset.h 2006/10/31 22:06:59
＠＠ -58,6 +58,8 ＠＠
(byte1) = (ch); \
(byte2) = 0; \
} while (0)
+#define XCHARSET_CCL_PROGRAM(cs) Qnil
+#define XCHARSET_NAME(cs) Qascii
#else /* MULE */
＠＠ -186,7 +188,7 ＠＠
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 ＠＠
#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 ＠＠
#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 ＠＠
#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))
Index: src/console-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v
retrieving revision 1.12
diff -u -u -r1.12 console-impl.h
--- src/console-impl.h 2005/10/24 10:07:34 1.12
+++ src/console-impl.h 2006/10/31 22:07:00
＠＠ -26,6 +26,7 ＠＠
#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 ＠＠
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 *);
Index: src/faces.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v
retrieving revision 1.49
diff -u -u -r1.49 faces.c
--- src/faces.c 2005/11/26 11:46:08 1.49
+++ src/faces.c 2006/10/31 22:07:02
＠＠ -72,6 +72,31 ＠＠
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 ＠＠
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 ＠＠
(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 ＠＠
{
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 ＠＠
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,15 ＠＠
/* 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);
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 +1127,108 ＠＠
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;
}
＠＠ -1399,10 +1490,12 ＠＠
{
int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
- if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[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]);
- cachel->font_specified[offs] = 1;
+ set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1);
cachel->dirty = 1;
}
}
＠＠ -1433,6 +1526,8 ＠＠
}
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 +1600,10 ＠＠
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 +1990,81 ＠＠
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 +2086,17 ＠＠
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 +2160,13 ＠＠
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 +2233,12 ＠＠
#if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK)
+#ifdef HAVE_GTK
+ Lisp_Object device_symbol = Qgtk;
+#else
+ Lisp_Object device_symbol = Qx;
+#endif
+
const Ascbyte *fonts[] =
{
#ifdef USE_XFT
＠＠ -2053,165 +2246,122 ＠＠
/* 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", Qnil, /* Western #### add encoding info? */
/* 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", Vcharset_katakana_jisx0201,
+ /* 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(a)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"));
+
+ inst_list =
+ Fcons
+ (Fcons
+ (list1 (device_symbol),
+ build_string ("*")),
+ inst_list);
+
+ /* 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);
+
+ /* 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
Index: src/faces.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.h,v
retrieving revision 1.17
diff -u -u -r1.17 faces.h
--- src/faces.h 2006/02/27 16:29:25 1.17
+++ src/faces.h 2006/10/31 22:07:02
＠＠ -25,6 +25,7 ＠＠
#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 ＠＠
/* 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 ＠＠
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 ＠＠
#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 ＠＠
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 ＠＠
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) \
Index: src/fileio.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fileio.c,v
retrieving revision 1.105
diff -u -u -r1.105 fileio.c
--- src/fileio.c 2006/06/19 18:19:37 1.105
+++ src/fileio.c 2006/10/31 22:07:04
＠＠ -2948,6 +2948,13 ＠＠
reasonable maximum file size on the files. Is any of this worth it?
--ben
+
+ It's probably not worth it, and despite what you might take from the
+ above, we don't do it currently; that is, for non-"binary" coding
+ systems, we don't try to implement replace-mode at all. See the
+ do_speedy_insert variable above. The upside of this is that our API
+ is consistent and not buggy. -- Aidan Kehoe, Fri Oct 27 21:02:30 CEST
+ 2006
*/
if (!NILP (replace))
Index: src/font-mgr.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.h,v
retrieving revision 1.2
diff -u -u -r1.2 font-mgr.h
--- src/font-mgr.h 2006/04/25 14:02:09 1.2
+++ src/font-mgr.h 2006/10/31 22:07:04
＠＠ -68,4 +68,73 ＠＠
#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_ */
Index: src/general-slots.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/general-slots.h,v
retrieving revision 1.17
diff -u -u -r1.17 general-slots.h
--- src/general-slots.h 2006/06/03 17:50:54 1.17
+++ src/general-slots.h 2006/10/31 22:07:05
＠＠ -130,6 +130,7 ＠＠
SYMBOL (Qfile);
SYMBOL_MODULE_API (Qfile_name);
SYMBOL_KEYWORD (Q_filter);
+SYMBOL (Qfinal);
SYMBOL (Qfixnum);
SYMBOL (Qfloat);
SYMBOL (Qfont);
＠＠ -157,6 +158,7 ＠＠
SYMBOL (Qicon);
SYMBOL (Qid);
SYMBOL (Qignore);
+SYMBOL (Qinitial);
SYMBOL (Qimage);
SYMBOL_KEYWORD (Q_image);
SYMBOL_KEYWORD (Q_included);
＠＠ -286,6 +288,7 ＠＠
SYMBOL (Qundecided);
SYMBOL (Qundefined);
SYMBOL (Qunimplemented);
+SYMBOL (Qunicode_registries);
SYMBOL (Quser_default);
SYMBOL_KEYWORD (Q_value);
SYMBOL (Qvalue_assoc);
Index: src/intl.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/intl.c,v
retrieving revision 1.10
diff -u -u -r1.10 intl.c
--- src/intl.c 2005/09/24 16:31:39 1.10
+++ src/intl.c 2006/10/31 22:07:06
＠＠ -167,7 +167,7 ＠＠
void
init_intl (void)
{
- /* This function can GC */
+ /* This function cannot GC, because it explicitly prevents it. */
if (initialized)
{
int count = begin_gc_forbidden ();
Index: src/lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.143
diff -u -u -r1.143 lisp.h
--- src/lisp.h 2006/07/08 16:15:56 1.143
+++ src/lisp.h 2006/10/31 22:07:10
＠＠ -2623,6 +2623,13 ＠＠
#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 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;
Index: src/mule-charset.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v
retrieving revision 1.47
diff -u -u -r1.47 mule-charset.c
--- src/mule-charset.c 2006/06/03 17:50:54 1.47
+++ src/mule-charset.c 2006/10/31 22:07:10
＠＠ -35,6 +35,7 ＠＠
#include "lstream.h"
#include "mule-ccl.h"
#include "objects.h"
+#include "specifier.h"
/* The various pre-defined charsets. */
＠＠ -79,7 +80,7 ＠＠
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_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 ＠＠
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 ＠＠
{ 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 ＠＠
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 ＠＠
}
recalculate_unicode_precedence ();
+ setup_charset_initial_specifier_tags (obj);
+
return obj;
}
＠＠ -419,8 +423,8 ＠＠
`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 ＠＠
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 ＠＠
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 ＠＠
}
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 */
}
Index: src/objects-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v
retrieving revision 1.17
diff -u -u -r1.17 objects-gtk.c
--- src/objects-gtk.c 2005/12/24 17:33:34 1.17
+++ src/objects-gtk.c 2006/10/31 22:07:11
＠＠ -385,7 +385,7 ＠＠
gtk_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset,
const Ibyte *nonreloc, Lisp_Object reloc,
Bytecount offset, Bytecount length,
- int stage)
+ enum font_specifier_matchspec_stages stage)
{
if (stage)
return 0;
＠＠ -436,7 +436,10 ＠＠
/* 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);
+static Lisp_Object
+gtk_find_charset_font (Lisp_Object device, Lisp_Object font,
+ Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage);
#endif /* MULE */
＠＠ -492,7 +495,8 ＠＠
(the registry of) CHARSET. */
static Lisp_Object
gtk_find_charset_font (Lisp_Object device, Lisp_Object font,
- Lisp_Object charset, int stage)
+ Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
{
char **names;
int count = 0;
＠＠ -516,7 +520,7 ＠＠
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))
+ intname, Qnil, 0, -1, stage))
{
result = make_string (intname, intlen);
break;
Index: src/objects-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v
retrieving revision 1.47
diff -u -u -r1.47 objects-msw.c
--- src/objects-msw.c 2005/01/28 02:58:51 1.47
+++ src/objects-msw.c 2006/10/31 22:07:12
＠＠ -2182,7 +2182,8 ＠＠
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;
Index: src/objects-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v
retrieving revision 1.17
diff -u -u -r1.17 objects-tty.c
--- src/objects-tty.c 2005/11/25 01:42:06 1.17
+++ src/objects-tty.c 2006/10/31 22:07:12
＠＠ -367,7 +367,8 ＠＠
(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);
Index: src/objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.43
diff -u -u -r1.43 objects-x.c
--- src/objects-x.c 2006/06/23 15:45:03 1.43
+++ src/objects-x.c 2006/10/31 22:07:13
＠＠ -37,6 +37,7 ＠＠
#include "console-x-impl.h"
#include "objects-x-impl.h"
+#include "elhash.h"
#ifdef USE_XFT
#include "font-mgr.h"
＠＠ -44,6 +45,36 ＠＠
int x_handle_non_fully_specified_fonts;
+#ifdef DEBUG_XEMACS
+Fixnum debug_x_objects;
+#endif /* DEBUG_XEMACS */
+
+#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901)
+
+#ifdef DEBUG_XEMACS
+# define DEBUG_OBJECTS(FORMAT, ...) \
+ do { if (debug_x_objects) stderr_out(FORMAT, __VA_ARGS__); } while (0)
+#else /* DEBUG_XEMACS */
+# define DEBUG_OBJECTS(format, ...)
+#endif /* DEBUG_XEMACS */
+
+#elif defined(__GNUC__)
+
+#ifdef DEBUG_XEMACS
+# define DEBUG_OBJECTS(format, args...) \
+ do { if (debug_x_objects) stderr_out(format, args ); } while (0)
+#else /* DEBUG_XEMACS */
+# define DEBUG_OBJECTS(format, args...)
+#endif /* DEBUG_XEMACS */
+
+#else /* defined(__STDC_VERSION__) [...] */
+# define DEBUG_OBJECTS (void)
+#endif
+
+#define THIS_IS_X
+#include "objects-xlike-inc.c"
+
+
/************************************************************************/
/* color instances */
＠＠ -205,75 +236,7 ＠＠
/* 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 +262,12 ＠＠
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 +430,13 ＠＠
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))
＠＠ -946,15 +919,52 ＠＠
#ifdef MULE
+static int
+count_hyphens(const Ibyte *str, Bytecount length, Ibyte **last_hyphen)
+{
+ int hyphen_count = 0;
+ const Ibyte *hyphening = str;
+ const Ibyte *new_hyphening;
+
+ for (hyphen_count = 0;
+ NULL != (new_hyphening = memchr((const void *)hyphening, '-', length));
+ hyphen_count++)
+ {
+ ++new_hyphening;
+ length -= new_hyphening - hyphening;
+ hyphening = new_hyphening;
+ }
+
+ if (NULL != last_hyphen)
+ {
+ *last_hyphen = (Ibyte *)hyphening;
+ }
+
+ return hyphen_count;
+}
+
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)
+ enum font_specifier_matchspec_stages stage)
{
- if (stage)
+ Lisp_Object registries = Qnil;
+ long i, registries_len;
+ const Ibyte *the_nonreloc;
+ Bytecount the_length;
+
+ the_nonreloc = nonreloc;
+ the_length = length;
+
+ if (!the_nonreloc)
+ the_nonreloc = XSTRING_DATA (reloc);
+ fixup_internal_substring (nonreloc, reloc, offset, &the_length);
+ the_nonreloc += offset;
+
#ifdef USE_XFT
+ if (stage)
{
Display *dpy = DEVICE_X_DISPLAY (d);
Extbyte *extname;
＠＠ -967,14 +977,15 ＠＠
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 ;) */
+ /* Jesus, Stephen, what the fuck? */
}
}
-#else
- return 0;
#endif
+ /* Hmm, this smells bad. */
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
＠＠ -986,41 +997,53 ＠＠
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))
+ if (EQ (charset, Vcharset_ascii) &&
+ (!memchr (the_nonreloc, '*', the_length))
+ && (5 > (count_hyphens(the_nonreloc, the_length, NULL))))
{
- 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;
- }
+ return 1;
+ }
- /* 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;
+ if (final == stage)
+ {
+ registries = Qunicode_registries;
+ }
+ else if (initial == stage)
+ {
+ registries = XCHARSET_REGISTRIES (charset);
+ if (NILP(registries))
+ {
+ return 0;
}
}
+ else assert(0);
+
+ CHECK_VECTOR (registries);
+ registries_len = XVECTOR_LENGTH(registries);
- return (fast_string_match (XCHARSET_REGISTRY (charset),
- nonreloc, reloc, offset, length, 1,
- ERROR_ME, 0) >= 0);
+ for (i = 0; i < registries_len; ++i)
+ {
+ if (!(STRINGP(XVECTOR_DATA(registries)[i]))
+ || (XSTRING_LENGTH(XVECTOR_DATA(registries)[i]) > the_length))
+ {
+ continue;
+ }
+
+ /* Check if the font spec ends in the registry specified. X11 says
+ this comparison is case insensitive: XLFD, section 3.11:
+
+ "Alphabetic case distinctions are allowed but are for human
+ readability concerns only. Conforming X servers will perform
+ matching on font name query or open requests independent of case." */
+ if (0 == qxestrcasecmp(XSTRING_DATA(XVECTOR_DATA(registries)[i]),
+ the_nonreloc + (the_length -
+ XSTRING_LENGTH
+ (XVECTOR_DATA(registries)[i]))))
+ {
+ return 1;
+ }
+ }
+ return 0;
}
#ifdef USE_XFT
＠＠ -1170,26 +1193,18 ＠＠
: 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)
+xft_find_charset_font (Lisp_Object font, Lisp_Object charset,
+ enum font_specifier_matchspec_stages 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. */
＠＠ -1339,7 +1354,6 ＠＠
}
ASSERT_ASCTEXT_ASCII((Extbyte *) lang);
- }
if (fccs)
{
＠＠ -1356,7 +1370,7 ＠＠
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
+ unwieldy, but the shorter names are 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? */
＠＠ -1432,42 +1446,175 ＠＠
return result;
}
- DEBUG_XFT1 (0, "shit happens, try X11 charset match for %s\n",
- XSTRING_DATA(font));
+ return Qnil;
#undef DECLARE_DEBUG_FONTNAME
+}
+
#endif /* USE_XFT */
- LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding);
+static Lisp_Object
+xlistfonts_checking_charset (Lisp_Object device, const Extbyte *xlfd,
+ Lisp_Object charset,
+ enum font_specifier_matchspec_stages stage)
+{
+ Extbyte **names;
+ Lisp_Object result = Qnil;
+ int count = 0, i;
+ DECLARE_EISTRING(ei_single_result);
+
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);
+ xlfd, MAX_FONT_COUNT, &count);
+ for (i = 0; i < count; ++i)
+ {
+ eireset(ei_single_result);
+ eicpy_ext(ei_single_result, names[i], Qx_font_name_encoding);
+
if (x_font_spec_matches_charset (XDEVICE (device), charset,
- intname, Qnil, 0, -1, 0))
+ eidata(ei_single_result), Qnil, 0,
+ -1, stage))
{
- result = build_ext_string ((const Extbyte *) intname,
- Qx_font_name_encoding);
+ result = eimake_string(ei_single_result);
+ DEBUG_OBJECTS ("in xlistfonts_checking_charset, returning %s\n",
+ eidata(ei_single_result));
break;
}
}
if (names)
- XFreeFontNames (names);
+ {
+ XFreeFontNames (names);
+ }
+
+ return result;
+}
+
+/* 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,
+ enum font_specifier_matchspec_stages stage)
+{
+ Lisp_Object result = Qnil, registries = Qnil;
+ int j, hyphen_count, registries_len = 0;
+ Ibyte *hyphening, *new_hyphening;
+ Bytecount xlfd_length;
+
+ DECLARE_EISTRING(ei_xlfd_without_registry);
+ DECLARE_EISTRING(ei_xlfd);
+
+#ifdef USE_XFT
+ result = xft_find_charset_font(font, charset, stage);
+ if (!NILP(result))
+ {
+ return result;
+ }
+#endif
+
+ switch (stage)
+ {
+ case initial:
+ {
+ if (!(NILP(XCHARSET_REGISTRIES(charset)))
+ && VECTORP(XCHARSET_REGISTRIES(charset)))
+ {
+ registries_len = XVECTOR_LENGTH(XCHARSET_REGISTRIES(charset));
+ registries = XCHARSET_REGISTRIES(charset);
+ }
+ break;
+ }
+ case final:
+ {
+ registries_len = 1;
+ registries = Qunicode_registries;
+ break;
+ }
+ default:
+ {
+ assert(0);
+ break;
+ }
+ }
+
+ eicpy_lstr(ei_xlfd, font);
+ hyphening = eidata(ei_xlfd);
+ xlfd_length = eilen(ei_xlfd);
+
+ /* Count the hyphens in the string, moving new_hyphening to just after the
+ last one. */
+ hyphen_count = count_hyphens(hyphening, xlfd_length, &new_hyphening);
+
+ if (0 == registries_len || (5 > hyphen_count &&
+ !(1 == xlfd_length && '*' == *hyphening)))
+ {
+ /* No proper XLFD specified, or we can't modify the pattern to change
+ the registry and encoding to match what we want, or we have no
+ information on the registry needed. */
+ eito_external(ei_xlfd, Qx_font_name_encoding);
+ DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n",
+ eidata(ei_xlfd));
+ result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd),
+ charset, stage);
+ /* No need to loop through the available registries; return
+ immediately. */
+ return result;
+ }
+ else if (1 == xlfd_length && '*' == *hyphening)
+ {
+ /* It's a single asterisk. We can add the registry directly to the
+ end. */
+ eicpy_ch(ei_xlfd_without_registry, '*');
+ }
+ else
+ {
+ /* It's a fully-specified XLFD. Work out where the registry and
+ encoding are, and initialise ei_xlfd_without_registry to the string
+ without them. */
+
+ /* count_hyphens has set new_hyphening to just after the last
+ hyphen. Move back to just after the hyphen before it. */
- /* Check for a short font name. */
- if (NILP (result)
- && x_font_spec_matches_charset (XDEVICE (device), charset, 0,
- font, 0, -1, 0))
- return font;
+ for (new_hyphening -= 2; new_hyphening > hyphening
+ && '-' != *new_hyphening; --new_hyphening)
+ ;
+ ++new_hyphening;
+ eicpy_ei(ei_xlfd_without_registry, ei_xlfd);
+
+ /* Manipulate ei_xlfd_without_registry, using the information about
+ ei_xlfd, to which it's identical. */
+ eidel(ei_xlfd_without_registry, new_hyphening - hyphening, -1,
+ eilen(ei_xlfd) - (new_hyphening - hyphening), -1);
+
+ }
+
+ /* Now, loop through the registries and encodings defined for this
+ charset, doing an XListFonts each time with the pattern modified to
+ specify the regisry and encoding. This avoids huge amounts of IPC and
+ duplicated searching; now we use the searching the X server was doing
+ anyway, where before the X server did its search, transferred huge
+ amounts of data, and then we proceeded to do a regexp search on that
+ data. */
+ for (j = 0; j < registries_len && NILP(result); ++j)
+ {
+ eireset(ei_xlfd);
+ eicpy_ei(ei_xlfd, ei_xlfd_without_registry);
+
+ eicat_lstr(ei_xlfd, XVECTOR_DATA(registries)[j]);
+
+ eito_external(ei_xlfd, Qx_font_name_encoding);
+
+ DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n",
+ eidata(ei_xlfd));
+ result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd),
+ charset, stage);
+ }
+
+ /* This function used to return the font spec, in the case where a font
+ didn't exist on the X server but it did match the charset. We're not
+ doing that any more, because none of the other platform code does, and
+ the old behaviour was badly-judged in other respects, so I don't trust
+ the original author to have had a good reason for it. */
+
return result;
}
＠＠ -1512,6 +1659,13 ＠＠
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
Index: src/objects.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v
retrieving revision 1.31
diff -u -u -r1.31 objects.c
--- src/objects.c 2005/11/26 11:46:10 1.31
+++ src/objects.c 2006/10/31 22:07:14
＠＠ -323,8 +323,11 ＠＠
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 (printcharfun, " 0x%x>", f->header.uid);
}
＠＠ -776,7 +779,7 ＠＠
font_spec_matches_charset (struct device *d, Lisp_Object charset,
const Ibyte *nonreloc, Lisp_Object reloc,
Bytecount offset, Bytecount length,
- int stage)
+ enum font_specifier_matchspec_stages stage)
{
return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
(d, charset, nonreloc, reloc, offset, length,
＠＠ -789,6 +792,21 ＠＠
{
CHECK_CONS (matchspec);
Fget_charset (XCAR (matchspec));
+
+ do
+ {
+ if (EQ(XCDR(matchspec), Qinitial))
+ {
+ break;
+ }
+ if (EQ(XCDR(matchspec), Qfinal))
+ {
+ break;
+ }
+
+ invalid_argument("Invalid font matchspec stage",
+ XCDR(matchspec));
+ } while (0);
}
void
＠＠ -836,12 +854,23 ＠＠
Lisp_Object instance;
Lisp_Object charset = Qnil;
#ifdef MULE
- int stage = 0;
+ enum font_specifier_matchspec_stages stage = initial;
if (!UNBOUNDP (matchspec))
{
charset = Fget_charset (XCAR (matchspec));
- stage = NILP (XCDR (matchspec)) ? 0 : 1;
+
+#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \
+ { \
+ stage = new_stage; \
+ }
+
+ FROB(initial)
+ else FROB(final)
+ else assert(0);
+
+#undef FROB
+
}
#endif
＠＠ -864,6 +893,7 ＠＠
if (STRINGP (instantiator))
{
#ifdef MULE
+ /* #### rename these caches. */
Lisp_Object cache = stage ? d->charset_font_cache_stage_2 :
d->charset_font_cache_stage_1;
#else
＠＠ -921,10 +951,22 ＠＠
}
else if (VECTORP (instantiator))
{
+ Lisp_Object match_inst = Qunbound;
assert (XVECTOR_LENGTH (instantiator) == 1);
- return (face_property_matching_instance
- (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
- charset, domain, ERROR_ME, 0, depth));
+
+ match_inst = face_property_matching_instance
+ (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
+ charset, domain, ERROR_ME, 0, depth, initial);
+
+ if (UNBOUNDP(match_inst))
+ {
+ match_inst = face_property_matching_instance
+ (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
+ charset, domain, ERROR_ME, 0, depth, final);
+ }
+
+ return match_inst;
+
}
else if (NILP (instantiator))
return Qunbound;
Index: src/objects.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.h,v
retrieving revision 1.11
diff -u -u -r1.11 objects.h
--- src/objects.h 2005/11/26 11:46:10 1.11
+++ src/objects.h 2006/10/31 22:07:14
＠＠ -76,4 +76,8 ＠＠
void set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
Lisp_Object property);
+/* Defined in search.c, used in mule-charset.c; slightly ugly to declare it
+ here, but oh well. */
+EXFUN (Fregexp_quote, 1);
+
#endif /* INCLUDED_objects_h_ */
Index: src/redisplay-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-x.c,v
retrieving revision 1.43
diff -u -u -r1.43 redisplay-x.c
--- src/redisplay-x.c 2006/06/27 22:59:40 1.43
+++ src/redisplay-x.c 2006/10/31 22:07:14
＠＠ -41,9 +41,8 ＠＠
#include "sysdep.h"
#include "window.h"
-#ifdef MULE
#include "mule-ccl.h"
-#endif
+#include "charset.h"
#include "console-x-impl.h"
#include "glyphs-x.h"
＠＠ -154,138 +153,145 ＠＠
static int
separate_textual_runs (unsigned char *text_storage,
struct textual_run *run_storage,
- const Ichar *str, Charcount len)
+ const Ichar *str, Charcount len,
+ struct face_cachel *cachel)
{
Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a
possible valid charset when
MULE is not defined */
- int runs_so_far = 0;
- int i;
-#ifdef MULE
+ int runs_so_far = 0, i;
+ Ibyte charset_leading_byte = LEADING_BYTE_ASCII;
+ int dimension = 1, graphic = 0, need_ccl_conversion = 0;
+ Lisp_Object ccl_prog;
struct ccl_program char_converter;
- int need_ccl_conversion = 0;
-#endif
+
+#ifdef USE_XFT
+#define translate_to_ucs_2 1 /* Translate to UTF-16 unconditionally. */
+#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) (void)(arg) /* Empty,
+ may avoid some
+ warnings. */
+#else /* USE_XFT */
+#ifndef MULE
+#define translate_to_ucs_2 0 /* We don't support falling back to
+ iso10646-1 without MULE */
+#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) (void)(arg)
+#else /* if MULE */
+ int translate_to_ucs_2 = 0;
+#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) translate_to_ucs_2 = (arg)
+#endif /* MULE */
+#endif /* !USE_XFT */
for (i = 0; i < len; i++)
{
Ichar ch = str[i];
Lisp_Object charset;
- int byte1, byte2; /* #### why aren't these UExtbytes? */
- int dimension;
- int graphic;
-
+ int byte1, byte2; /* Not UExbytes because BREAKUP_ICHAR takes
+ the addresses of its arguments and
+ dereferences those addresses as integer
+ pointers. */
BREAKUP_ICHAR (ch, charset, byte1, byte2);
- dimension = XCHARSET_DIMENSION (charset);
- graphic = XCHARSET_GRAPHIC (charset);
if (!EQ (charset, prev_charset))
{
run_storage[runs_so_far].ptr = text_storage;
run_storage[runs_so_far].charset = charset;
-#ifdef USE_XFT
- run_storage[runs_so_far].dimension = 2;
-#else
- run_storage[runs_so_far].dimension = dimension;
-#endif
if (runs_so_far)
{
run_storage[runs_so_far - 1].len =
text_storage - run_storage[runs_so_far - 1].ptr;
- if (run_storage[runs_so_far - 1].dimension == 2)
- run_storage[runs_so_far - 1].len >>= 1;
+ /* Checks the value for dimension from the previous run. */
+ if (2 == dimension) run_storage[runs_so_far - 1].len >>= 1;
}
- runs_so_far++;
- prev_charset = charset;
+
+ charset_leading_byte = XCHARSET_LEADING_BYTE(charset);
+
+ MAYBE_ASSIGN_TRANSLATE_TO_UCS_2
+ (bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE
+ (cachel),
+ charset_leading_byte - MIN_LEADING_BYTE));
+
+ if (translate_to_ucs_2)
+ {
+ dimension = 2;
+ run_storage[runs_so_far].dimension = 2;
+ }
+ else
+ {
+ dimension = XCHARSET_DIMENSION (charset);
+ run_storage[runs_so_far].dimension = dimension;
#ifdef MULE
- {
- Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset);
- if ((!NILP (ccl_prog))
+
+ ccl_prog = XCHARSET_CCL_PROGRAM (charset);
+ if ((!NILP (ccl_prog))
&& (setup_ccl_program (&char_converter, ccl_prog) >= 0))
- need_ccl_conversion = 1;
- }
-#endif
- }
+ {
+ need_ccl_conversion = 1;
+ }
+ else
+ {
+ /* The graphic property is only relevant if we're neither
+ doing the CCL conversion nor doing the UTF-16
+ conversion; it's irrelevant otherwise. */
+ graphic = XCHARSET_GRAPHIC (charset);
+ need_ccl_conversion = 0;
+ }
+#endif /* MULE */
+ }
+ prev_charset = charset;
-#ifndef USE_XFT
- if (graphic == 0)
- {
- byte1 &= 0x7F;
- byte2 &= 0x7F;
- }
- else if (graphic == 1)
+ runs_so_far++;
+ }
+
+ if (translate_to_ucs_2)
{
- byte1 |= 0x80;
- byte2 |= 0x80;
+ int ucs = ichar_to_unicode(ch);
+
+ /* If UCS is less than zero or greater than 0xFFFF, set it to
+ REPLACMENT CHARACTER. */
+ if (ucs & ~0xFFFF)
+ {
+ ucs = 0xFFFD;
+ }
+
+ /* Ignoring the "graphic" handling. Also, X11 (XFT included) takes
+ its font indices with network byte order. */
+ byte1 = ucs >> 8;
+ byte2 = ucs & 0xFF;
}
#ifdef MULE
- if (need_ccl_conversion)
+ else if (need_ccl_conversion)
{
- char_converter.reg[0] = XCHARSET_ID (charset);
+ char_converter.reg[0] = charset_leading_byte;
char_converter.reg[1] = byte1;
char_converter.reg[2] = byte2;
ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING);
byte1 = char_converter.reg[1];
byte2 = char_converter.reg[2];
}
+ else if (graphic == 0)
+ {
+ byte1 &= 0x7F;
+ byte2 &= 0x7F;
+ }
+ else
+ {
+ byte1 |= 0x80;
+ byte2 |= 0x80;
+ }
#endif /* MULE */
- *text_storage++ = (unsigned char) byte1;
- /* This dimension stuff is broken if you want to use a two-dimensional
- X11 font to display a single-dimensional character set, as is
- appropriate for the IPA (use one of the -iso10646-1 fonts) or some
- of the other non-standard character sets. */
- if (dimension == 2)
- *text_storage++ = (unsigned char) byte2;
-#else /* USE_XFT */
- /* #### This is bogus as hell. XftChar16, aka FcChar16, is actually
- unsigned short, and therefore is not suitable for indexing matrix
- fonts such as the JIS fonts supplied with X11. But if this were
- consistent, the XftDraw*8 and XftDraw*16 functions are pretty
- incoherent, as then we not should allow anything but ISO 8859/1
- (ie, the first 256 code points of Unicode) in XftDraw*8. So it
- looks like this depends on the font, not the charset. */
- {
- XftChar16 xftchar16 = 0xFFFD; /* unsigned short */
-#ifndef MULE
- int unicode = ch;
-#else
- int unicode = ichar_to_unicode (ch);
- if (unicode < 0)
- /* abort(); */ /* #### serious error, tables are corrupt
- Unfortunately, not a valid assumption; this can happen with
- composite characters. Fake it. */
- unicode = 0xFFFD; /* REPLACEMENT CHARACTER, can't represent */
- else if (need_ccl_conversion)
- /* #### maybe we should just ignore this and hope the font wins? */
- unicode = 0xFFFD; /* REPLACEMENT CHARACTER, can't represent */
- else if (unicode > 65535)
- unicode = 0xFFFD; /* REPLACEMENT CHARACTER, can't represent */
- else
-#endif
- xftchar16 = (XftChar16) unicode;
- /* #### endianness dependency? No,
- apparently xft handles endianness for us;
- the "big-endian" code works on Intel and PPC */
-#if 1
- /* big-endian or auto-endian */
- byte1 = ((unsigned char *) (&xftchar16))[0];
- byte2 = ((unsigned char *) (&xftchar16))[1];
-#else
- /* little-endian */
- byte1 = ((unsigned char *) (&xftchar16))[1];
- byte2 = ((unsigned char *) (&xftchar16))[0];
-#endif
- }
- *text_storage++ = (unsigned char) byte1;
- *text_storage++ = (unsigned char) byte2;
-#endif /* USE_XFT */
+ *text_storage++ = (unsigned char)byte1;
+#ifdef MULE
+ if (2 == dimension) *text_storage++ = (unsigned char)byte2;
+#endif /* MULE */
}
if (runs_so_far)
{
run_storage[runs_so_far - 1].len =
text_storage - run_storage[runs_so_far - 1].ptr;
- if (run_storage[runs_so_far - 1].dimension == 2)
+ /* Dimension retains the relevant value for the run before it. */
+ if (2 == dimension)
run_storage[runs_so_far - 1].len >>= 1;
}
＠＠ -361,7 +367,8 ＠＠
int nruns;
int i;
- nruns = separate_textual_runs (text_storage, runs, str, len);
+ nruns = separate_textual_runs (text_storage, runs, str, len,
+ cachel);
for (i = 0; i < nruns; i++)
width_so_far += x_text_width_single_run (f, cachel, runs + i);
＠＠ -1014,7 +1021,7 ＠＠
}
nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0),
- Dynarr_length (buf));
+ Dynarr_length (buf), cachel);
for (i = 0; i < nruns; i++)
{
Index: src/redisplay.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v
retrieving revision 1.100
diff -u -u -r1.100 redisplay.c
--- src/redisplay.c 2006/07/08 16:15:56 1.100
+++ src/redisplay.c 2006/10/31 22:07:18
＠＠ -760,7 +760,7 ＠＠
static int
space_width (struct window *w)
{
- /* While tabs are traditional composed of spaces, for variable-width
+ /* While tabs are traditionally composed of spaces, for variable-width
fonts the space character tends to give too narrow a value. So
we use 'n' instead. Except that we don't. We use the default
character width for the default face. If this is actually
Index: src/specifier.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v
retrieving revision 1.44
diff -u -u -r1.44 specifier.c
--- src/specifier.c 2006/02/27 16:29:28 1.44
+++ src/specifier.c 2006/10/31 22:07:19
＠＠ -47,6 +47,7 ＠＠
Lisp_Object Qconsole_type, Qdevice_class;
static Lisp_Object Vuser_defined_tags;
+static Lisp_Object Vcharset_tag_lists;
typedef struct specifier_type_entry specifier_type_entry;
struct specifier_type_entry
＠＠ -834,10 +835,10 ＠＠
DEFUN ("valid-specifier-tag-set-p", Fvalid_specifier_tag_set_p, 1, 1, 0, /*
Return non-nil if TAG-SET is a valid specifier tag set.
-A specifier tag set is an entity that is attached to an instantiator
-and can be used to restrict the scope of that instantiator to a
-particular device class or device type and/or to mark instantiators
-added by a particular package so that they can be later removed.
+A specifier tag set is an entity that is attached to an instantiator and can
+be used to restrict the scope of that instantiator to a particular device
+class, device type, or charset. It can also be used to mark instantiators
+added by a particular package so that they can be later removed as a group.
A specifier tag set consists of a list of zero of more specifier tags,
each of which is a symbol that is recognized by XEmacs as a tag.
＠＠ -846,13 +847,20 ＠＠
\(as opposed to a list) because the order of the tags or the number of
times a particular tag occurs does not matter.
-Each tag has a predicate associated with it, which specifies whether
-that tag applies to a particular device. The tags which are device types
-and classes match devices of that type or class. User-defined tags can
-have any predicate, or none (meaning that all devices match). When
-attempting to instantiate a specifier, a particular instantiator is only
-considered if the device of the domain being instantiated over matches
-all tags in the tag set attached to that instantiator.
+Each tag has two predicates associated with it, which specify, respectively,
+whether that tag applies to a particular device and whether it applies to a
+particular character set. The predefined tags which are device types and
+classes match devices of that type or class. User-defined tags can have any
+device predicate, or none (meaning that all devices match). When attempting
+to instantiate a specifier, a particular instantiator is only considered if
+the device of the domain being instantiated over matches all tags in the tag
+set attached to that instantiator.
+
+If a charset is to be considered--which is only the case for face
+instantiators--this consideration may be done twice. The first iteration
+pays attention to the character set predicates; if no instantiator can be
+found in that case, the search is repeated ignoring the character set
+predicates.
Most of the time, a tag set is not specified, and the instantiator
gets a null tag set, which matches all devices.
＠＠ -973,6 +981,63 ＠＠
return 1;
}
+static int
+charset_matches_specifier_tag_set_p (Lisp_Object charset,
+ Lisp_Object tag_set,
+ enum font_specifier_matchspec_stages
+ stage)
+{
+ Lisp_Object rest;
+ int res = 0;
+
+ assert(stage != impossible);
+
+ LIST_LOOP (rest, tag_set)
+ {
+ Lisp_Object tag = XCAR (rest);
+ Lisp_Object assoc;
+
+ /* This function will not ever be called with a charset for which the
+ relevant information hasn't been calculated (the information is
+ calculated with the creation of every charset). */
+ assert (!NILP(XVECTOR_DATA
+ (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset)
+ - MIN_LEADING_BYTE]));
+
+ /* Now, find out what the pre-calculated value is. */
+ assoc = assq_no_quit(tag,
+ XVECTOR_DATA(Vcharset_tag_lists)
+ [XCHARSET_LEADING_BYTE(charset)
+ - MIN_LEADING_BYTE]);
+
+ if (!(NILP(assoc)) && !(NILP(XCDR(assoc))))
+ {
+ assert(VECTORP(XCDR(assoc)));
+
+ /* In the event that a tag specifies a charset, then the specifier
+ must match for (this stage and this charset) for all
+ charset-specifying tags. */
+ if (NILP(XVECTOR_DATA(XCDR(assoc))[stage]))
+ {
+ /* It doesn't match for this tag, even though the tag
+ specifies a charset. Return 0. */
+ return 0;
+ }
+
+ /* This tag specifies charset limitations, and this charset and
+ stage match those charset limitations.
+
+ In the event that a later tag specifies charset limitations
+ that don't match, the return 0 above prevents us giving a
+ positive match. */
+ res = 1;
+ }
+ }
+
+ return res;
+}
+
+
DEFUN ("device-matches-specifier-tag-set-p",
Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /*
Return non-nil if DEVICE matches specifier tag set TAG-SET.
＠＠ -990,56 +1055,61 ＠＠
return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
}
-DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /*
-Define a new specifier tag.
-If PREDICATE is specified, it should be a function of one argument
-\(a device) that specifies whether the tag matches that particular
-device. If PREDICATE is omitted, the tag matches all devices.
-
-You can redefine an existing user-defined specifier tag. However,
-you cannot redefine the built-in specifier tags (the device types
-and classes) or the symbols nil, t, `all', or `global'.
-*/
- (tag, predicate))
+Lisp_Object
+define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate,
+ Lisp_Object charset_predicate)
{
- Lisp_Object assoc, devcons, concons;
- int recompute = 0;
+ Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags),
+ concons, devcons, charpres = Qnil;
+ int recompute_devices = 0, recompute_charsets = 0, i, max_args;
- CHECK_SYMBOL (tag);
- if (valid_device_class_p (tag) ||
- valid_console_type_p (tag))
- invalid_change ("Cannot redefine built-in specifier tags", tag);
- /* Try to prevent common instantiators and locales from being
- redefined, to reduce ambiguity */
- if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
- invalid_change ("Cannot define nil, t, `all', or `global'", tag);
- assoc = assq_no_quit (tag, Vuser_defined_tags);
if (NILP (assoc))
{
- recompute = 1;
- Vuser_defined_tags = Fcons (Fcons (tag, predicate), Vuser_defined_tags);
+ recompute_devices = recompute_charsets = 1;
+ Vuser_defined_tags = Fcons (list3 (tag, device_predicate,
+ charset_predicate),
+ Vuser_defined_tags);
DEVICE_LOOP_NO_BREAK (devcons, concons)
{
struct device *d = XDEVICE (XCAR (devcons));
/* Initially set the value to t in case of error
- in predicate */
+ in device_predicate */
DEVICE_USER_DEFINED_TAGS (d) =
Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d));
}
}
- else if (!NILP (predicate) && !NILP (XCDR (assoc)))
+ else if (!NILP (device_predicate) && !NILP (XCADR (assoc)))
{
- recompute = 1;
- XCDR (assoc) = predicate;
+ recompute_devices = 1;
+ XCDR (assoc) = list2(device_predicate, charset_predicate);
}
+ else if (!NILP (charset_predicate) || !NILP(XCADDR (assoc)))
+ {
+ max_args = XINT(Ffunction_max_args(charset_predicate));
+ if (max_args < 1)
+ {
+ invalid_argument
+ ("Charset predicate must be able to take an argument", tag);
+ }
+
+ /* If there exists a charset_predicate for the tag currently (even if
+ the new charset_predicate is nil), or if we're adding one, we need
+ to recompute. This contrasts with the device predicates, where we
+ don't need to recompute if the old and new device predicates are
+ both nil. */
+
+ recompute_charsets = 1;
+ XCDR (assoc) = list2(device_predicate, charset_predicate);
+ }
- /* recompute the tag values for all devices. However, in the special
- case where both the old and new predicates are nil, we know that
- we don't have to do this. (It's probably common for people to
- call (define-specifier-tag) more than once on the same tag,
- and the most common case is where PREDICATE is not specified.) */
+ /* Recompute the tag values for all devices and charsets, if necessary. In
+ the special case where both the old and new device_predicates are nil,
+ we know that we don't have to do it for the device. (It's probably
+ common for people to call (define-specifier-tag) more than once on the
+ same tag, and the most common case is where DEVICE_PREDICATE is not
+ specified.) */
- if (recompute)
+ if (recompute_devices)
{
DEVICE_LOOP_NO_BREAK (devcons, concons)
{
＠＠ -1047,16 +1117,155 ＠＠
assoc = assq_no_quit (tag,
DEVICE_USER_DEFINED_TAGS (XDEVICE (device)));
assert (CONSP (assoc));
- if (NILP (predicate))
+ if (NILP (device_predicate))
XCDR (assoc) = Qt;
else
- XCDR (assoc) = !NILP (call1 (predicate, device)) ? Qt : Qnil;
+ XCDR (assoc) = !NILP (call1 (device_predicate, device)) ? Qt
+ : Qnil;
}
}
- return Qnil;
+ if (recompute_charsets)
+ {
+ if (NILP(charset_predicate))
+ {
+ charpres = Qnil;
+ }
+
+ for (i = 0; i < NUM_LEADING_BYTES; ++i)
+ {
+ if (NILP(charset_by_leading_byte(MIN_LEADING_BYTE + i)))
+ {
+ continue;
+ }
+
+ assoc = assq_no_quit (tag,
+ XVECTOR_DATA(Vcharset_tag_lists)[i]);
+
+ if (!NILP(charset_predicate))
+ {
+ charpres = make_vector(impossible, Qnil);
+
+ /* If you want to extend the number of stages available, here
+ in setup_charset_initial_specifier_tags, and in specifier.h
+ is where you want to go. */
+
+#define DEFINE_SPECIFIER_TAG_FROB(stage) do { \
+ if (max_args > 1) \
+ { \
+ XVECTOR_DATA(charpres)[stage] = \
+ call2_trapping_problems \
+ ("Error during specifier tag charset predicate," \
+ " stage " #stage, charset_predicate, \
+ charset_by_leading_byte(MIN_LEADING_BYTE + i), \
+ Q##stage, 0); \
+ } \
+ else \
+ { \
+ XVECTOR_DATA(charpres)[stage] = \
+ call1_trapping_problems \
+ ("Error during specifier tag charset predicate," \
+ " stage " #stage, charset_predicate, \
+ charset_by_leading_byte(MIN_LEADING_BYTE + i), \
+ 0); \
+ } \
+ \
+ if (UNBOUNDP(XVECTOR_DATA(charpres)[stage])) \
+ { \
+ XVECTOR_DATA(charpres)[stage] = Qnil; \
+ } \
+ else if (!NILP(XVECTOR_DATA(charpres)[stage])) \
+ { \
+ /* Don't want refs to random other objects. */ \
+ XVECTOR_DATA(charpres)[stage] = Qt; \
+ } \
+ } while (0)
+
+ DEFINE_SPECIFIER_TAG_FROB (initial);
+ DEFINE_SPECIFIER_TAG_FROB (final);
+
+#undef DEFINE_SPECIFIER_TAG_FROB
+
+ }
+
+ if (!NILP(assoc))
+ {
+ assert(CONSP(assoc));
+ XCDR (assoc) = charpres;
+ }
+ else
+ {
+ XVECTOR_DATA(Vcharset_tag_lists)[i]
+ = Fcons(Fcons(tag, charpres),
+ XVECTOR_DATA (Vcharset_tag_lists)[i]);
+ }
+ }
+ }
+ return Qt;
}
+DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 3, 0, /*
+Define a new specifier tag.
+
+If DEVICE-PREDICATE is specified, it should be a function of one argument
+\(a device) that specifies whether the tag matches that particular device.
+If DEVICE-PREDICATE is omitted, the tag matches all devices.
+
+If CHARSET-PREDICATE is supplied, it should be a function taking a single
+Lisp character set argument. A tag's charset predicate is primarily used to
+determine what font to use for a given \(set of) charset\(s) when that tag
+is used in a set-face-font call; a non-nil return value indicates that the
+tag matches the charset.
+
+The font matching process also has a concept of stages; the defined stages
+are currently `initial' and `final', and there exist specifier tags
+with those names that correspond to those stages. On X11, 'initial is used
+when the font matching process is looking for fonts that match the desired
+registries of the charset--see the `charset-registries' function. If that
+match process fails, then the 'final tag becomes relevant; this means that a
+more general lookup is desired, and that a font doesn't necessarily have to
+match the desired XLFD for the face, just the charset repertoire for this
+charset. It also means that the charset registry and encoding used will be
+`iso10646-1', and the characters will be converted to display using that
+registry.
+
+If a tag set matches no character set; the two-stage match process will
+ignore the tag on its first pass, but if no match is found, it will respect
+it on the second pass, where character set information is ignored.
+
+You can redefine an existing user-defined specifier tag. However, you cannot
+redefine the built-in specifier tags \(the device types and classes,
+`initial', and `final') or the symbols nil, t, `all', or `global'. Note that
+if a device type is not supported in this XEmacs, it will not be available
+as a built-in specifier tag; this is probably something we should change.
+*/
+ (tag, device_predicate, charset_predicate))
+{
+ int max_args;
+
+ CHECK_SYMBOL (tag);
+ if (valid_device_class_p (tag) ||
+ valid_console_type_p (tag) ||
+ EQ (tag, Qinitial) || EQ (tag, Qfinal))
+ invalid_change ("Cannot redefine built-in specifier tags", tag);
+ /* Try to prevent common instantiators and locales from being
+ redefined, to reduce ambiguity */
+ if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
+ invalid_change ("Cannot define nil, t, `all', or `global'", tag);
+
+ if (!NILP (charset_predicate))
+ {
+ max_args = XINT(Ffunction_max_args(charset_predicate));
+ if (max_args < 1)
+ {
+ invalid_change ("Charset predicate must take one argument",
+ tag);
+ }
+ }
+
+ return define_specifier_tag(tag, device_predicate, charset_predicate);
+}
+
/* Called at device-creation time to initialize the user-defined
tag values for the newly-created device. */
＠＠ -1065,6 +1274,8 ＠＠
{
Lisp_Object rest, rest2;
Lisp_Object device = wrap_device (d);
+ Lisp_Object device_predicate, charset_predicate;
+ int list_len;
DEVICE_USER_DEFINED_TAGS (d) = Fcopy_alist (Vuser_defined_tags);
＠＠ -1075,15 +1286,83 ＠＠
for (rest = Vuser_defined_tags, rest2 = DEVICE_USER_DEFINED_TAGS (d);
!NILP (rest); rest = XCDR (rest), rest2 = XCDR (rest2))
{
- Lisp_Object predicate = XCDR (XCAR (rest));
- if (NILP (predicate))
- XCDR (XCAR (rest2)) = Qt;
+ GET_LIST_LENGTH(XCAR(rest), list_len);
+
+ assert(3 == list_len);
+
+ device_predicate = XCADR(XCAR (rest));
+ charset_predicate = XCADDR(XCAR (rest));
+
+ if (NILP (device_predicate))
+ {
+ XCDR (XCAR (rest2)) = list2(Qt, charset_predicate);
+ }
else
- XCDR (XCAR (rest2)) =
- !NILP (call_critical_lisp_code (d, predicate, device)) ? Qt : Qnil;
+ {
+ device_predicate = !NILP (call_critical_lisp_code
+ (d, device_predicate, device))
+ ? Qt : Qnil;
+ XCDR (XCAR (rest2)) = list2(device_predicate, charset_predicate);
+ }
}
}
+void
+setup_charset_initial_specifier_tags (Lisp_Object charset)
+{
+ Lisp_Object rest, charset_predicate, tag, new_value;
+ Lisp_Object charset_tag_list = Qnil;
+
+ LIST_LOOP (rest, Vuser_defined_tags)
+ {
+ tag = XCAR(XCAR(rest));
+ charset_predicate = XCADDR(XCAR (rest));
+
+ if (NILP(charset_predicate))
+ {
+ continue;
+ }
+
+ new_value = make_vector(impossible, Qnil);
+
+#define SETUP_CHARSET_TAGS_FROB(stage) do { \
+ \
+ XVECTOR_DATA(new_value)[stage] = call2_trapping_problems \
+ ("Error during specifier tag charset predicate," \
+ " stage " #stage, \
+ charset_predicate, charset, Q##stage, 0); \
+ \
+ if (UNBOUNDP(XVECTOR_DATA(new_value)[stage])) \
+ { \
+ XVECTOR_DATA(new_value)[stage] = Qnil; \
+ } \
+ else if (!NILP(XVECTOR_DATA(new_value)[stage])) \
+ { \
+ /* Don't want random other objects hanging around. */ \
+ XVECTOR_DATA(new_value)[stage] = Qt; \
+ } \
+ \
+ } while (0)
+
+ SETUP_CHARSET_TAGS_FROB (initial);
+ SETUP_CHARSET_TAGS_FROB (final);
+ /* More later? */
+
+#undef SETUP_CHARSET_TAGS_FROB
+
+ charset_tag_list = Fcons(Fcons(tag, new_value), charset_tag_list);
+ }
+
+ XVECTOR_DATA
+ (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) - MIN_LEADING_BYTE]
+ = charset_tag_list;
+}
+
+#ifdef DEBUG_XEMACS
+
+/* Nothing's calling this, I see no reason to keep it in the production
+ builds. */
+
DEFUN ("device-matching-specifier-tag-list",
Fdevice_matching_specifier_tag_list,
0, 1, 0, /*
＠＠ -1100,7 +1379,7 ＠＠
LIST_LOOP (rest, DEVICE_USER_DEFINED_TAGS (d))
{
- if (!NILP (XCDR (XCAR (rest))))
+ if (!NILP (XCADR (XCAR (rest))))
list = Fcons (XCAR (XCAR (rest)), list);
}
＠＠ -1111,6 +1390,8 ＠＠
RETURN_UNGCPRO (list);
}
+#endif /* DEBUG_XEMACS */
+
DEFUN ("specifier-tag-list", Fspecifier_tag_list, 0, 0, 0, /*
Return a list of all currently-defined specifier tags.
This includes the built-in ones (the device types and classes).
＠＠ -1132,8 +1413,9 ＠＠
RETURN_UNGCPRO (list);
}
-DEFUN ("specifier-tag-predicate", Fspecifier_tag_predicate, 1, 1, 0, /*
-Return the predicate for the given specifier tag.
+DEFUN ("specifier-tag-device-predicate", Fspecifier_tag_device_predicate,
+ 1, 1, 0, /*
+Return the device predicate for the given specifier tag.
*/
(tag))
{
＠＠ -1155,8 +1437,24 ＠＠
return list3 (Qlambda, list1 (Qdevice),
list3 (Qeq, list2 (Qquote, tag),
list2 (Qdevice_class, Qdevice)));
+
+ return XCADR (assq_no_quit (tag, Vuser_defined_tags));
+}
+
+DEFUN ("specifier-tag-charset-predicate", Fspecifier_tag_charset_predicate,
+ 1, 1, 0, /*
+Return the charset predicate for the given specifier tag.
+*/
+ (tag))
+{
+ /* The return value of this function must be GCPRO'd. */
+ CHECK_SYMBOL (tag);
+
+ if (NILP (Fvalid_specifier_tag_p (tag)))
+ invalid_argument ("Invalid specifier tag",
+ tag);
- return XCDR (assq_no_quit (tag, Vuser_defined_tags));
+ return XCADDR (assq_no_quit (tag, Vuser_defined_tags));
}
/* Return true if A "matches" B. If EXACT_P is 0, A must be a subset of B.
＠＠ -2496,10 +2794,13 ＠＠
{
/* This function can GC */
Lisp_Specifier *sp;
- Lisp_Object device;
- Lisp_Object rest;
- int count = specpdl_depth ();
+ Lisp_Object device, charset = Qnil, rest;
+ int count = specpdl_depth (), respected_charsets = 0;
struct gcpro gcpro1, gcpro2;
+ enum font_specifier_matchspec_stages stage = initial;
+#ifdef DEBUG_XEMACS
+ int non_ascii;
+#endif
GCPRO2 (specifier, inst_list);
＠＠ -2513,31 +2814,119 ＠＠
Fsignal will abort. */
specbind (Qinhibit_quit, Qt);
+#ifdef MULE
+ if (CONSP(matchspec) && (CHARSETP(XCAR(matchspec))))
+ {
+ charset = Ffind_charset(XCAR(matchspec));
+
+#ifdef DEBUG_XEMACS
+ /* This is mostly to have somewhere to set debug breakpoints. */
+ if (!EQ(charset, Vcharset_ascii))
+ {
+ non_ascii = 1;
+ }
+#endif /* DEBUG_XEMACS */
+
+ if (!NILP(XCDR(matchspec)))
+ {
+
+#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \
+ { \
+ stage = new_stage; \
+ }
+
+ FROB(initial)
+ else FROB(final)
+ else assert(0);
+#undef FROB
+
+ }
+ }
+#endif /* MULE */
+
+ LIST_LOOP(rest, inst_list)
+ {
+ Lisp_Object tagged_inst = XCAR (rest);
+ Lisp_Object tag_set = XCAR (tagged_inst);
+ Lisp_Object val, the_instantiator;
+
+ if (!device_matches_specifier_tag_set_p (device, tag_set))
+ {
+ continue;
+ }
+
+ val = XCDR (tagged_inst);
+ the_instantiator = val;
+
+ if (!NILP(charset) &&
+ !(charset_matches_specifier_tag_set_p (charset, tag_set, stage)))
+ {
+ ++respected_charsets;
+ continue;
+ }
+
+ if (HAS_SPECMETH_P (sp, instantiate))
+ val = call_with_suspended_errors
+ ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
+ Qunbound, Qspecifier, errb, 5, specifier,
+ matchspec, domain, val, depth);
+
+ if (!UNBOUNDP (val))
+ {
+ unbind_to (count);
+ UNGCPRO;
+ if (instantiator)
+ *instantiator = the_instantiator;
+ return val;
+ }
+ }
+
+ /* We've checked all the tag sets, and checking the charset part of the
+ specifier never returned 0 (preventing the attempted instantiation), so
+ there's no need to loop for the second time to avoid checking the
+ charsets. */
+ if (!respected_charsets)
+ {
+ unbind_to (count);
+ UNGCPRO;
+ return Qunbound;
+ }
+
+ /* Right, didn't instantiate a specifier last time, perhaps because we
+ paid attention to the charset-specific aspects of the specifier. Try
+ again without checking the charset information.
+
+ We can't emulate the approach for devices, defaulting to matching all
+ character sets for a given specifier, because $random font instantiator
+ cannot usefully show all character sets, and indeed having it try is a
+ failure on our part. */
LIST_LOOP (rest, inst_list)
{
Lisp_Object tagged_inst = XCAR (rest);
Lisp_Object tag_set = XCAR (tagged_inst);
+ Lisp_Object val, the_instantiator;
- if (device_matches_specifier_tag_set_p (device, tag_set))
+ if (!device_matches_specifier_tag_set_p (device, tag_set))
{
- Lisp_Object val = XCDR (tagged_inst);
- Lisp_Object the_instantiator = val;
+ continue;
+ }
+ val = XCDR (tagged_inst);
+ the_instantiator = val;
- if (HAS_SPECMETH_P (sp, instantiate))
- val = call_with_suspended_errors
- ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
- Qunbound, Qspecifier, errb, 5, specifier,
- matchspec, domain, val, depth);
+ if (HAS_SPECMETH_P (sp, instantiate))
+ val = call_with_suspended_errors
+ ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
+ Qunbound, Qspecifier, errb, 5, specifier,
+ matchspec, domain, val, depth);
- if (!UNBOUNDP (val))
- {
- unbind_to (count);
- UNGCPRO;
- if (instantiator)
- *instantiator = the_instantiator;
- return val;
- }
+ if (!UNBOUNDP (val))
+ {
+ unbind_to (count);
+ UNGCPRO;
+ if (instantiator)
+ *instantiator = the_instantiator;
+ return val;
}
}
＠＠ -3408,7 +3797,8 ＠＠
DEFSUBR (Fdefine_specifier_tag);
DEFSUBR (Fdevice_matching_specifier_tag_list);
DEFSUBR (Fspecifier_tag_list);
- DEFSUBR (Fspecifier_tag_predicate);
+ DEFSUBR (Fspecifier_tag_device_predicate);
+ DEFSUBR (Fspecifier_tag_charset_predicate);
DEFSUBR (Fcheck_valid_instantiator);
DEFSUBR (Fvalid_instantiator_p);
＠＠ -3509,4 +3899,7 ＠＠
Vunlock_ghost_specifiers = Qnil;
staticpro (&Vunlock_ghost_specifiers);
+
+ Vcharset_tag_lists = make_vector(NUM_LEADING_BYTES, Qnil);
+ staticpro (&Vcharset_tag_lists);
}
Index: src/specifier.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.h,v
retrieving revision 1.19
diff -u -u -r1.19 specifier.h
--- src/specifier.h 2005/11/25 01:42:06 1.19
+++ src/specifier.h 2006/10/31 22:07:20
＠＠ -535,6 +535,7 ＠＠
void cleanup_specifiers (void);
void prune_specifiers (void);
void setup_device_initial_specifier_tags (struct device *d);
+void setup_charset_initial_specifier_tags (Lisp_Object charset);
void kill_specifier_buffer_locals (Lisp_Object buffer);
DECLARE_SPECIFIER_TYPE (generic);
＠＠ -566,5 +567,19 ＠＠
#define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table)
#define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table)
#define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table)
+
+/* The various stages of font instantiation; initial means "find a font for
+ CHARSET that matches the charset's registries" and final means "find a
+ font for CHARSET that matches iso10646-1, since we haven't found a font
+ that matches its registry." */
+enum font_specifier_matchspec_stages {
+ initial,
+ final,
+ impossible,
+};
+
+Lisp_Object define_specifier_tag(Lisp_Object tag,
+ Lisp_Object device_predicate,
+ Lisp_Object charset_predicate);
#endif /* INCLUDED_specifier_h_ */
Index: src/unicode.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/unicode.c,v
retrieving revision 1.34
diff -u -u -r1.34 unicode.c
--- src/unicode.c 2006/06/14 06:10:10 1.34
+++ src/unicode.c 2006/10/31 22:07:21
＠＠ -1115,9 +1115,8 ＠＠
Ibyte setname[32];
Lisp_Object charset_descr = build_string
("Mule charset for otherwise unknown Unicode code points.");
- Lisp_Object charset_regr = build_string("iso10646-1");
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1;
if ('\0' == last_jit_charset_final)
{
＠＠ -1138,7 +1137,7 ＠＠
Lisp reader. We GCPRO in case it GCs in the future and no-one
checks all the C callers. */
- GCPRO2 (charset_descr, charset_regr);
+ GCPRO1 (charset_descr);
Vcurrent_jit_charset = Fmake_charset
(intern((const CIbyte *)setname), charset_descr,
/* Set encode-as-utf-8 to t, to have this character set written
＠＠ -1148,7 +1147,7 ＠＠
nconc2 (list2(Qencode_as_utf_8, Qt),
nconc2 (list6(Qcolumns, make_int(1), Qchars, make_int(96),
Qdimension, make_int(2)),
- list6(Qregistry, charset_regr,
+ list6(Qregistries, Qunicode_registries,
Qfinal, make_char(last_jit_charset_final++),
/* This CCL program is initialised in
unicode.el. */
＠＠ -2539,6 +2538,8 ＠＠
DEFSYMBOL (Qccl_encode_to_ucs_2);
DEFSYMBOL (Qlast_allocated_character);
DEFSYMBOL (Qignore_first_column);
+
+ DEFSYMBOL (Qunicode_registries);
#endif /* MULE */
DEFSUBR (Fchar_to_unicode);
＠＠ -2611,6 +2612,8 ＠＠
dump_add_root_block_ptr (&unicode_precedence_dynarr,
&lisp_object_dynarr_description);
+
+
init_blank_unicode_tables ();
staticpro (&Vcurrent_jit_charset);
＠＠ -2636,5 +2639,16 ＠＠
from_unicode_level_3_desc_1);
dump_add_root_block (&from_unicode_blank_4, sizeof (void *),
from_unicode_level_4_desc_1);
+
+ DEFVAR_LISP ("unicode-registries", &Qunicode_registries /*
+Vector describing the X11 registries searched when using fallback fonts.
+
+"Fallback fonts" here includes by default those fonts used by redisplay when
+displaying charsets for which the `encode-as-utf-8' property is true, and
+those used when no font matching the charset's registries property has been
+found (that is, they're probably Mule-specific charsets like Ethiopic or
+IPA.)
+*/ );
+ Qunicode_registries = vector1(build_string("iso10646-1"));
#endif /* MULE */
}
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
[C] XEmacs-CVSROOT: Remove old www.xemacs.org IP
17 years, 5 months
Adrian Aichner
Adrian Aichner
COMMIT
XEmacs-CVSROOT ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/CVSROOT/ChangeLog,v
retrieving revision 1.151
diff -u -U0 -r1.151 ChangeLog
--- ChangeLog 27 Oct 2006 21:01:11 -0000 1.151
+++ ChangeLog 1 Nov 2006 23:50:35 -0000
＠＠ -0,0 +1,4 ＠＠
+2006-11-02 Adrian Aichner <adrian(a)xemacs.org>
+
+ * ssh_known_hosts: Remove old www.xemacs.org IP.
+
XEmacs-CVSROOT source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: ssh_known_hosts
Index: ssh_known_hosts
===================================================================
RCS file: /pack/xemacscvs/CVSROOT/ssh_known_hosts,v
retrieving revision 1.25
diff -u -w -r1.25 ssh_known_hosts
--- ssh_known_hosts 27 Oct 2006 21:01:11 -0000 1.25
+++ ssh_known_hosts 1 Nov 2006 23:49:58 -0000
＠＠ -1,3 +1,3 ＠＠
sunsite.dk,130.225.247.90 1024 35 148528299969609934846963622501552993813562345182945326718830553989687933347506564835361597805030181070665422926714899851462477104403575697872368044394421277863950549818205511825079380927537469626151489624113742202914922423343628570500862653065486787673958367142512616535948103788535351269771532331123007504709
xemacs.sourceforge.net,66.35.250.209 1024 33 128924470705398209102756996954502983262028081367539141294366246954411549904580834121479916210106191946755940435825080973567069530858666809492745122498855495744994998372484124505793741347067203790865455488054034609680287705733837331602330407470713515342800732981818490074631195245036203914402097831932034223577
-www.xemacs.org,199.184.165.136,207.172.156.133 1024 35 147791117709570226148391879398434809228159132703734105870815018356822921857678284814977059049568661442230855537449309575401577924292090593234020384348603755111614158040736768046345448616336139216350571433289658153595106874705767152078680206376400908833084672875810036607926893168605412877115839848383242787401
+www.xemacs.org,207.172.156.133 1024 35 147791117709570226148391879398434809228159132703734105870815018356822921857678284814977059049568661442230855537449309575401577924292090593234020384348603755111614158040736768046345448616336139216350571433289658153595106874705767152078680206376400908833084672875810036607926893168605412877115839848383242787401
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[C] [R21.4] xemacs-21.5-clean: Sync font-lock-add-keywords and font-lock-remove-keywords from GNU Emacs
17 years, 5 months
Adrian Aichner
Adrian Aichner
COMMIT
RECOMMEND 21.4
Many unbundled lisp libraries don't work out-of-the-box due to these
missing functions.
I've had these locally added to my 21.4 build for years.
It's time we close this compatibility gap.
oddmuse.el works out of the box for me with this patch.
Adrian
xemacs-21.5-clean ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: lisp/ChangeLog
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.766
diff -u -U0 -r1.766 ChangeLog
--- lisp/ChangeLog 1 Nov 2006 21:35:35 -0000 1.766
+++ lisp/ChangeLog 1 Nov 2006 23:13:52 -0000
＠＠ -0,0 +1,10 ＠＠
+2006-11-02 Adrian Aichner <adrian(a)xemacs.org>
+
+ * font-lock.el: Sync font-lock-add-keywords and
+ font-lock-remove-keywords from GNU Emacs.
+ * font-lock.el (font-lock-keywords-alist): New.
+ * font-lock.el (font-lock-removed-keywords-alist): New.
+ * font-lock.el (font-lock-add-keywords): New.
+ * font-lock.el (font-lock-update-removed-keyword-alist): New.
+ * font-lock.el (font-lock-remove-keywords): New.
+
xemacs-21.5-clean source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: lisp/font-lock.el
Index: lisp/font-lock.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-lock.el,v
retrieving revision 1.30
diff -u -w -r1.30 font-lock.el
--- lisp/font-lock.el 4 Feb 2006 01:56:06 -0000 1.30
+++ lisp/font-lock.el 1 Nov 2006 23:10:11 -0000
＠＠ -449,6 +449,32 ＠＠
Be very careful composing regexps for this list; the wrong pattern can
dramatically slow things down!
")
+
+(defvar font-lock-keywords-alist nil
+ "Alist of additional `font-lock-keywords' elements for major modes.
+
+Each element has the form (MODE KEYWORDS . HOW).
+`font-lock-set-defaults' adds the elements in the list KEYWORDS to
+`font-lock-keywords' when Font Lock is turned on in major mode MODE.
+
+If HOW is nil, KEYWORDS are added at the beginning of
+`font-lock-keywords'. If it is `set', they are used to replace the
+value of `font-lock-keywords'. If HOW is any other non-nil value,
+they are added at the end.
+
+This is normally set via `font-lock-add-keywords' and
+`font-lock-remove-keywords'.")
+
+(defvar font-lock-removed-keywords-alist nil
+ "Alist of `font-lock-keywords' elements to be removed for major modes.
+
+Each element has the form (MODE . KEYWORDS). `font-lock-set-defaults'
+removes the elements in the list KEYWORDS from `font-lock-keywords'
+when Font Lock is turned on in major mode MODE.
+
+This is normally set via `font-lock-add-keywords' and
+`font-lock-remove-keywords'.")
+
;;;###autoload
(make-variable-buffer-local 'font-lock-keywords)
＠＠ -868,6 +894,188 ＠＠
(setq font-lock-maximum-decoration t)
(font-lock-recompute-variables)))
+(defun font-lock-add-keywords (mode keywords &optional how)
+ "Add highlighting KEYWORDS for MODE.
+
+MODE should be a symbol, the major mode command name, such as `c-mode'
+or nil. If nil, highlighting keywords are added for the current buffer.
+KEYWORDS should be a list; see the variable `font-lock-keywords'.
+By default they are added at the beginning of the current highlighting list.
+If optional argument HOW is `set', they are used to replace the current
+highlighting list. If HOW is any other non-nil value, they are added at the
+end of the current highlighting list.
+
+For example:
+
+ (font-lock-add-keywords 'c-mode
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face)))
+
+adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
+comments, and to fontify `and', `or' and `not' words as keywords.
+
+The above procedure will only add the keywords for C mode, not
+for modes derived from C mode. To add them for derived modes too,
+pass nil for MODE and add the call to c-mode-hook.
+
+For example:
+
+ (add-hook 'c-mode-hook
+ (lambda ()
+ (font-lock-add-keywords nil
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
+ font-lock-keyword-face)))))
+
+The above procedure may fail to add keywords to derived modes if
+some involved major mode does not follow the standard conventions.
+File a bug report if this happens, so the major mode can be corrected.
+
+Note that some modes have specialized support for additional patterns, e.g.,
+see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
+`objc-font-lock-extra-types' and `java-font-lock-extra-types'."
+ (cond (mode
+ ;; If MODE is non-nil, add the KEYWORDS and HOW spec to
+ ;; `font-lock-keywords-alist' so `font-lock-set-defaults' uses them.
+ (let ((spec (cons keywords how)) cell)
+ (if (setq cell (assq mode font-lock-keywords-alist))
+ (if (eq how 'set)
+ (setcdr cell (list spec))
+ (setcdr cell (append (cdr cell) (list spec))))
+ (push (list mode spec) font-lock-keywords-alist)))
+ ;; Make sure that `font-lock-removed-keywords-alist' does not
+ ;; contain the new keywords.
+ (font-lock-update-removed-keyword-alist mode keywords how))
+ (t
+ ;; Otherwise set or add the keywords now.
+ ;; This is a no-op if it has been done already in this buffer
+ ;; for the correct major mode.
+ (font-lock-set-defaults)
+ (let ((was-compiled (eq (car font-lock-keywords) t)))
+ ;; Bring back the user-level (uncompiled) keywords.
+ (if was-compiled
+ (setq font-lock-keywords (cadr font-lock-keywords)))
+ ;; Now modify or replace them.
+ (if (eq how 'set)
+ (setq font-lock-keywords keywords)
+ (font-lock-remove-keywords nil keywords) ;to avoid duplicates
+ (let ((old (if (eq (car-safe font-lock-keywords) t)
+ (cdr font-lock-keywords)
+ font-lock-keywords)))
+ (setq font-lock-keywords (if how
+ (append old keywords)
+ (append keywords old)))))
+ ;; If the keywords were compiled before, compile them again.
+ (if was-compiled
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))))))
+
+(defun font-lock-update-removed-keyword-alist (mode keywords how)
+ "Update `font-lock-removed-keywords-alist' when adding new KEYWORDS to MODE."
+ ;; When font-lock is enabled first all keywords in the list
+ ;; `font-lock-keywords-alist' are added, then all keywords in the
+ ;; list `font-lock-removed-keywords-alist' are removed. If a
+ ;; keyword was once added, removed, and then added again it must be
+ ;; removed from the removed-keywords list. Otherwise the second add
+ ;; will not take effect.
+ (let ((cell (assq mode font-lock-removed-keywords-alist)))
+ (if cell
+ (if (eq how 'set)
+ ;; A new set of keywords is defined. Forget all about
+ ;; our old keywords that should be removed.
+ (setq font-lock-removed-keywords-alist
+ (delq cell font-lock-removed-keywords-alist))
+ ;; Delete all previously removed keywords.
+ (dolist (kword keywords)
+ (setcdr cell (delete kword (cdr cell))))
+ ;; Delete the mode cell if empty.
+ (if (null (cdr cell))
+ (setq font-lock-removed-keywords-alist
+ (delq cell font-lock-removed-keywords-alist)))))))
+
+;; Written by Anders Lindgren <andersl(a)andersl.com>.
+;;
+;; Case study:
+;; (I) The keywords are removed from a major mode.
+;; In this case the keyword could be local (i.e. added earlier by
+;; `font-lock-add-keywords'), global, or both.
+;;
+;; (a) In the local case we remove the keywords from the variable
+;; `font-lock-keywords-alist'.
+;;
+;; (b) The actual global keywords are not known at this time.
+;; All keywords are added to `font-lock-removed-keywords-alist',
+;; when font-lock is enabled those keywords are removed.
+;;
+;; Note that added keywords are taken out of the list of removed
+;; keywords. This ensure correct operation when the same keyword
+;; is added and removed several times.
+;;
+;; (II) The keywords are removed from the current buffer.
+(defun font-lock-remove-keywords (mode keywords)
+ "Remove highlighting KEYWORDS for MODE.
+
+MODE should be a symbol, the major mode command name, such as `c-mode'
+or nil. If nil, highlighting keywords are removed for the current buffer.
+
+To make the removal apply to modes derived from MODE as well,
+pass nil for MODE and add the call to MODE-hook. This may fail
+for some derived modes if some involved major mode does not
+follow the standard conventions. File a bug report if this
+happens, so the major mode can be corrected."
+ (cond (mode
+ ;; Remove one keyword at the time.
+ (dolist (keyword keywords)
+ (let ((top-cell (assq mode font-lock-keywords-alist)))
+ ;; If MODE is non-nil, remove the KEYWORD from
+ ;; `font-lock-keywords-alist'.
+ (when top-cell
+ (dolist (keyword-list-how-pair (cdr top-cell))
+ ;; `keywords-list-how-pair' is a cons with a list of
+ ;; keywords in the car top-cell and the original how
+ ;; argument in the cdr top-cell.
+ (setcar keyword-list-how-pair
+ (delete keyword (car keyword-list-how-pair))))
+ ;; Remove keyword list/how pair when the keyword list
+ ;; is empty and how doesn't specify `set'. (If it
+ ;; should be deleted then previously deleted keywords
+ ;; would appear again.)
+ (let ((cell top-cell))
+ (while (cdr cell)
+ (if (and (null (car (car (cdr cell))))
+ (not (eq (cdr (car (cdr cell))) 'set)))
+ (setcdr cell (cdr (cdr cell)))
+ (setq cell (cdr cell)))))
+ ;; Final cleanup, remove major mode cell if last keyword
+ ;; was deleted.
+ (if (null (cdr top-cell))
+ (setq font-lock-keywords-alist
+ (delq top-cell font-lock-keywords-alist))))
+ ;; Remember the keyword in case it is not local.
+ (let ((cell (assq mode font-lock-removed-keywords-alist)))
+ (if cell
+ (unless (member keyword (cdr cell))
+ (nconc cell (list keyword)))
+ (push (cons mode (list keyword))
+ font-lock-removed-keywords-alist))))))
+ (t
+ ;; Otherwise remove it immediately.
+ (font-lock-set-defaults)
+ (let ((was-compiled (eq (car font-lock-keywords) t)))
+ ;; Bring back the user-level (uncompiled) keywords.
+ (if was-compiled
+ (setq font-lock-keywords (cadr font-lock-keywords)))
+
+ ;; Edit them.
+ (setq font-lock-keywords (copy-sequence font-lock-keywords))
+ (dolist (keyword keywords)
+ (setq font-lock-keywords
+ (delete keyword font-lock-keywords)))
+
+ ;; If the keywords were compiled before, compile them again.
+ (if was-compiled
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))))))
;;;;;;;;;;;;;;;;;;;;;; actual code ;;;;;;;;;;;;;;;;;;;;;;
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[C] xemacs-21.5-clean: minibuffer resizing based on echo area size
17 years, 5 months
Adrian Aichner
Adrian Aichner
COMMIT
Larsi, you may be interested in this too.
All, please send me your feedback and problem reports.
I have always felt uneasy about answering questions like:
Please answer y or n. File `c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean
Now the question is:
Please answer y or n. File `c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\xemacs-21.5-clean-make-all.err' exists; overwrite? (y or n)
which is a bit easier to answer :-)
The full CahngeLog entry is:
2006-10-28 Adrian Aichner <adrian(a)xemacs.org>
* simple.el (raw-append-message): Implement minibuffer resizing
based on requirements of echo area content.
The diff is a result of an earlier accidental commit (._.)
Adrian
xemacs-21.5-clean ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: lisp/ChangeLog
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.765
diff -u -U0 -r1.765 ChangeLog
--- lisp/ChangeLog 1 Nov 2006 20:55:14 -0000 1.765
+++ lisp/ChangeLog 1 Nov 2006 21:20:23 -0000
＠＠ -0,0 +1,4 ＠＠
+2006-11-01 Adrian Aichner <adrian(a)xemacs.org>
+
+ * simple.el (raw-append-message):
+
＠＠ -4 +8 ＠＠
- based on requirements filled echo area content.
+ based on requirements of echo area content.
xemacs-21.5-clean source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: lisp/simple.el
===================================================================
RCS
Index: lisp/simple.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/simple.el,v
retrieving revision 1.55
diff -u -w -r1.55 simple.el
--- lisp/simple.el 25 Apr 2006 19:46:24 -0000 1.55
+++ lisp/simple.el 1 Nov 2006 21:20:06 -0000
＠＠ -4301,7 +4301,16 ＠＠
(defun raw-append-message (message &optional frame stdout-p)
(unless (equal message "")
(let ((inhibit-read-only t))
- (insert-string message " *Echo Area*")
+ (with-current-buffer " *Echo Area*"
+ (insert-string message)
+ ;; (fill-region (point-min) (point-max))
+ (enlarge-window
+ (-
+ (ceiling
+ (/ (- (point-max) (point-min))
+ (- (window-width (minibuffer-window)) 1.0)))
+ (window-height (minibuffer-window)))
+ nil (minibuffer-window)))
;; Conditionalizing on the device type in this way is not that clean,
;; but neither is having a device method, as I originally implemented
;; it: all non-stream devices behave in the same way. Perhaps
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[C] xemacs-21.5-clean: Stylistic change to TUTORIAL.de
17 years, 5 months
Adrian Aichner
Adrian Aichner
COMMIT
xemacs-21.5-clean ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: etc/ChangeLog
Index: etc/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/ChangeLog,v
retrieving revision 1.74
diff -u -U0 -r1.74 ChangeLog
--- etc/ChangeLog 19 Jul 2006 15:22:37 -0000 1.74
+++ etc/ChangeLog 1 Nov 2006 20:40:13 -0000
＠＠ -0,0 +1,5 ＠＠
+2006-10-08 Adrian Aichner <adrian(a)xemacs.org>
+
+ * TUTORIAL.de: Small rephrasing as suggested by hroptatyr on
+ #xemacs.
+
xemacs-21.5-clean source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: etc/TUTORIAL.de
===================================================================
RCS
Index: etc/TUTORIAL.de
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/TUTORIAL.de,v
retrieving revision 1.6
diff -u -w -r1.6 TUTORIAL.de
--- etc/TUTORIAL.de 13 Mar 2002 08:51:25 -0000 1.6
+++ etc/TUTORIAL.de 1 Nov 2006 20:39:19 -0000
＠＠ -272,9 +272,9 ＠＠
>> Bewege den Textzeiger mittels <Down> oder <Up> auf die mittlere Zeile
der obigen Tabelle. Dann zentriere das Diagramm mittels C-l im
- Bildschirmfenster. (Bitte erinnere Dich, daß TTY Benutzer,wenn
- nötig, die entsprechenden TTY-Befehle benutzen sollten. In diesem
- Fall sind dies C-n und C-p.)
+ Bildschirmfenster. (Zur Erinnerung: TTY Benutzer sollten, wenn
+ nötig, die entsprechenden TTY-Befehle benutzen. In diesem Fall
+ sind dies C-n und C-p.)
Bitte beachte die mnemonische Bedeutung der TTY-Befehle (im
Englischen): P für previous, N für next, B für backward und F für
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments