6:09 p.m.
User: stephent
Date: 05/03/05 19:09:34
Modified: xemacs/src Tag: sjt-xft ChangeLog EmacsShell-sub.c faces.c
faces.h frame-x.c lisp.h objects-impl.h objects-x.c
objects.c objects.h xft-fonts.c xft-fonts.h
Log:
refactor charset/lang <87d5uermts.fsf(a)tleepslib.sk.tsukuba.ac.jp>
Revision Changes Path
No revision
No revision
1.599.2.5 +18 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.599.2.4
retrieving revision 1.599.2.5
diff -u -r1.599.2.4 -r1.599.2.5
--- ChangeLog 2005/03/01 13:14:00 1.599.2.4
+++ ChangeLog 2005/03/05 18:09:20 1.599.2.5
＠＠ -1,3 +1,21 ＠＠
+2005-03-02 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * font.el (font-running-xemacs): Remove definition.
+ (font-x-font-regexp):
+ (font-x-registry-and-encoding-regexp):
+ (font-default-font-for-device):
+ (x-font-create-name-core):
+ (mswindows-font-create-name):
+ (font-set-face-font):
+ (font-blink-callback):
+ Remove references.
+
+ (define-font-keywords): Remove definition and top-level references.
+
+ (set-font-style-by-keywords):
+ (font-properties-from-style):
+ Comment out.
+
2005-03-01 Aidan Kehoe <kehoea(a)parhasard.net>
General cleanup of references to functions Eric has deleted
1.15.2.3 +72 -68 XEmacs/xemacs/lisp/font.el
Index: font.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font.el,v
retrieving revision 1.15.2.2
retrieving revision 1.15.2.3
diff -u -r1.15.2.2 -r1.15.2.3
--- font.el 2005/03/01 13:14:01 1.15.2.2
+++ font.el 2005/03/05 18:09:21 1.15.2.3
＠＠ -29,6 +29,18 ＠＠
;;; Commentary:
+;; This file is totally bogus in the context of Emacs. Much of what it does
+;; is really in the provice of faces (for example all the style parameters),
+;; and that's the way it is in GNU Emacs.
+;;
+;; What is needed for fonts at the Lisp level is a consistent way to access
+;; face properties that are actually associated with fonts for some rendering
+;; engine, in other words, the kinds of facilities provided by fontconfig
+;; patterns. We just need to provide an interface to looking up, storing,
+;; and manipulating font specifications with certain properties. There will
+;; be some engine-specific stuff, like the bogosity of X11's character set
+;; registries.
+
;;; Code:
(globally-declare-fboundp
＠＠ -96,23 +108,14 ＠＠
;;; Lots of variables / keywords for use later in the program
;;; Not much should need to be modified
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst font-running-xemacs (string-match "XEmacs" (emacs-version))
- "Whether we are running in XEmacs or not.")
-
-(defmacro define-font-keywords (&rest keys)
- `(eval-and-compile
- (let ((keywords (quote ,keys)))
- (while keywords
- (or (boundp (car keywords))
- (set (car keywords) (car keywords)))
- (setq keywords (cdr keywords))))))
-
+;; #### These aren't window system mappings
(defconst font-window-system-mappings
'((x . (x-font-create-name x-font-create-object))
(gtk . (x-font-create-name x-font-create-object))
(ns . (ns-font-create-name ns-font-create-object))
(mswindows . (mswindows-font-create-name mswindows-font-create-object))
(pm . (x-font-create-name x-font-create-object)) ; Change? FIXME
+ ;; #### what is this bogosity?
(tty . (tty-font-create-plist tty-font-create-object)))
"An assoc list mapping device types to a list of translations.
＠＠ -155,12 +158,11 ＠＠
"How much a font is allowed to vary from the desired size.")
;; Canonical (internal) sizes are in points.
-;; Registry
-(define-font-keywords :family :style :size :registry :encoding)
-(define-font-keywords
- :weight :extra-light :light :demi-light :medium :normal :demi-bold
- :bold :extra-bold)
+;; Property keywords: :family :style :size :registry :encoding :weight
+;; Weight keywords: :extra-light :light :demi-light :medium
+;; :normal :demi-bold :bold :extra-bold
+;; See GNU Emacs 21.4 for more properties and keywords we should support
(defvar font-style-keywords nil)
＠＠ -268,27 +270,31 ＠＠
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utility functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun set-font-style-by-keywords (fontobj styles)
- (make-local-variable 'font-func)
- (declare (special font-func))
- (if (listp styles)
- (while styles
- (setq font-func (car-safe (cdr-safe (assq (car styles) font-style-keywords)))
- styles (cdr styles))
- (and (fboundp font-func) (funcall font-func fontobj t)))
- (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords))))
- (and (fboundp font-func) (funcall font-func fontobj t))))
-
-(defun font-properties-from-style (fontobj)
- (let ((todo font-style-keywords)
- type func retval)
- (while todo
- (setq func (cdr (cdr (car todo)))
- type (car (pop todo)))
- (if (funcall func fontobj)
- (setq retval (cons type retval))))
- retval))
+;; #### unused?
+; (defun set-font-style-by-keywords (fontobj styles)
+; (make-local-variable 'font-func)
+; (declare (special font-func))
+; (if (listp styles)
+; (while styles
+; (setq font-func (car-safe (cdr-safe (assq (car styles)
+; font-style-keywords)))
+; styles (cdr styles))
+; (and (fboundp font-func) (funcall font-func fontobj t)))
+; (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords))))
+; (and (fboundp font-func) (funcall font-func fontobj t))))
+
+;; #### unused?
+; (defun font-properties-from-style (fontobj)
+; (let ((todo font-style-keywords)
+; type func retval)
+; (while todo
+; (setq func (cdr (cdr (car todo)))
+; type (car (pop todo)))
+; (if (funcall func fontobj)
+; (setq retval (cons type retval))))
+; retval))
+;; #### only used in this file; maybe there's a cl.el function?
(defun font-unique (list)
(let ((retval)
(cur))
＠＠ -475,9 +481,8 ＠＠
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The window-system dependent code (X-style)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar font-x-font-regexp (or (and font-running-xemacs
- (boundp 'x-font-regexp)
- x-font-regexp)
+(defvar font-x-font-regexp (when (and (boundp 'x-font-regexp)
+ x-font-regexp)
(let
((- "[-?]")
(foundry "[^-]*")
＠＠ -504,13 +509,12 ＠＠
))))
(defvar font-x-registry-and-encoding-regexp
- (or (and font-running-xemacs
- (boundp 'x-font-regexp-registry-and-encoding)
- (symbol-value 'x-font-regexp-registry-and-encoding))
- (let ((- "[-?]")
- (registry "[^-]*")
- (encoding "[^-]+"))
- (concat - "\\(" registry "\\)" - "\\(" encoding
"\\)\\'"))))
+ (when (and (boundp 'x-font-regexp-registry-and-encoding)
+ (symbol-value 'x-font-regexp-registry-and-encoding))
+ (let ((- "[-?]")
+ (registry "[^-]*")
+ (encoding "[^-]+"))
+ (concat - "\\(" registry "\\)" - "\\(" encoding
"\\)\\'"))))
(defvar font-x-family-mappings
'(
＠＠ -638,14 +642,13 ＠＠
;;;###autoload
(defun font-default-font-for-device (&optional device)
(or device (setq device (selected-device)))
- (if font-running-xemacs
- (font-truename
- (make-font-specifier
- (face-font-name 'default device)))
+ (font-truename
+ (make-font-specifier
+ (face-font-name 'default device)))
(let ((font (cdr-safe (assq 'font (frame-parameters device)))))
(if (and (fboundp 'fontsetp) (fontsetp font))
(aref (get-font-info (aref (cdr (get-fontset-info font)) 0)) 2)
- font))))
+ font)))
;;;###autoload
(defun font-default-object-for-device (&optional device)
＠＠ -702,8 +705,7 ＠＠
(font-family default)
(x-font-families-for-device device)))
(weight (or (font-weight fontobj) :medium))
- (size (or (if font-running-xemacs
- (font-size fontobj))
+ (size (or (font-size fontobj)
(font-size default)))
(registry (or (font-registry fontobj)
(font-registry default)
＠＠ -916,8 +918,7 ＠＠
(family (or (font-family fontobj)
(font-family default)))
(weight (or (font-weight fontobj) :regular))
- (size (or (if font-running-xemacs
- (font-size fontobj))
+ (size (or (font-size fontobj)
(font-size default)))
(underline-p (font-underline-p fontobj))
(strikeout-p (font-strikethru-p fontobj))
＠＠ -1013,7 +1014,7 ＠＠
(setq cur (car font-name)
font-name (cdr font-name))
(apply 'set-face-property face (car cur) (cdr cur) args))))
- (font-running-xemacs
+ (t
(apply 'set-face-font face font-name args)
(apply 'set-face-underline-p face (font-underline-p font) args)
(if (and (or (font-smallcaps-p font) (font-bigcaps-p font))
＠＠ -1024,16 +1025,18 ＠＠
(font-linethrough-p font)
(font-strikethru-p font))
args))
- (t
- (condition-case nil
- (apply 'set-face-font face font-name args)
- (error
- (let ((args (car-safe args)))
- (and (or (font-bold-p font)
- (memq (font-weight font) '(:bold :demi-bold)))
- (make-face-bold face args t))
- (and (font-italic-p font) (make-face-italic face args t)))))
- (apply 'set-face-underline-p face (font-underline-p font) args)))))
+;;; this used to be default with preceding conditioned on font-running-xemacs
+; (t
+; (condition-case nil
+; (apply 'set-face-font face font-name args)
+; (error
+; (let ((args (car-safe args)))
+; (and (or (font-bold-p font)
+; (memq (font-weight font) '(:bold :demi-bold)))
+; (make-face-bold face args t))
+; (and (font-italic-p font) (make-face-italic face args t)))))
+; (apply 'set-face-underline-p face (font-underline-p font) args))
+ )))
(t
;; Let the original set-face-font signal any errors
(set-face-property face 'font-specification nil)
＠＠ -1408,13 +1411,14 ＠＠
(defun font-blink-callback ()
;; Optimized to never invert the face unless one of the visible windows
;; is showing it.
- (let ((faces (if font-running-xemacs (face-list t) (face-list)))
+ (let ((faces (face-list t))
(obj nil))
(while faces
(if (and (setq obj (face-property (car faces) 'font-specification))
(font-blink-p obj)
(memq t
- (font-map-windows 'font-face-visible-in-window-p (car faces))))
+ (font-map-windows 'font-face-visible-in-window-p
+ (car faces))))
(invert-face (car faces)))
(pop faces))))
No revision
No revision
1.758.2.16 +56 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.758.2.15
retrieving revision 1.758.2.16
diff -u -r1.758.2.15 -r1.758.2.16
--- ChangeLog 2005/02/24 11:08:24 1.758.2.15
+++ ChangeLog 2005/03/05 18:09:25 1.758.2.16
＠＠ -1,3 +1,59 ＠＠
+2005-03-05 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ Refactor language/charset checking in Xft.
+
+ * objects-x.c (struct charset_reporter): New type.
+ (charset_table): New internal table.
+ (DEBUG_XFT0):
+ (DEBUG_XFT1):
+ (DEBUG_XFT2):
+ (PRINT_XFT_PATTERN):
+ (CHECKING_LANG):
+ New debugging macros.
+ (mule_to_fc_charset): New function.
+ (x_find_charset_font): Completely rewrite Xft part using the above.
+
+ Cache knowledge of charset in font instances.
+
+ * objects-impl.h (struct Lisp_Font_Instance): New member charset.
+ Update comment on use of truename.
+ * objects.c (syms_of_objects): DEFSUBR Ffont_instance_charset.
+ (Ffont_instance_charset): New accessor.
+ (Fmake_font_instance): New argument CHARSET, update charset member.
+ (font_instantiate): Update call to Fmake_font_instance.
+ (font_instance_description): Add charset member.
+ * objects.h (Fmake_font_instance): Update EXFUN.
+ (Ffont_instance_charset): New EXFUN.
+
+ Make Xft debug level adjustable from Lisp.
+
+ * xft-fonts.c (vars_of_xft_fonts): New DEFVAR_INT
+ xft-debug-level (from debug_xft), adjust style of xft-version.
+ * xft-fonts.h (debug_xft): Now Lisp-visible, change declaration.
+
+ Miscellaneous.
+
+ * lisp.h (Vcharset_iso8859_15): Export it.
+ * faces.h (struct face_cachel): Update comment on space usage.
+ * faces.c: Comment proposed changes to improve font handling.
+ * frame-x.c:
+ * EmacsShell-sub.c:
+ Disable geometry debugging.
+
+2005-02-24 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * xft-fonts.h:
+ * xft-fonts.c:
+ Update copyright notices.
+
+ * xft.fonts.h (string_list_to_fcobjectset):
+ (extract_fcapi_string):
+ Delete; static function declarations don't belong in headers.
+
+ * xft.fonts.c (string_list_to_fcobjectset):
+ (extract_fcapi_string):
+ Declare.
+
2005-02-24 Stephen J. Turnbull <stephen(a)xemacs.org>
* objects-x.c (x_find_charset_font): ConfigSubstitute in the
1.6.2.2 +0 -1 XEmacs/xemacs/src/EmacsShell-sub.c
Index: EmacsShell-sub.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/EmacsShell-sub.c,v
retrieving revision 1.6.2.1
retrieving revision 1.6.2.2
diff -u -r1.6.2.1 -r1.6.2.2
--- EmacsShell-sub.c 2005/02/01 15:46:52 1.6.2.1
+++ EmacsShell-sub.c 2005/03/05 18:09:28 1.6.2.2
＠＠ -245,7 +245,6 ＠＠
cell_height = w->wm.size_hints.height_inc;
base_width = width - cell_width * w->emacs_shell.width_cells;
base_height = height - cell_height * w->emacs_shell.height_cells;
-#define DEBUG_GEOMETRY_MANAGEMENT
#ifdef DEBUG_GEOMETRY_MANAGEMENT
/* Very useful info when debugging geometry management problems.
When it's guaranteed that no more such problems exist, take
1.43.2.4 +11 -3 XEmacs/xemacs/src/faces.c
Index: faces.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v
retrieving revision 1.43.2.3
retrieving revision 1.43.2.4
diff -u -r1.43.2.3 -r1.43.2.4
--- faces.c 2005/02/24 09:32:27 1.43.2.3
+++ faces.c 2005/03/05 18:09:28 1.43.2.4
＠＠ -1033,8 +1033,11 ＠＠
}
/* ensure that the given cachel contains an updated font value for
- the given charset. Return the updated font value. */
+ the given charset. Return the updated font value (which can be
+ Qunbound, so this value must not be passed unchecked to Lisp).
+ #### Xft: This function will need to be updated for new font model. */
+
Lisp_Object
ensure_face_cachel_contains_charset (struct face_cachel *cachel,
Lisp_Object domain, Lisp_Object charset)
＠＠ -1384,6 +1387,7 ＠＠
}
/* Initialize a cachel. */
+/* #### Xft: this function will need to be changed for new font model. */
void
reset_face_cachel (struct face_cachel *cachel)
＠＠ -1465,6 +1469,7 ＠＠
Dynarr_atp (w->face_cachels, elt)->dirty = 0;
}
+/* #### Xft: this function will need to be changed for new font model. */
void
mark_face_cachels_as_not_updated (struct window *w)
{
＠＠ -2019,7 +2024,9 ＠＠
/* Note that fontconfig can search for several font families in one
call. We should use this facility. */
"monospace-12", /* Western #### add encoding info? */
- /* do we need to worry about non-Latin characters for monospace? */
+ /* 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? */
/* Arphic for Chinese? */
/* Korean */
＠＠ -2107,7 +2114,8 ＠＠
charset. (#### Bogus, but that's the way it currently works)
sjt sez: With Xft/fontconfig that information is available as a
- language support property. So what we need to do is to map charset
+ 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.
1.12.8.2 +3 -1 XEmacs/xemacs/src/faces.h
Index: faces.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.h,v
retrieving revision 1.12.8.1
retrieving revision 1.12.8.2
diff -u -r1.12.8.1 -r1.12.8.2
--- faces.h 2004/11/25 12:44:13 1.12.8.1
+++ faces.h 2005/03/05 18:09:28 1.12.8.2
＠＠ -161,7 +161,9 ＠＠
of them. This avoids messing with Dynarrs.
#### We should look into this and probably clean it up
- to use Dynarrs. This may be a big space hog as is. */
+ to use Dynarrs. This may be a big space hog as is.
+ sjt sez: doesn't look like it, my total face cache is 170KB.
+ Could be reduced to maybe 50KB. */
Lisp_Object font[NUM_LEADING_BYTES];
Lisp_Object display_table;
1.68.2.3 +0 -1 XEmacs/xemacs/src/frame-x.c
Index: frame-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-x.c,v
retrieving revision 1.68.2.2
retrieving revision 1.68.2.3
diff -u -r1.68.2.2 -r1.68.2.3
--- frame-x.c 2005/02/01 15:46:54 1.68.2.2
+++ frame-x.c 2005/03/05 18:09:28 1.68.2.3
＠＠ -283,7 +283,6 ＠＠
if (!XtIsWMShell (wmshell))
abort ();
-#define DEBUG_GEOMETRY_MANAGEMENT
#ifdef DEBUG_GEOMETRY_MANAGEMENT
/* See comment in EmacsShell.c */
printf ("x_wm_set_variable_size: %d %d\n", width, height);
1.116.2.2 +1 -0 XEmacs/xemacs/src/lisp.h
Index: lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.116.2.1
retrieving revision 1.116.2.2
diff -u -r1.116.2.1 -r1.116.2.2
--- lisp.h 2004/12/11 05:16:19 1.116.2.1
+++ lisp.h 2005/03/05 18:09:29 1.116.2.2
＠＠ -4851,6 +4851,7 ＠＠
extern Lisp_Object Vcharset_latin_jisx0201;
extern Lisp_Object Vcharset_cyrillic_iso8859_5;
extern Lisp_Object Vcharset_latin_iso8859_9;
+extern Lisp_Object Vcharset_latin_iso8859_15;
extern Lisp_Object Vcharset_japanese_jisx0208_1978;
extern Lisp_Object Vcharset_chinese_gb2312;
extern Lisp_Object Vcharset_japanese_jisx0208;
1.3.2.1 +9 -2 XEmacs/xemacs/src/objects-impl.h
Index: objects-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-impl.h,v
retrieving revision 1.3
retrieving revision 1.3.2.1
diff -u -r1.3 -r1.3.2.1
--- objects-impl.h 2003/01/12 11:08:19 1.3
+++ objects-impl.h 2005/03/05 18:09:29 1.3.2.1
＠＠ -125,8 +125,13 ＠＠
call them to get the truename (#### in reality,
they all probably just store the truename here
if they know it, and nil otherwise; we should
- check this and enforce it as a general policy) */
+ check this and enforce it as a general policy
+ X and GTK do this, except that when they don't
+ know they return NAME and don't update TRUENAME.
+ MS Windows initializes TRUENAME when the font is
+ initialized. TTY doesn't do truename.) */
Lisp_Object device;
+ Lisp_Object charset; /* Mule charset, or whatever */
/* See comment in struct console about console variants. */
enum console_variant font_instance_type;
＠＠ -142,7 +147,8 ＠＠
};
#define FONT_INSTANCE_NAME(f) ((f)->name)
-#define FONT_INSTANCE_TRUENAME(f) ((f)->name)
+#define FONT_INSTANCE_TRUENAME(f) ((f)->truename)
+#define FONT_INSTANCE_CHARSET(f) ((f)->charset)
#define FONT_INSTANCE_DEVICE(f) ((f)->device)
#define FONT_INSTANCE_ASCENT(f) ((f)->ascent)
#define FONT_INSTANCE_DESCENT(f) ((f)->descent)
＠＠ -151,6 +157,7 ＠＠
#define XFONT_INSTANCE_NAME(f) FONT_INSTANCE_NAME (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_TRUENAME(f) FONT_INSTANCE_TRUENAME (XFONT_INSTANCE (f))
+#define XFONT_INSTANCE_CHARSET(f) FONT_INSTANCE_CHARSET (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_DEVICE(f) FONT_INSTANCE_DEVICE (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_ASCENT(f) FONT_INSTANCE_ASCENT (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_DESCENT(f) FONT_INSTANCE_DESCENT (XFONT_INSTANCE (f))
1.26.2.10 +232 -94 XEmacs/xemacs/src/objects-x.c
Index: objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.26.2.9
retrieving revision 1.26.2.10
diff -u -r1.26.2.9 -r1.26.2.10
--- objects-x.c 2005/02/24 11:08:27 1.26.2.9
+++ objects-x.c 2005/03/05 18:09:29 1.26.2.10
＠＠ -1019,8 +1019,114 ＠＠
return buffer;
}
}
-#endif
+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;
+}
+
+/* print message to stderr: one string argument */
+#define DEBUG_XFT0(level,s) \
+ if (debug_xft > level) stderr_out (s)
+
+/* print message to stderr: one formatted string argument */
+#define DEBUG_XFT1(level,format,s) \
+ if (debug_xft > level) stderr_out (format, s)
+
+/* print message to stderr: two formatted string arguments */
+#define DEBUG_XFT2(level,format,s1,s2) \
+ if (debug_xft > level) stderr_out (format, s1, s2)
+
+/* 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
+ PATTERN is an FcPattern *. */
+#define PRINT_XFT_PATTERN(level,format,pattern) \
+ do { \
+ FcChar8 *name = FcNameUnparse (pattern); \
+ DEBUG_XFT1 (level, format, name); \
+ free (name); \
+ } while (0)
+
+/* print a progress message
+ LEVEL is the debug level (to compare to debug_xft)
+ FORMAT is a newline-terminated printf format with two %s for font and lang
+ FONT is the Xft font
+ LANG is the language being checked for support. */
+#define CHECKING_LANG(level,font,lang) \
+ DEBUG_XFT2 (level, "checking if %s handles %s\n", font, lang)
+
+struct charset_reporter {
+ Lisp_Object *charset;
+ /* #### Mule-ize these strings? */
+ Extbyte *language;
+ FcChar8 *rfc3066;
+};
+
+static struct charset_reporter charset_table[] =
+ {
+ /* #### it's my branch, my favorite charsets get checked first */
+ { &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", "gr" },
+ { &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, NULL, NULL },
+ { &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 }
+ };
+
+#endif /* USE_XFT */
+
/* find a font spec that matches font spec FONT and also matches
(the registry of) CHARSET. */
static Lisp_Object
＠＠ -1044,126 +1150,158 ＠＠
if (stage)
return Qnil;
+#ifdef USE_XFT
/* #### does Xft permit/require a different encoding? */
LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding);
-#ifdef USE_XFT
- if (debug_xft > 1)
- stderr_out ("confirming charset for font instance %s\n", patternext);
- /* #### totally lazy, let's just get something out the door */
+ DEBUG_XFT1 (1, "confirming charset for font instance %s\n", patternext);
+
+ /* #### this looks like a fair amount of work, but the basic design
+ has never been rethought, and it should be
+
+ #### ALL THE OBJECTS CONSTRUCTED BY FcName(Un)Parse MUST BE FREED!
+ */
+
waste = FcInit ();
- if (waste) /* I don't think this can fail */
+ if (!waste && debug_xft > 0) /* I don't think this can fail */
/* #### should we init in xft_fonts_init()
and FcInitBringUpToDate() here? */
+ stderr_out ("Failed fontconfig initialization\n");
+ else if (waste)
{
FcChar8 *lang = "en";
+ FcCharSet *fccs = NULL;
+ FcChar8 *shortname;
+
fcc = FcConfigGetCurrent ();
- patternxft = FcNameParse (patternext);
- if (debug_xft > 1)
- stderr_out ("FcNameParse'ed name is %s\n",
- FcNameUnparse (patternxft));
+ patternxft = FcNameParse (patternext); /* #### needs freeing */
+ PRINT_XFT_PATTERN (1,"FcNameParse'ed name is %s\n",patternxft);
/* #### Next two return FcBool, but what does the return mean? */
- /* #### I wonder if the order of the next two should be reversed. */
+ /* The order is correct according the fontconfig docs. */
FcConfigSubstitute (fcc, patternxft, FcMatchPattern);
- if (debug_xft > 1)
- stderr_out ("FcConfigSubstitute'ed name is %s\n",
- FcNameUnparse (patternxft));
+ PRINT_XFT_PATTERN (0,"FcConfigSubstitute'ed name is
%s\n",patternxft);
FcDefaultSubstitute (patternxft);
- if (debug_xft > 0)
- stderr_out ("FcDefaultSubstitute'ed name is %s\n",
- FcNameUnparse (patternxft));
+ PRINT_XFT_PATTERN (1,"FcDefaultSubstitute'ed name is
%s\n",patternxft);
patternxft = FcFontMatch (fcc, patternxft, &fcresult);
- if (debug_xft > 0)
- stderr_out ("FcFontMatch'ed name is %s\n",
- FcNameUnparse (patternxft));
-
- /* #### There's probably a way to do this with FcCharsets, but isn't
- the language approach better in the long run? */
- /* #### can we regression test this, or does it break too early? */
- if (EQ (charset, Fget_charset (intern ("katakana-jisx0201")))
- || EQ (charset, Fget_charset (intern ("japanese-jisx0208")))
- || EQ (charset, Fget_charset (intern ("japanese-jisx0212"))))
+ PRINT_XFT_PATTERN (0,"FcFontMatch'ed name is %s\n",patternxft);
+
+ /* heuristic to give reasonable-length names */
+ {
+ FcPattern *p = FcFontRenderPrepare (fcc, patternxft, patternxft);
+ FcPatternDel (p, FC_CHARSET);
+ FcPatternDel (p, FC_LANG);
+ shortname = FcNameUnparse (p); /* #### needs freeing */
+ 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. */
+
+ struct charset_reporter *cr;
+ for (cr = charset_table;
+ cr->charset && !EQ (*(cr->charset), charset);
+ cr++)
+ ;
+
+ if (cr->rfc3066)
{
- if (debug_xft > 0)
- stderr_out ("checking if %s handles Japanese\n", patternext);
- lang = "ja";
+ CHECKING_LANG (0, shortname, cr->language);
+ lang = cr->rfc3066;
}
- else if (EQ (charset, Fget_charset (intern ("ascii"))))
+ else if (cr->charset)
{
- if (debug_xft > 0)
- stderr_out ("checking if %s handles English\n", patternext);
- lang = "en";
+ /* #### what the hey, build 'em on the fly */
+ /* #### in the case of error this could return NULL! */
+ fccs = mule_to_fc_charset (charset);
+ lang = XSTRING_DATA (XSYMBOL (XCHARSET_NAME (charset))-> name);
}
else
{
- /* #### is this the right way to make a warning? */
+ /* OK, we fell off the end of the table */
warn_when_safe_lispobj (intern ("xft"), intern ("alert"),
list2 (build_string ("unchecked charset"),
charset));
+ /* #### THIS IS WRONG, WRONG, WRONG!!
+ It is why we never fall through to XLFD-checking. */
/* default to "en" */
}
- /* #### stderr_out crashed in the next block; why?
- probably because FcTypeOfValueToString below didn't get
- an argument!! Fixed now, but watch for crashes. */
- {
- int i = 0;
- FcValue v;
- /* the main event */
- FcResult r = FcPatternGet (patternxft, FC_LANG, i, &v);
- if (r == FcResultMatch)
- {
- if (v.type != FcTypeLangSet) /* excessive paranoia */
- {
- /* Urk! Fall back and punt to core font. */
- if (debug_xft > 0)
- stderr_out ("Unexpected type of lang value (%s)\n",
- FcTypeOfValueToString (v));
- /* uncomment this to not try core font */
- /* return Qnil; */
- }
- else if (FcLangSetHasLang (v.u.l, lang) != FcLangDifferentLang)
- {
- if (debug_xft > 0)
- stderr_out ("Xft font %s supports %s\n", patternext, lang);
- /* heuristic to give reasonable-length names */
- FcPatternDel (patternxft, FC_CHARSET);
- FcPatternDel (patternxft, FC_LANG);
- return (build_string (FcNameUnparse (patternxft)));
- }
- /* assume everything supports English */
-#if 0
- /* KLUDGE!! */
- else if (!strcmp (lang, "en"))
- {
- if (debug_xft > 0)
- stderr_out ("Xft font %s doesn't support en, using anyway\n",
- patternext);
- /* heuristic to give reasonable-length names */
- FcPatternDel (patternxft, FC_CHARSET);
- FcPatternDel (patternxft, FC_LANG);
- return (build_string (FcNameUnparse (patternxft)));
- }
-#endif
- else
- {
- if (debug_xft > 0)
- stderr_out ("Xft font %s doesn't support %s\n",
- patternext, lang);
- return Qnil;
- }
- }
- if (debug_xft > 0)
- stderr_out ("Unexpected result getting lang=%s\n",
- FcResultToString (r));
- }
+ if (fccs)
+ {
+ /* check for character set coverage */
+ Lisp_Object retval = Qunbound;
+ int i = 0;
+ FcCharSet *v;
+ FcResult r = FcPatternGetCharSet (patternxft, FC_CHARSET, i, &v);
+
+ if (r == FcResultTypeMismatch)
+ {
+ /* Urk! Fall back and punt to core font. */
+ DEBUG_XFT0 (0, "Unexpected type return in charset value\n");
+ /* uncomment this to not try core font */
+ /* retval = Qnil; */
+ }
+ else if (r == FcResultMatch && FcCharSetIsSubset (fccs, v))
+ {
+ DEBUG_XFT2 (0, "Xft font %s supports %s\n", shortname, lang);
+ /* #### would it be better to return shortname? */
+ retval = (build_string (FcNameUnparse (patternxft)));
+ }
+ else
+ {
+ DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n",
+ shortname, lang);
+ /* comment this to try the core font */
+ retval = Qnil;
+ }
+
+ /* clean up and maybe return */
+ FcCharSetDestroy (fccs);
+ if (!UNBOUNDP (retval))
+ return retval;
+ }
+ else
+ {
+ /* check for language coverage */
+ int i = 0;
+ FcValue v;
+ /* the main event */
+ FcResult r = FcPatternGet (patternxft, FC_LANG, i, &v);
+ if (r == FcResultMatch)
+ {
+ if (v.type != FcTypeLangSet) /* excessive paranoia */
+ {
+ /* Urk! Fall back and punt to core font. */
+ DEBUG_XFT1 (0, "Unexpected type of lang value (%s)\n",
+ FcTypeOfValueToString (v));
+ /* uncomment this to not try core font */
+ /* return Qnil; */
+ }
+ else if (FcLangSetHasLang (v.u.l, lang) != FcLangDifferentLang)
+ {
+ DEBUG_XFT2 (0, "Xft font %s supports %s\n", shortname, lang);
+ /* #### would it be better to return shortname? */
+ return (build_string (FcNameUnparse (patternxft)));
+ }
+ else
+ {
+ DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n",
+ shortname, lang);
+ return Qnil;
+ }
+ }
+ DEBUG_XFT1 (0, "Unexpected result getting lang=%s\n",
+ FcResultToString (r));
+ }
}
- else if (debug_xft > 0)
- stderr_out ("Failed fontconfig initialization\n");
- if (debug_xft > 0)
- stderr_out ("shit happens, try X11 charset match for %s\n", patternext);
-#endif
+ DEBUG_XFT1 (0, "shit happens, try X11 charset match for %s\n",
patternext);
+#endif /* USE_XFT */
names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
patternext, MAX_FONT_COUNT, &count);
1.23.2.1 +21 -5 XEmacs/xemacs/src/objects.c
Index: objects.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v
retrieving revision 1.23
retrieving revision 1.23.2.1
diff -u -r1.23 -r1.23.2.1
--- objects.c 2004/11/04 23:06:46 1.23
+++ objects.c 2005/03/05 18:09:30 1.23.2.1
＠＠ -274,6 +274,7 ＠＠
{ XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, name)},
{ XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)},
{ XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)},
+ { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, charset)},
{ XD_UNION, offsetof (Lisp_Font_Instance, data),
XD_INDIRECT (0, 0), &font_instance_data_description },
{ XD_END }
＠＠ -350,19 +351,23 ＠＠
Lisp_Font_Instance);
-DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
+/* #### Why is this exposed to Lisp? Used in:
+x-frob-font-size, gtk-font-menu-load-font, x-font-menu-load-font-xft,
+x-font-menu-load-font-core, mswindows-font-menu-load-font,
+mswindows-frob-font-style-and-sizify, mswindows-frob-font-size. */
+DEFUN ("make-font-instance", Fmake_font_instance, 1, 4, 0, /*
Return a new `font-instance' object named NAME.
DEVICE specifies the device this object applies to and defaults to the
selected device. An error is signalled if the font is unknown or cannot
be allocated; however, if NOERROR is non-nil, nil is simply returned in
-this case.
+this case. CHARSET is used internally. #### make helper function?
The returned object is a normal, first-class lisp object. The way you
`deallocate' the font is the way you deallocate any other lisp object:
you drop all pointers to it and allow it to be garbage collected. When
-these objects are GCed, the underlying X data is deallocated as well.
+these objects are GCed, the underlying GUI data is deallocated as well.
*/
- (name, device, noerror))
+ (name, device, noerror, charset))
{
Lisp_Font_Instance *f;
int retval = 0;
＠＠ -387,6 +392,7 ＠＠
f->ascent = f->height = 1;
f->descent = 0;
f->width = 1;
+ f->charset = charset;
f->proportional_p = 0;
retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance,
＠＠ -489,6 +495,15 ＠＠
return font_instance_truename_internal (font_instance, ERROR_ME);
}
+DEFUN ("font-instance-charset", Ffont_instance_charset, 1, 1, 0, /*
+Return the Mule charset that FONT-INSTANCE was allocated to handle.
+*/
+ (font_instance))
+{
+ CHECK_FONT_INSTANCE (font_instance);
+ return XFONT_INSTANCE (font_instance)->charset;
+}
+
DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /*
Return the properties (an alist or nil) of FONT-INSTANCE.
*/
＠＠ -878,7 +893,7 ＠＠
if (UNBOUNDP (instance))
{
/* make sure we cache the failures, too. */
- instance = Fmake_font_instance (instantiator, device, Qt);
+ instance = Fmake_font_instance (instantiator, device, Qt, charset);
Fputhash (instantiator, instance, cache);
}
＠＠ -1129,6 +1144,7 ＠＠
DEFSUBR (Ffont_instance_ascent);
DEFSUBR (Ffont_instance_descent);
DEFSUBR (Ffont_instance_width);
+ DEFSUBR (Ffont_instance_charset);
DEFSUBR (Ffont_instance_proportional_p);
DEFSUBR (Ffont_instance_truename);
DEFSUBR (Ffont_instance_properties);
1.10.2.1 +2 -1 XEmacs/xemacs/src/objects.h
Index: objects.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.h,v
retrieving revision 1.10
retrieving revision 1.10.2.1
diff -u -r1.10 -r1.10.2.1
--- objects.h 2004/09/14 14:32:52 1.10
+++ objects.h 2005/03/05 18:09:30 1.10.2.1
＠＠ -58,10 +58,11 ＠＠
#define CHECK_FONT_INSTANCE(x) CHECK_RECORD (x, font_instance)
#define CONCHECK_FONT_INSTANCE(x) CONCHECK_RECORD (x, font_instance)
-EXFUN (Fmake_font_instance, 3);
+EXFUN (Fmake_font_instance, 4);
EXFUN (Ffont_instance_name, 1);
EXFUN (Ffont_instance_p, 1);
EXFUN (Ffont_instance_truename, 1);
+EXFUN (Ffont_instance_charset, 1);
extern Lisp_Object Vthe_null_font_instance;
1.1.2.8 +20 -7 XEmacs/xemacs/src/Attic/xft-fonts.c
Index: xft-fonts.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/xft-fonts.c,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -u -r1.1.2.7 -r1.1.2.8
--- xft-fonts.c 2005/02/22 13:03:12 1.1.2.7
+++ xft-fonts.c 2005/03/05 18:09:30 1.1.2.8
＠＠ -1,13 +1,14 ＠＠
/* Lisp font handling implementation for X with Xft.
Copyright (C) 2003 Eric Knauel and Matthias Neubauer
-Copyright (C) 2004 Free Software Foundation, Inc.
+Copyright (C) 2005 Eric Knauel
+Copyright (C) 2004, 2005 Free Software Foundation, Inc.
Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de>
Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de>
Stephen J. Turnbull <stephen(a)xemacs.org>
Created: 27 Oct 2003
-Updated: 24 Jul 2004 by Stephen J. Turnbull
+Updated: 05 Mar 2005 by Stephen J. Turnbull
This file is part of XEmacs.
＠＠ -46,9 +47,6 ＠＠
#include "objects-x-impl.h"
#include "xft-fonts.h"
-int debug_xft = 0; /* Set to 1 enables lots of obnoxious messages.
- Setting it to 2 or 3 enables even more. */
-
/* #### TO DO ####
. The "x-xft-*" and "x_xft_*" nomenclature is mostly redundant,
especially
if we separate X fonts from Xft fonts, and use fontconfig more generally.
＠＠ -78,8 +76,13 ＠＠
Lisp_Object Qfc_internal_error;
Lisp_Object Vxlfd_font_name_regexp; /* Really needed in initialization? */
Lisp_Object Vxft_version;
+Fixnum debug_xft; /* Set to 1 enables lots of obnoxious messages.
+ Setting it to 2 or 3 enables even more. */
static Lisp_Object make_xlfd_font_regexp (void);
+static void string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os);
+/* #### need to change this to proper FcChar* */
+static inline char *extract_fcapi_string (Lisp_Object str);
static const struct memory_description fcpattern_description [] = {
{ XD_LISP_OBJECT, offsetof (struct fc_pattern, fontset) },
＠＠ -1091,10 +1094,20 ＠＠
void
vars_of_xft_fonts (void)
{
+ /* #### I know, but the right fix is use the generic debug facility. */
+ DEFVAR_INT ("xft-debug-level", &debug_xft /*
+Level of debugging messages to issue to stderr for Xft.
+A nonnegative integer. Set to 0 to suppress all warnings.
+Default is 1 to ensure a minimum of debugging output at initialization.
+Higher levels give even more information.
+*/ );
+ debug_xft = 1;
+
DEFVAR_LISP("xft-version", &Vxft_version /*
-The major version number of the Xft library being used */
- );
+The major version number of the Xft library being used.
+*/ );
Vxft_version = make_int(XFT_VERSION);
+
Fprovide (intern ("xft"));
}
1.1.2.5 +4 -9 XEmacs/xemacs/src/Attic/xft-fonts.h
Index: xft-fonts.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/xft-fonts.h,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- xft-fonts.h 2005/02/11 15:39:08 1.1.2.4
+++ xft-fonts.h 2005/03/05 18:09:30 1.1.2.5
＠＠ -1,13 +1,14 ＠＠
/* Lisp font data structures for X and Xft.
Copyright (C) 2003 Eric Knauel and Matthias Neubauer
-Copyright (C) 2004 Free Software Foundation, Inc.
+Copyright (C) 2005 Eric Knauel
+Copyright (C) 2004, 2005 Free Software Foundation, Inc.
Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de>
Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de>
Stephen J. Turnbull <stephen(a)xemacs.org>
Created: 27 Oct 2003
-Updated: 24 Jul 2004 by Stephen J. Turnbull
+Updated: 05 Mar 2005 by Stephen J. Turnbull
This file is part of XEmacs.
＠＠ -44,7 +45,7 ＠＠
#include "../lwlib/lwlib-fonts.h"
#include "../lwlib/lwlib-colors.h"
-extern int debug_xft;
+extern Fixnum debug_xft;
/* #### new in xft reloaded #3; where is this used? */
XftColor xft_get_color (Display *dpy, Colormap cmap, Lisp_Object c, int dim);
＠＠ -89,11 +90,5 ＠＠
Lisp_Object fc_get_pattern_integer(Lisp_Object fcpat, Lisp_Object id, const char*
objid);
Lisp_Object fc_get_pattern_bool(Lisp_Object fcpat, Lisp_Object id, const char* objid);
Lisp_Object fc_get_pattern_string(Lisp_Object fcpat, Lisp_Object id, const char*
objid);
-
-static void
-string_list_to_fcobjectset (Lisp_Object, FcObjectSet*);
-
-inline static char *
-extract_fcapi_string (Lisp_Object str);
#endif /* INCLUDED_xft_fonts_h_ */