CVS update by stephent xemacs/tests/autoconf ...

User: stephent Date: 05/11/26 12:46:25 Modified: xemacs/tests/autoconf regressiontest.pl Added: xemacs/lisp fontconfig.el xemacs/lwlib lwlib-colors.c lwlib-colors.h lwlib-fonts.c lwlib-fonts.h xemacs/src xft-fonts.c xft-fonts.h Log: Xft merge. <87k6ev4p8q.fsf(a)tleepslib.sk.tsukuba.ac.jp&gt; Revision Changes Path 1.474 +158 -1 XEmacs/xemacs/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/ChangeLog,v retrieving revision 1.473 retrieving revision 1.474 diff -u -p -r1.473 -r1.474 --- ChangeLog 2005/11/25 01:41:31 1.473 +++ ChangeLog 2005/11/26 11:45:47 1.474 ＠＠ -1,3 +1,155 ＠＠ +2005-11-26 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Merge Xft. + + 2005-03-05 Malcolm Purvis <malcolmp(a)xemacs.org&gt; + + * configure.ac: Correct the filename of the old copy of configure. + + 2005-03-05 Malcolm Purvis <malcolmp(a)xemacs.org&gt; + + * config.guess: + * config.sub: Sync with the latest upstream versions. + * configure.ac: Use --verbose for --extra-verbose. Better + quoting of arguments. Internal shell vars statr with '_' to avoid + name clashes. Pick up the latest changes to configure.in. + Improve the testing of Athena 3d widgets. + + 2005-02-20 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.ac (athena): Spells as 3d, not xaw3d, in declaration. + (sound): quickfix: AC_DEFINE, not AC_DEFINE_UNQUOTED, at top level. + + 2005-02-19 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.ac (XE_EXPAND_COMPLEX_OPTION): Use same name in comment. + (XEmacs keyword option support): + (XEmacs complex option support): + Move long header comments to internals.texi(The configure Script). + + 2005-02-03 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.ac: Trap --with-style flags, now --enable. + + 2005-02-03 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.ac (Autodetect native sound): + Handle NetBSD per Aidan's patch. + + 2005-02-11 Malcolm Purvis <malcolmp(a)xemacs.org&gt; + + * configure.ac: Added keyword option support. Converted database, + sound, athena, xim, bignum, error-checking, menubars, scrollbars, + dialogs and widgets command line arguments to use keyword option + and complex option macros. + + 2005-02-09 Malcolm Purvis <malcolmp(a)xemacs.org&gt; + + * configure.ac (XE_COMPLEX_OPTION): + * configure.ac (XE_COMPLEX_OPTION_HELP_STRING): + * configure.ac (XE_COMPLEX_ARG_WITH): + * configure.ac (XE_COMPLEX_ARG_ENABLE): + Rewritten complex option support with a simpler API and support + for --enable as well a --with. + + 2005-02-02 Malcolm Purvis <malcolmp(a)xemacs.org&gt; + + * configure.ac Align with the current mainline version of + configure.in. + + 2005-02-01 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.ac (Xrender, fontconfig, and Xft): + Check /usr/include/freetype2. + + 2005-01-30 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.ac (AC_COPYRIGHT): Update. + (progname): Restore and improve documentation. + + (XE_INIT_COMPLEX_OPTION): + (XE_APPEND_COMPLEX_OPTION_DEFAULT): + (XE_PARSE_COMPLEX_OPTION): + (XE_CLEANUP_COMPLEX_OPTION): + (XE_COMPLEX_OPTION_HELP_STRING): Support complex options. + (--with-xft): Add Xft support using the complex option support. + + (--with-xface): + (--with-zlib): + (--with-xmu): + (--with-purify): + (--with-quantify): + (--with-toolbars): + (--with-tty): + (--with-xfs): + (--with-canna): + (--with-wnn): + (--with-wnn6): + (--with-ldap): + (--with-postgresql): + (--with-infodock): + (--with-native-sound-lib): + (--with-netinstall): + (--with-site-includes): + (--with-site-libraries): + (--with-site-prefixes): + (--with-package-prefix): + (--with-package-path): + (--enable-external-widget): + (--enable-kkcc): + (--enable-union-type): + (--enable-pdump): + (--enable-debug): + (--enable-memory-usage-stats): + (--enable-error-checking): + (--with-rel-alloc): + (--with-dlmalloc): + (--with-debug-malloc): + (--with-system-malloc): + Improve (including add) help strings. + + (--with-athena): + (--with-xim): + (--with-mail-locking): + (--enable-bignum): + (--enable-menubars): + (--enable-scrollbars): + (--enable-dialogs): + (--enable-widgets): + Fix `eval "$FEATURE=\"$val\"" bug. + + 2005-01-29 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * INSTALL (CONFIGURATION OPTIONS): + Insert Malcolm's notes on autoconf 2.59 support. + + 2005-01-04 Malcolm Purvis <malcolmp(a)xemacs.org&gt; + + * aclocal.m4: Changes to support autoconf 2.59 + * config.guess: + * config.sub: Upgraded to the version in from automake 1.9 + * configure.ac: Rewritten for autoconf 2.59 support. + + 2004-12-10 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.usage: Various minor improvements. + + 2004-12-09 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * configure.in: Update FSF's copyright. Support --with-xft=LIST + syntax. Try to find a directory containing freetype/ftheader.h. + + * configure.usage (--with-xft): Update. + + 2004-11-20 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Xft branch based on "Xft reloaded #3" patch by Eric Knauel and + Mathias Neuebaur, and other contributors. + + * configure.in: + * configure.usage: + Implement and document switches for configuring Xft. + 2005-11-21 Marcus Crestani <crestani(a)xemacs.org&gt; Incremental Garbage Collector ＠＠ -274,8 +426,13 ＠＠ 2005-02-21 Stephen J. Turnbull <stephen(a)xemacs.org&gt; * version.sh (XEMACS_RELEASE_DATE): New version info variable. + + * configure.in (XEMACS_RELEASE_DATE): + * configure.ac (XEMACS_RELEASE_DATE): + Use it. - * configure.in (XEMACS_RELEASE_DATE): Use it. + * configure.ac (sound): + AC_DEFINE_UNQUOTED seems OK, if it's not m4-quoted. 2005-02-18 Stephen J. Turnbull <stephen(a)xemacs.org&gt; 1.23 +122 -1 XEmacs/xemacs/configure.ac Index: configure.ac =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v retrieving revision 1.22 retrieving revision 1.23 diff -u -p -r1.22 -r1.23 --- configure.ac 2005/11/25 01:41:36 1.22 +++ configure.ac 2005/11/26 11:45:48 1.23 ＠＠ -630,6 +630,20 ＠＠ XE_MERGED_ARG([infopath], [AC_DEFINE(INFOPATH_USER_DEFINED)], []) dnl XE_HELP_SUBSECTION([Window-system options]) +dnl if you change defaults, make sure to fix arg 6 of the OPTION_HELP macro. +XE_COMPLEX_ARG([xft], + [XE_COMPLEX_OPTION_HELP_STRING([--with-xft], + [Xft client-side font rendering and anti-aliasing], + [Xft], + [`emacs' (buffers), `menubars', `tabs', and `gauges'], + [X11, Xft, Xrender, freetype, and fontconfig], + [`emacs,menubars,tabs,gauges'])], + [],[], + [XE_COMPLEX_OPTION([emacs],[yes]), + XE_COMPLEX_OPTION([menubars],[yes]), + XE_COMPLEX_OPTION([tabs],[yes]), + XE_COMPLEX_OPTION([gauges],[yes])]) + [], []) XE_MERGED_ARG([gtk], AC_HELP_STRING([--with-gtk],[Support GTK on the X Window System. (EXPERIMENTAL)]), [true], [with_gtk=no]) ＠＠ -777,7 +791,7 ＠＠ XE_MERGED_ARG([wnn6], [], []) XE_MERGED_ARG([xfs], AC_HELP_STRING([--with-xfs],[Enable XFontSet support for internationalized - menubar. Incompatible with `--with-xim=motif'. + menubar. Incompatible with `--with-xim=motif' and `--with-xft'. `--enable-menubars=lucid' (the default) is desirable.]), [], []) dnl ＠＠ -967,6 +981,20 ＠＠ fi dnl CDE requires tooltalk XE_CHECK_FEATURE_DEPENDENCY(cde, tooltalk) +dnl Xft sanity checking +dnl #### Maybe we should XE_DIE here instead? Or fix the UI so that +dnl emacs is always implicit? (I worry that --without-xft would be weird.) +if test \( "$with_xft_menubars" = "yes" -o "$with_xft_tabs" = "yes" \ + -o "$with_xft_gauges" = "yes" \) -a "$with_xft_emacs" = "no"; then + AC_MSG_WARN([Forcing --with-xft=emacs because Xft is enabled]) + with_xft_emacs=yes +fi + +dnl XFS and Xft in menubars conflict +if test "$with_xfs" = "yes" -a "$with_xft_menubars" = "yes"; then + USAGE_ERROR("XFS and Xft in the menubars are incompatible!") +fi + dnl ------------------------------------------------------------------------- dnl Local paths test "x$prefix" = xNONE && prefix=$ac_default_prefix ＠＠ -3362,6 +3390,50 ＠＠ extern Bool XRegisterIMInstantiateCallba fi fi + dnl include xft/AA support? + dnl #### need to check for includes here (especially, freetype.h for v.2) + + if test "$with_xft_emacs" = "yes"; then + AC_CHECKING([for Xrender, fontconfig, and Xft]) + xft_includes_found=no + AC_CHECK_HEADERS([freetype/config/ftheader.h], + [xft_includes_found=yes], + [ + dnl #### How about /sw/include, and /opt/local/include? + dnl these directories need to be the parent of the freetype directory + for freetype_include_top in "/usr/X11R6/include/freetype2" \ + "/usr/include/freetype2" + do + if test -d $freetype_include_top; then + AC_CHECKING([in ${freetype_include_top}/freetype2]) + dnl disable autoconf's fucking cache; why these fuckheads think it + dnl is better to be broken than to be slow, I don't know! + dnl #### there's gotta be a better-looking way to do this!! + unset "$as_ac_Header" + save_c_switch_site="$c_switch_site" + c_switch_site="$c_switch_site -I${freetype_include_top}" + AC_CHECK_HEADERS([freetype/config/ftheader.h], + [xft_includes_found=yes], + [c_switch_site=$save_c_switch_site]) + fi + done + if test "$xft_includes_found" != "yes"; then + XE_DIE(["Unable to find headers for --with-xft"]) + else + AC_CHECK_LIB(Xrender, XRenderQueryExtension, XE_PREPEND(-lXrender, libs_x), + [XE_DIE(["Unable to find libXrender for --with-xft"])]) + AC_CHECK_LIB(fontconfig, FcPatternCreate, XE_PREPEND(-lfontconfig, libs_x), + [XE_DIE(["Unable to find libfontconfig for --with-xft"])]) + AC_CHECK_LIB(Xft, XftFontOpen, XE_PREPEND(-lXft, libs_x), + [XE_DIE(["Unable to find libXft for --with-xft"])]) + AC_DEFINE(USE_XFT) + dnl Due to interactions with other libraries, must postpone AC_DEFINE + dnl of USE_XFT_MENUBARS, USE_XFT_TABS, and USE_XFT_GAUGE. + unset xft_includes_found + fi +]) + fi + fi dnl $with_x11 = yes if test "$with_msw" != "no"; then ＠＠ -4186,6 +4258,14 ＠＠ esac case "$enable_menubars" in "" | "yes" | "athena" ) enable_menubars="lucid" ;; esac +dnl this is not in xft reloaded #3 +if test "$with_xft_menubars" != "no" ; then + if test "$with_xft_emacs" = "yes" -a "$with_menubars" != "no" ; then + with_xft_menubars="yes" + else + with_xft_menubars="no" + fi +fi case "$enable_dialogs" in "" | "yes" | "lucid" ) if test "$lucid_prefers_motif" = "yes"; then if test "$have_motif" = "yes"; then enable_dialogs="motif" ＠＠ -4219,6 +4299,22 ＠＠ case "$enable_widgets" in "" | "yes" | " fi fi ;; esac +dnl this is not in xft reloaded #3 +if test "$with_xft_tabs" != "no" ; then + if test "$with_xft_emacs" = "yes" -a "$enable_widgets" != "no" ; then + with_xft_tabs="yes" + else + with_xft_tabs="no" + fi +fi +dnl this is not in xft reloaded #3 +if test "$with_xft_gauge" != "no" ; then + if test "$with_xft_emacs" = "yes" -a "$enable_widgets" != "no" ; then + with_xft_gauge="yes" + else + with_xft_gauge="no" + fi +fi all_widgets="$enable_menubars $enable_scrollbars $enable_dialogs $enable_toolbars $enable_widgets" ＠＠ -4307,6 +4403,12 ＠＠ test "$enable_scrollbars" = "motif" && test "$enable_dialogs" = "motif" && AC_DEFINE(LWLIB_DIALOGS_MOTIF) test "$enable_widgets" = "motif" && AC_DEFINE(LWLIB_WIDGETS_MOTIF) +dnl this is not in xft reloaded #3 +test "$with_xft_menubars" = "yes" && AC_DEFINE(USE_XFT_MENUBARS) +dnl these are new in sjt-xft +test "$with_xft_tabs" = "yes" && AC_DEFINE(USE_XFT_TABS) +test "$with_xft_gauge" = "yes" && AC_DEFINE(USE_XFT_GAUGE) + dnl ---------------------- dnl Mule-dependent options dnl ---------------------- ＠＠ -5782,6 +5884,9 ＠＠ if test "$with_x11" = "yes"; then if test "$with_wmcommand" != no; then echo " - Handling WM_COMMAND properly." fi + if test "$with_xft" = "yes"; then + echo " - Compiling in support for Xft antialiased fonts (EXPERIMENTAL)." + fi fi if test "$need_motif" = "yes" ; then echo " Compiling in support for Motif." ＠＠ -5807,6 +5912,11 ＠＠ case "$enable_menubars" in echo " Re-run configure with --enable-menubars='lucid'." ;; msw ) echo " Using MS-Windows menubars." ;; esac +dnl this is not in xft reloaded #3 +if test "$with_xft_menubars" = "yes"; then + echo " - Using Xft to render antialiased fonts in menubars." + echo " WARNING: This feature will be replaced with a face." +fi case "$enable_scrollbars" in gtk ) echo " Using GTK scrollbars." ;; lucid ) echo " Using Lucid scrollbars." ;; ＠＠ -5832,6 +5942,17 ＠＠ case "$enable_widgets" in athena ) echo " Using Athena native widgets." ;; msw ) echo " Using MS-Windows native widgets." ;; esac +dnl this is not in xft reloaded #3 +if test "$with_xft_tabs" = "yes"; then + echo " - Using Xft to render antialiased fonts in tab controls." + echo " WARNING: This feature will be replaced with a face." +fi +dnl this is not in xft reloaded #3 +if test "$with_xft_gauge" = "yes"; then + echo " - Using Xft to render antialiased fonts in progress bars." + echo " WARNING: This feature will be replaced with a face." + echo " WARNING: This feature not yet implemented; setting ignored." +fi if test "$with_dragndrop" = yes; then echo " Compiling in support for Drag'n'Drop (EXPERIMENTAL)." echo " - Drag'n'Drop prototype: $dragndrop_proto." 1.700 +88 -0 XEmacs/xemacs/lisp/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v retrieving revision 1.699 retrieving revision 1.700 diff -u -p -r1.699 -r1.700 --- ChangeLog 2005/11/25 01:41:45 1.699 +++ ChangeLog 2005/11/26 11:45:53 1.700 ＠＠ -1,3 +1,91 ＠＠ +2005-11-26 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Merge Xft. + + 2005-09-07 Clemens Fruhwirth <clemens(a)endorphin.org&gt; + + * font.el (font-default-font-for-device): Remove vestigial code + from incomplete removal of conditional. + + 2005-08-17 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * fontconfig.el (fc-try-font): Improve docstring, add todo comment. + (make-fc-pattern): Use defalias, not defun. + + 2005-08-04 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * fontconfig.el (make-fc-pattern): Don't add finalizer, now + finalizer is in lrecord implementation. + + 2005-08-02 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + `fc-list-fonts-pattern-objects' now returns a LISP list. + + * fontconfig.el (fc-try-font): + (fc-find-available-font-families): + (fc-find-available-weights-for-family): + Adapt to it. + + (fc-try-font): Return list of pattern objects. + + (fc-fontset-list): Remove. + + 2005-03-02 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * 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&gt; + + General cleanup of references to functions Eric has deleted + and renamed in the C core. + * font.el (x-font-create-object): + xft-xlfd-font-name-p -> xlfd-font-name-p + * font.el (x-font-create-object-xft): + xft-pattern-* -> fc-pattern-*, return the created font. + * font.el (x-font-create-name-xft): + xft* -> fc* + * fontconfig.el (fc-font-name-weight-regular): New. + * fontconfig.el (fc-font-name-weight-mapping): + * fontconfig.el (fc-font-name-weight-mapping-string): + * fontconfig.el (fc-font-name-weight-mapping-string-reverse): + * fontconfig.el (fc-font-name-weight-mapping-reverse): + * fontconfig.el (fc-font-weight-translate-from-symbol): + Add information on the "regular" font weight, taken from + fontconfig.h, which is the weight my local system returns by + default. + + 2005-02-03 Eric Knauel <eric(a)xemacs.org&gt; + + * fontconfig.el (fc-try-font): + (fc-find-available-font-families): + (fc-find-available-weights-for-family): adapt to new representation of + FcObjectSets + + 2004-11-20 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Xft branch based on "Xft reloaded #3" patch by Eric Knauel and + Mathias Neuebaur, and other contributors. + + * fontconfig.el: New file implementing fontconfig interfaces. + + * font.el: + * face.el: + Use fontconfig to access Xft fonts. + 2005-11-21 Marcus Crestani <crestani(a)xemacs.org&gt; Incremental Garbage Collector 1.57 +2 -0 XEmacs/xemacs/lisp/dumped-lisp.el Index: dumped-lisp.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/dumped-lisp.el,v retrieving revision 1.56 retrieving revision 1.57 diff -u -p -r1.56 -r1.57 --- dumped-lisp.el 2005/10/04 17:51:20 1.56 +++ dumped-lisp.el 2005/11/26 11:45:53 1.57 ＠＠ -53,6 +53,8 ＠＠ in dumped-lisp.el and is not itself list "obsolete" "specifier" "frame" ; needed by faces + ;; #### this should be (featurep 'xft) + (when (featurep 'x) "fontconfig") ; needed by x-faces (when (featurep 'x) "x-faces") ; needed by faces (when (featurep 'gtk) "gtk-faces") (when (valid-console-type-p 'mswindows) "msw-faces") 1.37 +2 -1 XEmacs/xemacs/lisp/faces.el Index: faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v retrieving revision 1.36 retrieving revision 1.37 diff -u -p -r1.36 -r1.37 --- faces.el 2005/10/25 11:28:24 1.36 +++ faces.el 2005/11/26 11:45:54 1.37 ＠＠ -49,7 +49,8 ＠＠ ;; To elude the warnings for font functions. (Normally autoloaded when ;; font-create-object is called) (eval-when-compile - (require 'font)) + (require 'font) + (load "cl-macs")) (defgroup faces nil "Support for multiple text attributes (fonts, colors, ...) 1.18 +239 -135 XEmacs/xemacs/lisp/font.el Index: font.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font.el,v retrieving revision 1.17 retrieving revision 1.18 diff -u -p -r1.17 -r1.18 --- font.el 2005/03/25 15:58:03 1.17 +++ font.el 2005/11/26 11:45:54 1.18 ＠＠ -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 ＠＠ -42,6 +54,7 ＠＠ (globally-declare-boundp '(global-face-data x-font-regexp x-font-regexp-foundry-and-family + fc-font-regexp mswindows-font-regexp)) (require 'cl) ＠＠ -89,23 +102,16 ＠＠ ;;; 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)) + ;; #### FIXME should this handle fontconfig font objects? + (fc . (fc-font-create-name fc-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. ＠＠ -148,12 +154,11 ＠＠ for use in the 'weight' field of an X fo "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) ＠＠ -248,6 +253,7 ＠＠ for use in the 'weight' field of an X fo (aset table (+ i ?a) (+ i ?A)) (setq i (1+ i))) ;; Now ISO translations + ;; #### FIXME what's this for?? (setq i 224) (while (< i 247) ;; Agrave - Ouml (aset table i (- i 32)) ＠＠ -261,27 +267,31 ＠＠ for use in the 'weight' field of an X fo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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)) ＠＠ -329,8 +339,8 ＠＠ The type may be the strings \"px\", \"pi (mm-width (float (or (device-mm-width device) 293))) (retval nil)) (cond - ;; the following string-match is broken, there will never be a - ;; left operand detected + ;; #### this is pretty bogus and should probably be made gone + ;; or supported at a higher level ((string-match "^ *\\([-+*/]\\) *" spec) ; math! whee! (let ((math-func (intern (match-string 1 spec))) (other (font-spatial-to-canonical ＠＠ -361,7 +371,7 ＠＠ The type may be the strings \"px\", \"pi ((string= type "mm") (setq retval (* num (/ 72.0 25.4)))) ((string= type "cm") - (setq retval (* num 10 (/ 72.0 25.4)))) + (setq retval (* num (/ 72.0 2.54)))) (t (setq retval num)) ) ＠＠ -445,6 +455,42 ＠＠ The type may be the strings \"px\", \"pi args (cdr args))) retval)))) +(defvar font-default-cache nil) + +;;;###autoload +(defun font-default-font-for-device (&optional device) + (or device (setq device (selected-device))) + (font-truename + (make-font-specifier + (face-font-name 'default device)))) + +;;;###autoload +(defun font-default-object-for-device (&optional device) + (let ((font (font-default-font-for-device device))) + (or (cdr-safe (assoc font font-default-cache)) + (let ((object (font-create-object font))) + (push (cons font object) font-default-cache) + object)))) + +;;;###autoload +(defun font-default-family-for-device (&optional device) + (font-family (font-default-object-for-device (or device (selected-device))))) + +;;;###autoload +(defun font-default-registry-for-device (&optional device) + (font-registry (font-default-object-for-device (or device (selected-device))))) + +;;;###autoload +(defun font-default-encoding-for-device (&optional device) + (font-encoding (font-default-object-for-device (or device (selected-device))))) + +;;;###autoload +(defun font-default-size-for-device (&optional device) + ;; face-height isn't the right thing (always 1 pixel too high?) + ;; (if font-running-xemacs + ;; (format "%dpx" (face-height 'default device)) + (font-size (font-default-object-for-device (or device (selected-device))))) +  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The window-system dependent code (TTY-style) ＠＠ -468,9 +514,8 ＠＠ The type may be the strings \"px\", \"pi ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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 "[^-]*") ＠＠ -497,13 +542,12 ＠＠ The type may be the strings \"px\", \"pi )))) (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 '( ＠＠ -600,47 +644,6 ＠＠ The type may be the strings \"px\", \"pi (sort (font-unique (nconc scaled normal)) 'string-lessp)))) (cons "monospace" (mapcar 'car font-x-family-mappings)))) -(defvar font-default-cache nil) - -;;;###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))) - (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)))) - -;;;###autoload -(defun font-default-object-for-device (&optional device) - (let ((font (font-default-font-for-device device))) - (or (cdr-safe (assoc font font-default-cache)) - (let ((object (font-create-object font))) - (push (cons font object) font-default-cache) - object)))) - -;;;###autoload -(defun font-default-family-for-device (&optional device) - (font-family (font-default-object-for-device (or device (selected-device))))) - -;;;###autoload -(defun font-default-registry-for-device (&optional device) - (font-registry (font-default-object-for-device (or device (selected-device))))) - -;;;###autoload -(defun font-default-encoding-for-device (&optional device) - (font-encoding (font-default-object-for-device (or device (selected-device))))) - -;;;###autoload -(defun font-default-size-for-device (&optional device) - ;; face-height isn't the right thing (always 1 pixel too high?) - ;; (if font-running-xemacs - ;; (format "%dpx" (face-height 'default device)) - (font-size (font-default-object-for-device (or device (selected-device))))) - (defun x-font-create-name (fontobj &optional device) "Return a font name constructed from FONTOBJ, appropriate for X devices." (if (and (not (or (font-family fontobj) ＠＠ -656,8 +659,7 ＠＠ The type may be the strings \"px\", \"pi (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) ＠＠ -714,6 +716,134 ＠＠ The type may be the strings \"px\", \"pi (if done font-name)))))  +;;; Cache building code +;;;###autoload +(defun x-font-build-cache (&optional device) + (let ((hash-table (make-hash-table :test 'equal :size 15)) + (fonts (mapcar 'x-font-create-object + (font-list "-*-*-*-*-*-*-*-*-*-*-*-*-*-*"))) + (plist nil) + (cur nil)) + (while fonts + (setq cur (car fonts) + fonts (cdr fonts) + plist (cl-gethash (car (font-family cur)) hash-table)) + (if (not (memq (font-weight cur) (plist-get plist 'weights))) + (setq plist (plist-put plist 'weights (cons (font-weight cur) + (plist-get plist 'weights))))) + (if (not (member (font-size cur) (plist-get plist 'sizes))) + (setq plist (plist-put plist 'sizes (cons (font-size cur) + (plist-get plist 'sizes))))) + (if (and (font-oblique-p cur) + (not (memq 'oblique (plist-get plist 'styles)))) + (setq plist (plist-put plist 'styles (cons 'oblique (plist-get plist 'styles))))) + (if (and (font-italic-p cur) + (not (memq 'italic (plist-get plist 'styles)))) + (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles))))) + (cl-puthash (car (font-family cur)) plist hash-table)) + hash-table)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The rendering engine-dependent code (Xft-style) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; #### FIXME actually, this section should be fc-*, right? + +(defvar font-xft-font-regexp + ;; #### FIXME what the fuck?!? + (when (and (boundp 'xft-font-regexp) xft-font-regexp) + (concat "\\`" + "[^:-]*" ; optional foundry and family + ; incorrect, escaping exists + "\\(-[0-9]*\\(\\.[0-9]*\\)?\\)?" ; optional size (points) + "\\(:[^:]*\\)*" ; optional properties + ; not necessarily key=value!! + "\\'" + ))) + +(defvar font-xft-family-mappings + ;; #### FIXME this shouldn't be needed or used for Xft + '(("serif" . ("new century schoolbook" + "utopia" + "charter" + "times" + "lucidabright" + "garamond" + "palatino" + "times new roman" + "baskerville" + "bookman" + "bodoni" + "computer modern" + "rockwell" + )) + ("sans-serif" . ("lucida" + "helvetica" + "gills-sans" + "avant-garde" + "univers" + "optima")) + ("elfin" . ("tymes")) + ("monospace" . ("courier" + "fixed" + "lucidatypewriter" + "clean" + "terminal")) + ("cursive" . ("sirene" + "zapf chancery")) + ) + "A list of font family mappings on Xft devices.") + +(defun xft-font-create-object (fontname &optional device) + "Return a font descriptor object for FONTNAME, appropriate for Xft." + (let* ((name fontname) + (device (or device (default-x-device))) + (pattern (fc-font-real-pattern name device)) + (font-obj (make-font)) + (family (fc-pattern-get-family pattern 0)) + (size (fc-pattern-get-size pattern 0)) + (weight (fc-pattern-get-weight pattern 0))) + (set-font-family font-obj + (and (not (equal family 'fc-result-no-match)) + family)) + (set-font-size font-obj + (and (not (equal size 'fc-result-no-match)) + size)) + (set-font-weight font-obj + (and (not (equal weight 'fc-result-no-match)) + (fc-font-weight-translate-from-constant weight))) + font-obj)) + +;; #### FIXME Xft fonts are not defined by the device. +;; ... Does that mean the whole model here is bogus? +(defun xft-font-families-for-device (&optional device no-resetp) + (ignore-errors (require 'x-font-menu)) ; #### FIXME xft-font-menu? + (or device (setq device (selected-device))) + (if (boundp 'device-fonts-cache) ; #### FIXME does this make sense? + (let ((menu (or (cdr-safe (assq device device-fonts-cache))))) + (if (and (not menu) (not no-resetp)) + (progn + (reset-device-font-menus device) + (xft-font-families-for-device device t)) + ;; #### FIXME clearly bogus for Xft + (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0))) + (aref menu 0))) + (normal (mapcar #'(lambda (x) (if x (aref x 0))) + (aref menu 1)))) + (sort (font-unique (nconc scaled normal)) 'string-lessp)))) + ;; #### FIXME clearly bogus for Xft + (cons "monospace" (mapcar 'car font-xft-family-mappings)))) + +(defun xft-font-create-name (fontobj &optional device) + (let* ((pattern (make-fc-pattern))) + (if (font-family fontobj) + (fc-pattern-add-family pattern (font-family fontobj))) + (if (font-size fontobj) + (fc-pattern-add-size pattern (font-size fontobj))) + (fc-name-unparse pattern))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The window-system dependent code (NS-style) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ＠＠ -870,8 +1000,7 ＠＠ for use in the 'weight' field of an mswi (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)) ＠＠ -920,34 +1049,6 ＠＠ for use in the 'weight' field of an mswi (if done font-name)))))  -;;; Cache building code -;;;###autoload -(defun x-font-build-cache (&optional device) - (let ((hash-table (make-hash-table :test 'equal :size 15)) - (fonts (mapcar 'x-font-create-object - (font-list "-*-*-*-*-*-*-*-*-*-*-*-*-*-*"))) - (plist nil) - (cur nil)) - (while fonts - (setq cur (car fonts) - fonts (cdr fonts) - plist (cl-gethash (car (font-family cur)) hash-table)) - (if (not (memq (font-weight cur) (plist-get plist 'weights))) - (setq plist (plist-put plist 'weights (cons (font-weight cur) - (plist-get plist 'weights))))) - (if (not (member (font-size cur) (plist-get plist 'sizes))) - (setq plist (plist-put plist 'sizes (cons (font-size cur) - (plist-get plist 'sizes))))) - (if (and (font-oblique-p cur) - (not (memq 'oblique (plist-get plist 'styles)))) - (setq plist (plist-put plist 'styles (cons 'oblique (plist-get plist 'styles))))) - (if (and (font-italic-p cur) - (not (memq 'italic (plist-get plist 'styles)))) - (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles))))) - (cl-puthash (car (font-family cur)) plist hash-table)) - hash-table)) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Now overwrite the original copy of set-face-font with our own copy that ;;; can deal with either syntax. ＠＠ -967,7 +1068,7 ＠＠ for use in the 'weight' field of an mswi (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)) ＠＠ -978,16 +1079,18 ＠＠ for use in the 'weight' field of an mswi (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) ＠＠ -1362,13 +1465,14 ＠＠ is returned." (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)))) 1.9 +16 -11 XEmacs/xemacs/lisp/font-menu.el Index: font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-menu.el,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- font-menu.el 2005/01/28 02:58:39 1.8 +++ font-menu.el 2005/11/26 11:45:54 1.9 ＠＠ -264,7 +264,9 ＠＠ or if you change your font path, you can (member 0 (aref entry 2)))) (enable-menu-item item) (disable-menu-item item)) - (if (eq size s) + ;; #### God save the Queen! + ;; well, if this fails because s or size is non-numeric, fuck 'em + (if (= size (if (featurep 'xft-fonts) (float s) s)) (select-toggle-menu-item item) (deselect-toggle-menu-item item)) item) ＠＠ -345,6 +347,7 ＠＠ or if you change your font path, you can (or weight from-weight) (or size from-size)) (error + (message "Error updating font of `%s'" face) (display-error c nil) (sit-for 1))))) ;; Set the default face's font after hacking the other faces, so that ＠＠ -356,16 +359,18 ＠＠ or if you change your font path, you can (set-face-font 'default new-default-face-font (and font-menu-this-frame-only-p (selected-frame))) ;; OK Let Customize do it. - (custom-set-face-update-spec 'default - (list (list 'type (device-type))) - (list :family (or family from-family) - :size (concat - (int-to-string - (/ (or size from-size) - (specifier-instance font-menu-size-scaling - (selected-device)))) - "pt"))) - (message "Font %s" (face-font-name 'default))))) + (let ((fsize (if (featurep 'xft-fonts) + (int-to-string (or size from-size)) + (concat (int-to-string + (/ (or size from-size) + (specifier-instance font-menu-size-scaling + (selected-device)))) + "pt")))) + (custom-set-face-update-spec 'default + (list (list 'type (device-type))) + (list :family (or family from-family) + :size fsize)))) + (message "Font %s" (face-font-name 'default)))) ;; #### This should be called `font-menu-maybe-change-face' 1.22 +189 -0 XEmacs/xemacs/lisp/x-faces.el Index: x-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v retrieving revision 1.21 retrieving revision 1.22 diff -u -p -r1.21 -r1.22 --- x-faces.el 2005/03/31 11:28:44 1.21 +++ x-faces.el 2005/11/26 11:45:54 1.22 ＠＠ -66,6 +66,8 ＠＠ '(x-get-resource-and-maybe-bogosity-check x-get-resource x-init-pointer-shape)) +(require 'fontconfig) + (defconst x-font-regexp nil) (defconst x-font-regexp-head nil) (defconst x-font-regexp-head-2 nil) ＠＠ -78,6 +80,7 ＠＠ (defconst x-font-regexp-spacing nil) ;;; Regexps matching font names in "Host Portable Character Representation." +;;; #### But more recently Latin-1 is permitted, and Xft needs it in C (?). ;;; (let ((- "[-?]") (foundry "[^-]*") ＠＠ -134,6 +137,11 ＠＠ - registry - encoding "\\'")) ) +(defun x-font-xlfd-font-name-p (font) + "Check if FONT is an XLFD font name" + (and (stringp font) + (string-match x-font-regexp font))) + ;; A "loser font" is something like "8x13" -> "8x13bold". ;; These are supported only through extreme generosity. (defconst x-loser-font-regexp "\\`[0-9]+x[0-9]+\\'") ＠＠ -167,6 +175,46 ＠＠ (defun x-make-font-bold (font &optional device) "Given an X font specification, this attempts to make a `bold' font. If it fails, it returns nil." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-make-font-bold-core font device) + (x-make-font-bold-xft font device)) + (x-make-font-bold-core font device))) + +(defun x-make-font-bold-xft (font &optional device) + (let ((pattern (fc-font-real-pattern + font (or device (default-x-device))))) + (if pattern + (let ((size (fc-pattern-get-size pattern 0)) + (copy (fc-copy-pattern-partial + pattern (list fc-font-name-property-family)))) + (fc-pattern-del copy fc-font-name-property-weight) + (fc-pattern-del copy fc-font-name-property-style) + (when copy + (or + ;; try bold font + (let ((copy-2 (fc-pattern-duplicate copy))) + (fc-pattern-add copy-2 fc-font-name-property-weight + fc-font-name-weight-bold) + (when (fc-try-font copy-2 device) + (fc-pattern-add copy-2 fc-font-name-property-size size) + (fc-name-unparse copy-2))) + ;; try black font + (let ((copy-2 (fc-pattern-duplicate copy))) + (fc-pattern-add copy-2 fc-font-name-property-weight + fc-font-name-weight-black) + (when (fc-try-font copy-2 device) + (fc-pattern-add copy-2 fc-font-name-property-size size) + (fc-name-unparse copy-2))) + ;; try demibold font + (let ((copy-2 (fc-pattern-duplicate copy))) + (fc-pattern-add copy-2 fc-font-name-property-weight + fc-font-name-weight-demibold) + (when (fc-try-font copy-2 device) + (fc-pattern-add copy-2 fc-font-name-property-size size) + (fc-name-unparse copy-2))))))))) + +(defun x-make-font-bold-core (font &optional device) ;; Certain Type1 fonts know "bold" as "black"... (or (try-font-name (x-frob-font-weight font "bold") device) (try-font-name (x-frob-font-weight font "black") device) ＠＠ -175,6 +223,23 ＠＠ If it fails, it returns nil." (defun x-make-font-unbold (font &optional device) "Given an X font specification, this attempts to make a non-bold font. If it fails, it returns nil." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-make-font-unbold-core font device) + (x-make-font-unbold-xft font device)) + (x-make-font-unbold-core font device))) + +(defun x-make-font-unbold-xft (font &optional device) + (let ((pattern (fc-font-real-pattern + font (or device (default-x-device))))) + (when pattern + (fc-pattern-del pattern fc-font-name-property-weight) + (fc-pattern-add pattern fc-font-name-property-weight + fc-font-name-weight-medium) + (if (fc-try-font pattern device) + (fc-name-unparse pattern))))) + +(defun x-make-font-unbold-core (font &optional device) (try-font-name (x-frob-font-weight font "medium") device)) (defcustom try-oblique-before-italic-fonts nil ＠＠ -189,6 +254,53 ＠＠ applicable to adobe-courier fonts" (defun x-make-font-italic (font &optional device) "Given an X font specification, this attempts to make an `italic' font. If it fails, it returns nil." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-make-font-italic-core font device) + (x-make-font-italic-xft font device)) + (x-make-font-italic-core font device))) + +(defun x-make-font-italic-xft (font &optional device) + (let ((pattern (fc-font-real-pattern + font (or device (default-x-device))))) + (if pattern + (let ((size (fc-pattern-get-size pattern 0)) + (copy (fc-copy-pattern-partial + pattern (list fc-font-name-property-family)))) + (when copy + (fc-pattern-del copy fc-font-name-property-slant) + (fc-pattern-del copy fc-font-name-property-style) + (let ((pattern-oblique (fc-pattern-duplicate copy)) + (pattern-italic (fc-pattern-duplicate copy))) + (fc-pattern-add pattern-oblique fc-font-name-property-slant + fc-font-name-slant-oblique) + (fc-pattern-add pattern-italic fc-font-name-property-slant + fc-font-name-slant-italic) + (let ((have-oblique (fc-try-font pattern-oblique device)) + (have-italic (fc-try-font pattern-italic device))) + (if try-oblique-before-italic-fonts + (if have-oblique + (progn + (if size + (fc-pattern-add pattern-oblique fc-font-name-property-size size)) + (fc-name-unparse pattern-oblique)) + (if have-italic + (progn + (if size + (fc-pattern-add pattern-italic fc-font-name-property-size size)) + (fc-name-unparse pattern-italic)))) + (if have-italic + (progn + (if size + (fc-pattern-add pattern-italic fc-font-name-property-size size)) + (fc-name-unparse pattern-italic)) + (if have-oblique + (progn + (if size + (fc-pattern-add pattern-oblique fc-font-name-property-size size)) + (fc-name-unparse pattern-oblique)))))))))))) + +(defun x-make-font-italic-core (font &optional device) (if try-oblique-before-italic-fonts (or (try-font-name (x-frob-font-slant font "o") device) (try-font-name (x-frob-font-slant font "i") device)) ＠＠ -198,11 +310,40 ＠＠ If it fails, it returns nil." (defun x-make-font-unitalic (font &optional device) "Given an X font specification, this attempts to make a non-italic font. If it fails, it returns nil." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-make-font-unitalic-core font device) + (x-make-font-unitalic-xft font device)) + (x-make-font-unitalic-core font device))) + +(defun x-make-font-unitalic-xft (font &optional device) + (let ((pattern (fc-font-real-pattern + font (or device (default-x-device))))) + (when pattern + (fc-pattern-del pattern fc-font-name-property-slant) + (fc-pattern-add pattern fc-font-name-property-slant + fc-font-name-slant-roman) + (if (fc-try-font pattern device) + (fc-name-unparse pattern))))) + +(defun x-make-font-unitalic-core (font &optional device) (try-font-name (x-frob-font-slant font "r") device)) (defun x-make-font-bold-italic (font &optional device) "Given an X font specification, this attempts to make a `bold-italic' font. If it fails, it returns nil." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-make-font-bold-italic-core font device) + (x-make-font-bold-italic-xft font device)) + (x-make-font-bold-italic-core font device))) + +(defun x-make-font-bold-italic-xft (font &optional device) + (let ((italic (x-make-font-italic-xft font device))) + (if italic + (x-make-font-bold-xft italic device)))) + +(defun x-make-font-bold-italic-core (font &optional device) ;; This is haired up to avoid loading the "intermediate" fonts. (if try-oblique-before-italic-fonts (or (try-font-name ＠＠ -236,6 +377,21 ＠＠ This is done by parsing its name, so it' X fonts can be specified (by the user) in either pixels or 10ths of points, and this returns the first one it finds, so you have to decide which units the returned value is measured in yourself..." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-font-size-core font) + (x-font-size-xft font)) + (x-font-size-core font))) + +;; this is unbelievable &*＠# +(defun x-font-size-xft (font) + (let ((pattern (fc-font-real-pattern + font (default-x-device)))) + (when pattern + (let ((pixelsize (fc-pattern-get-pixelsize pattern 0))) + (if (floatp pixelsize) (round pixelsize)))))) + +(defun x-font-size-core (font) (if (font-instance-p font) (setq font (font-instance-name font))) (cond ((or (string-match x-font-regexp font) (string-match x-font-regexp-head-2 font)) ＠＠ -354,6 +510,29 ＠＠ X fonts can be specified (by the user) i Returns the font if it succeeds, nil otherwise. If scalable fonts are available, this returns a font which is 1 point smaller. Otherwise, it returns the next smaller version of this font that is defined." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-find-smaller-font-core font device) + (x-find-smaller-font-xft font device)) + (x-find-smaller-font-core font device))) + +(defun x-find-xft-font-of-size (font new-size-proc &optional device) + (let* ((pattern (fc-font-real-pattern + font (or device (default-x-device))))) + (when pattern + (let ((size (fc-pattern-get-size pattern 0))) + (if (floatp size) + (let ((copy (fc-pattern-duplicate pattern))) + (fc-pattern-del copy fc-font-name-property-size) + (fc-pattern-add copy fc-font-name-property-size + (funcall new-size-proc size)) + (if (fc-try-font font device) + (fc-name-unparse copy)))))))) + +(defun x-find-smaller-font-xft (font &optional device) + (x-find-xft-font-of-size font '(lambda (old-size) (- old-size 1.0)) device)) + +(defun x-find-smaller-font-core (font &optional device) (x-frob-font-size font nil device)) (defun x-find-larger-font (font &optional device) ＠＠ -361,6 +540,16 ＠＠ Otherwise, it returns the next smaller v Returns the font if it succeeds, nil otherwise. If scalable fonts are available, this returns a font which is 1 point larger. Otherwise, it returns the next larger version of this font that is defined." + (if (featurep 'xft-fonts) + (if (x-font-xlfd-font-name-p font) + (x-find-larger-font-core font device) + (x-find-larger-font-xft font device)) + (x-find-larger-font-core font device))) + +(defun x-find-larger-font-xft (font &optional device) + (x-find-xft-font-of-size font '(lambda (old-size) (+ old-size 1.0)) device)) + +(defun x-find-larger-font-core (font &optional device) (x-frob-font-size font t device)) (defalias 'x-make-face-bold 'make-face-bold) 1.14 +130 -1 XEmacs/xemacs/lisp/x-font-menu.el Index: x-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v retrieving revision 1.13 retrieving revision 1.14 diff -u -p -r1.13 -r1.14 --- x-font-menu.el 2005/01/28 02:58:41 1.13 +++ x-font-menu.el 2005/11/26 11:45:55 1.14 ＠＠ -34,6 +34,10 ＠＠ (require 'font-menu) +(when (featurep 'xft-fonts) + (require 'xft) + (require 'fontconfig)) + (globally-declare-boundp '(x-font-regexp x-font-regexp-foundry-and-family ＠＠ -80,8 +84,70 ＠＠ E.g. cursor fonts.") "This is used to filter out font families that can't display ASCII text. It must be set at run-time.") +;; #### move these to font-menu.el, and maybe make them defcustoms +(defvar font-menu-common-sizes + '(60 80 100 110 120 130 140 150 160 170 180 200 220 240 300 360) + "List of commonly desired font sizes in decipoints.") + ;;;###autoload (defun x-reset-device-font-menus (device &optional debug) + (if (featurep 'xft-fonts) + (x-reset-device-font-menus-xft device debug) + (x-reset-device-font-menus-core device debug))) + +(defun fc-make-font-menu-entry (family) + (let ((weights (fc-find-available-weights-for-family family))) + (vector + family + (mapcar + '(lambda (weight-symbol) + (let ((pair (assoc weight-symbol + '((:light "Light") + (:medium "Medium") + (:demibold "Demibold") + (:bold "Bold") + (:black "Black"))))) + (if pair (cadr pair)))) + weights) + '(0) + nil))) + +(defun x-reset-device-font-menus-xft (device &optional debug) + (let* ((families-1 (fc-find-available-font-families device)) + (families (delete-if (lambda (x) + (string-match x-fonts-menu-junk-families x)) + (sort families-1 'string-lessp))) + (data + (vector + (mapcar 'fc-make-font-menu-entry families) + (mapcar + '(lambda (family) + (vector family `(font-menu-set-font ,family nil nil) + :style 'radio :active nil :selected nil)) + families) + (mapcar + '(lambda (size) + (vector + (number-to-string size) + `(font-menu-set-font nil nil ,size) + :style 'radio :active nil :selected nil)) + ;; common size list in decipoints, fontconfig wants points + (mapcar (lambda (x) (/ x 10)) font-menu-common-sizes)) + (mapcar + '(lambda (weight) + (vector + weight + `(font-menu-set-font nil ,weight nil) + :style 'radio :active nil :selected nil)) + '("Light" "Medium" "Demibold" "Bold" "Black")))) + ;; get or initialize the entry for device + (dev-cache (or (assq device device-fonts-cache) + (car (push (list device) device-fonts-cache))))) + ;; update the device-fonts-cache entry for device in place + (setcdr dev-cache data) + data)) + +(defun x-reset-device-font-menus-core (device &optional debug) "Generates the `Font', `Size', and `Weight' submenus for the Options menu. This is run the first time that a font-menu is needed for each device. If you don't like the lazy invocation of this function, you can add it to ＠＠ -136,7 +202,7 ＠＠ or if you change your font path, you can ;; up not getting mentioned explicitly. ;; (if (member 0 sizes) - (let ((common '(60 80 100 120 140 160 180 240))) + (let ((common font-menu-common-sizes)) (while common (or;;(member (car common) sizes) ; not enough slack (let ((rest sizes) ＠＠ -195,6 +261,51 ＠＠ or if you change your font path, you can ;; get the truename and use the possibly suboptimal data from that. ;;;###autoload (defun x-font-menu-font-data (face dcache) + (let* ((case-fold-search t) + (domain (if font-menu-this-frame-only-p + (selected-frame) + (selected-device))) + (name (font-instance-name (face-font-instance face domain)))) + (if (featurep 'xft-fonts) + (if (xlfd-font-name-p name) + ;; #### this call to x-font-menu-font-data-core originally + ;; had 4 args, and that's probably the right way to go + (x-font-menu-font-data-core face dcache) + (x-font-menu-font-data-xft face dcache name domain)) + ;; #### this one, too + (x-font-menu-font-data-core face dcache)))) + +(defun x-font-menu-font-data-xft (face dcache name domain) + (let* ((truename (font-instance-truename + (face-font-instance face domain + (if (featurep 'mule) 'ascii)))) + entry) + (if (xlfd-font-name-p truename) + (progn + nil) + (progn + (let* ((pattern (fc-font-real-pattern name domain)) + (family (and pattern + (fc-pattern-get-family pattern 0)))) + (if (fc-pattern-get-successp family) + (setq entry (vassoc family (aref dcache 0)))) + (if (null entry) + (make-vector 5 nil) + (let ((weight (fc-pattern-get-weight pattern 0)) + (size (fc-pattern-get-size pattern 0)) + (slant (fc-pattern-get-slant pattern 0))) + (vector + entry + (if (fc-pattern-get-successp family) + family) + (if (fc-pattern-get-successp size) + size) + (if (fc-pattern-get-successp weight) + (fc-font-weight-translate-to-string weight)) + (if (fc-pattern-get-successp slant) + (fc-font-slant-translate-to-string slant)))))))))) + +(defun x-font-menu-font-data-core (face dcache) (let* ((case-fold-search t) (domain (if font-menu-this-frame-only-p (selected-frame) ＠＠ -229,6 +340,24 ＠＠ or if you change your font path, you can (vector entry family size weight slant)))) (defun x-font-menu-load-font (family weight size slant resolution) + (if (featurep 'xft-fonts) + (x-font-menu-load-font-xft family weight size slant resolution) + (x-font-menu-load-font-core family weight size slant resolution))) + +(defun x-font-menu-load-font-xft (family weight size slant resolution) + (let ((pattern (make-fc-pattern))) + (fc-pattern-add pattern fc-font-name-property-family family) + (if weight + (fc-pattern-add pattern fc-font-name-property-weight + (fc-font-weight-translate-from-string weight))) + (if size + (fc-pattern-add pattern fc-font-name-property-size size)) + (if slant + (fc-pattern-add pattern fc-font-name-property-slant + (fc-font-slant-translate-from-string slant))) + (make-font-instance (fc-name-unparse pattern)))) + +(defun x-font-menu-load-font-core (family weight size slant resolution) "Try to load a font with the requested properties. The weight, slant and resolution are only hints." (when (integerp size) (setq size (int-to-string size))) 1.2 +534 -0 XEmacs/xemacs/lisp/fontconfig.el Index: fontconfig.el =================================================================== RCS file: fontconfig.el diff -N fontconfig.el --- /dev/null Sat Nov 26 12:45:38 2005 +++ /tmp/cvsAAAG2ayKX Sat Nov 26 12:45:57 2005 ＠＠ -0,0 +1,534 ＠＠ +;;; fontconfig.el --- New font model, NG + +;; Copyright (c) 2003 Eric Knauel and Matthias Neubauer +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. + +;; Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de&gt; +;; Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de&gt; +;; Stephen J. Turnbull <stephen(a)xemacs.org&gt; +;; Created: 27 Oct 2003 +;; Updated: 05 Mar 2005 by Stephen J. Turnbull +;; Keywords: faces + +;; 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 GNU + +;;; Commentary: + +;; This file is one of the pillars of the face refactoring effort +;; (another will be colorconfig.el, and there may be others). + +;; The overall plan is to have a sensible modern model for values of +;; each of the components of a face (starting with fonts and colors), +;; implemented in a single module. Of course we must be able to +;; convert such values to appropriate descriptors for any device type +;; on the one hand, but on the other it seems unreasonable to force +;; users to deal with a large number of different (and arcane, in the +;; case of XLFD) naming formats. + +;; This file implements font specification. We call a specification a +;; *pattern* to conform to fontconfig usage. The internal +;; representation of a pattern will have Keith Packard's fontconfig +;; API. For one, there is a robust and free C implementation, which +;; is available as a package for all platforms supported by X.org or +;; XFree86. For another, it seems to be capable of representing any +;; specification of any of the font models I know. Third, on X +;; platforms that internal representation can be passed verbatim to +;; libXft to get high quality TrueType fonts rendered with +;; anti-aliasing and hinting. + +;; We will support the following user interfaces: + +;; 1. fontconfig font names +;; 2. X Logical Font Descriptions (XLFD) +;; 3. MS Windows font names +;; 4. Mac OS X font names + +;; and possibly others (such as ad hoc abbreviations used in older X11 +;; implementations). This is called the *fontname UI* (for the +;; platform) to distinguish it from XEmacs's internal model +;; (fontconfig patterns) and the API for rendering engines (called the +;; *font API* for the engine). + +;; We will support the following rendering engine APIs: + +;; 1. fontconfig patterns (the native language of Xft); to emphasize +;; the engine-specific nature, we will call these *Xft fonts* +;; 2. XLFD strings +;; 3. MS Windows font names + +;; and possibly others (such as Mac OS X font names). This is called +;; the *font API* (for the platform) to distinguish it from XEmacs's +;; internal model (fontconfig *patterns*) and the names used by users +;; (called the *fontname UI* for the platform). + + +;; TODO (possible enhancements) +;; 1. add a more complete docstring for properties as such (would be a +;; hash table?) to describe things like special symbolic values, and +;; Emacs-relevant semantics +;; 2. add a special value defining macro for constants + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; The fontconfig pattern API +;; +;; The basic interfaces are defined as API wrappers in C in xft-font.c +;; #### which should be renamed to fontconfig.c. These are prefixed +;; with "fc-pattern-". These are +;; +;; fc-pattern-p +;; fc-pattern-create +;; fc-pattern-duplicate +;; fc-pattern-add +;; fc-pattern-del +;; fc-pattern-get +;; fc-pattern-destroy + +;; We provide a LISP-y alias, `make-fc-pattern' for the pattern +;; constructor function `fc-pattern-create'. #### It might make sense +;; to generalize `make-fc-pattern' by allowing a plist of properties +;; as an optional argument. We also provide accessors +;; `fc-pattern-get-PROPERTY' and mutators `fc-pattern-add-PROPERTY' +;; for each of the standard properties used by Xft, which overlap +;; substantially with the properties defined by X11. #### We probably +;; should provide `fc-pattern-delete-PROPERTY', too. + +(defalias 'make-fc-pattern 'fc-pattern-create) + +(defmacro fc-define-property (property type docfrag &optional obsolete-p) + "Define PROPERTY as a fontconfig font property of type TYPE using DOCFRAG. + +A font property is a key in a fontconfig pattern and is associated with +one or more values of a given type. This macro creates wrappers around +`fc-pattern-get' and `fc-pattern-add' for PROPERTY. Wrappers are +preferred to use of primitives with a string as the OBJECT argument because +typos in wrappers result in \"not fboundp\" errors, while a typo in a string +produces a silent null return. + +PROPERTY is a string. +TYPE is a symbol indicating the type of the property value. It is used only +to modify formatting of the wrapper function docstrings. +DOCFRAG is a string which briefly describes the use of the property, and is +interpolated into a format to create the doctstrings. +OBSOLETE-P if non-nil marks the property as pertaining only to older versions +of fontconfig or Xft. This merely adds a deprecation to the docstrings. + +This macro defines an accessor named `fc-pattern-get-PROPERTY' which takes +a fontconfig pattern object and an integer as arguments, and returns the +value associated with PROPERTY and ID in the pattern object. Since it is +not possible to associate a value to PROPERTY for a particular ID, it is +not very useful to interpret the values associated with a given id for +different properties as being linked to each other in some way. + +A mutator `fc-pattern-add-PROPERTY' which takes a fontconfig pattern object +and a value as arguments, and adds the value to the property with the next +id. The type of the value is recognized by `fc-pattern-add', and the id +is chosen by the fontconfig implementation." + + `(progn + (defsubst ,(intern (concat "fc-pattern-get-" property)) + (pattern id) + ,(format "\ +Return %s %s fc pattern PATTERN %s.%s + +This function is a convenience wrapper for `fc-pattern-get'. +See `fc-pattern-get' for documentation of patterns, ids, and error returns." + (if (eq type 'boolean) + "t" + docfrag) + (if (eq type 'boolean) + "if" + "associated with id ID in") + (if (eq type 'boolean) + docfrag + (format "as a%s %s" (if (eq type 'integer) "n" "") type)) + (if obsolete-p " +\(Obsolete, only available on systems using Xft version 1.)" + "")) + (fc-pattern-get pattern ,property id)) + + (defsubst ,(intern (concat "fc-pattern-add-" property)) + (pattern value) + ,(format "\ +Add VALUE to the %s property of fontconfig pattern PATTERN.%s + +The type of VALUE should be %s. + +This function is a convenience wrapper for `fc-pattern-add'. +See `fc-pattern-add' for documentation of patterns, values, and error returns." + property + (if obsolete-p " +\(Obsolete, only available on systems using Xft version 1.)" + "") + type) + (fc-pattern-add pattern ,property value)) + ,property)) + +;; define the standard properties for Xft v.2 here +(fc-define-property "antialias" boolean "the font supports antialiasing") +(fc-define-property "dpi" float "the design resolution") +(fc-define-property "family" string "the font family") +(fc-define-property "file" string "the file containing glyph data") +(fc-define-property "foundry" string "the vendor") +(fc-define-property "index" integer "the index of the glyph set") +(fc-define-property "minspace" boolean "has a minimum spacing") +(fc-define-property "outline" boolean "is an outline font") +(fc-define-property "pixelsize" float "the size in pixels") +(fc-define-property "rasterizer" string "the name of the rasterizing engine") +(fc-define-property "rgba" integer "the subpixel rendering capabilities") +(fc-define-property "scalable" boolean "is scalable") +(fc-define-property "scale" float "the scale factor") +(fc-define-property "size" float "the size in points") +(fc-define-property "slant" integer "the slant") +(fc-define-property "spacing" integer "the spacing model") +(fc-define-property "style" string "the typographic face or style") +(fc-define-property "weight" integer "the weight") +(fc-define-property "xlfd" string "the XLFD (full name in X11)") + +;; Xft v.1 properties (marked as obsolete) +(fc-define-property "encoding" string "the encoding" t) +(fc-define-property "charwidth" integer "the average character width" t) +(fc-define-property "charheight" integer "the average character height" t) +(fc-define-property "core" boolean "represents a core font" t) +(fc-define-property "render" boolean "represents a render (Xft) font" t) + + +(defconst fc-font-name-property-family "family") +(defconst fc-font-name-property-style "style") +(defconst fc-font-name-property-slant "slant") +(defconst fc-font-name-property-weight "weight") +(defconst fc-font-name-property-size "size") +(defconst fc-font-name-property-pixelsize "pixelsize") +(defconst fc-font-name-property-spacing "spacing") +(defconst fc-font-name-property-foundry "foundry") +(defconst fc-font-name-property-antialias "antialias") +(defconst fc-font-name-property-xlfd "xlfd") +(defconst fc-font-name-property-file "file") +(defconst fc-font-name-property-index "index") +(defconst fc-font-name-property-rasterizer "rasterizer") +(defconst fc-font-name-property-outline "outline") +(defconst fc-font-name-property-scalable "scalable") +(defconst fc-font-name-property-rgba "rgba") +(defconst fc-font-name-property-minspace "minspace") +(defconst fc-font-name-property-dpi "dpi") + +;; Xft version 1 only +;;(defconst fc-font-name-property-encoding "encoding") +;;(defconst fc-font-name-property-charwidth "charwidth") +;;(defconst fc-font-name-property-charheight "charheight") +;;(defconst fc-font-name-property-core "core") +;;(defconst fc-font-name-property-render "render") + + +(defconst fc-pattern-selector-mapping + `((,fc-font-name-property-family . fc-pattern-get-family) + (,fc-font-name-property-style . fc-pattern-get-style) + (,fc-font-name-property-slant . fc-pattern-get-slant) + (,fc-font-name-property-weight . fc-pattern-get-weight) + (,fc-font-name-property-size . fc-pattern-get-size) + (,fc-font-name-property-pixelsize . fc-pattern-get-pixelsize) + (,fc-font-name-property-spacing . fc-pattern-get-spacing) + (,fc-font-name-property-foundry . fc-pattern-get-foundry) + (,fc-font-name-property-antialias . fc-pattern-get-antialias) + (,fc-font-name-property-xlfd . fc-pattern-get-xlfd) + (,fc-font-name-property-file . fc-pattern-get-file) + (,fc-font-name-property-index . fc-pattern-get-index) + (,fc-font-name-property-rasterizer . fc-pattern-get-rasterizer) + (,fc-font-name-property-outline . fc-pattern-get-outline) + (,fc-font-name-property-scalable . fc-pattern-get-scalable) + (,fc-font-name-property-rgba . fc-pattern-get-rgba) + (,fc-font-name-property-minspace . fc-pattern-get-minspace) + (,fc-font-name-property-dpi . fc-pattern-get-dpi) + ;; Xft version 1 only + ;; (,fc-font-name-property-encoding . fc-pattern-get-encoding) + ;; (,fc-font-name-property-charwidth . fc-pattern-get-char-width) + ;; (,fc-font-name-property-charheight . fc-pattern-get-char-height) + ;; (,fc-font-name-property-core . fc-pattern-get-core) + ;; (,fc-font-name-property-render . fc-pattern-get-render) + )) + +(defvar fc-find-available-font-families-fc-fonts-only t + "If `fc-find-available-font-families-fc-fonts-only' is set to `t', +`fc-find-available-font-families' will ignore core fonts.") + +(defconst fc-font-name-slant-roman 0) +(defconst fc-font-name-slant-italic 100) +(defconst fc-font-name-slant-oblique 110) + +(defconst fc-font-name-slant-mapping + `((,fc-font-name-slant-roman . :roman) + (,fc-font-name-slant-italic . :italic) + (,fc-font-name-slant-oblique . :oblique))) + +(defconst fc-font-name-slant-mapping-string + `((,fc-font-name-slant-roman . "R") + (,fc-font-name-slant-roman . "I") + (,fc-font-name-slant-roman . "O"))) + +(defconst fc-font-name-slant-mapping-string-reverse + `(("R" . ,fc-font-name-slant-roman) + ("I" . ,fc-font-name-slant-italic) + ("O" . ,fc-font-name-slant-oblique))) + +(defconst fc-font-name-slant-mapping-reverse + `((:roman . ,fc-font-name-slant-roman) + (:italic . ,fc-font-name-slant-italic) + (:oblique . ,fc-font-name-slant-oblique))) + +(defun fc-font-slant-translate-from-constant (number) + "Translate the Xft font slant constant NUMBER to symbol." + (let ((pair (assoc number fc-font-name-slant-mapping))) + (if pair (cdr pair)))) + +(defun fc-font-slant-translate-from-symbol (symbol) + "Translate SYMBOL (`:roman', `:italic' or `:oblique') to the +corresponding Xft font slant constant." + (let ((pair (assoc symbol fc-font-name-slant-mapping-reverse))) + (if pair (cdr pair)))) + +(defun fc-font-slant-translate-to-string (num-or-sym) + (let* ((constant (if (symbolp num-or-sym) + (cdr (assoc num-or-sym fc-font-name-slant-mapping-reverse)) + num-or-sym)) + (pair (assoc constant fc-font-name-slant-mapping-string))) + (if pair (cdr pair)))) + +(defun fc-font-slant-translate-from-string (str) + (let ((pair (assoc str fc-font-name-slant-mapping-string-reverse))) + (if pair (cdr pair)))) + +(defconst fc-font-name-weight-light 0) +(defconst fc-font-name-weight-regular 80) +(defconst fc-font-name-weight-medium 100) +(defconst fc-font-name-weight-demibold 180) +(defconst fc-font-name-weight-bold 200) +(defconst fc-font-name-weight-black 210) + +(defconst fc-font-name-weight-mapping + `((,fc-font-name-weight-light . :light) + (,fc-font-name-weight-regular . :regular) + (,fc-font-name-weight-medium . :medium) + (,fc-font-name-weight-demibold . :demibold) + (,fc-font-name-weight-bold . :bold) + (,fc-font-name-weight-black . :black))) + +(defconst fc-font-name-weight-mapping-string + `((,fc-font-name-weight-light . "Light") + (,fc-font-name-weight-regular . "Regular") + (,fc-font-name-weight-medium . "Medium") + (,fc-font-name-weight-demibold . "Demibold") + (,fc-font-name-weight-bold . "Bold") + (,fc-font-name-weight-black . "Black"))) + +(defconst fc-font-name-weight-mapping-string-reverse + `(("Light" . ,fc-font-name-weight-light) + ("Regular" . ,fc-font-name-weight-regular) + ("Medium" . ,fc-font-name-weight-medium) + ("Demibold" . ,fc-font-name-weight-demibold) + ("Bold" . ,fc-font-name-weight-bold) + ("Black" . ,fc-font-name-weight-black))) + +(defconst fc-font-name-weight-mapping-reverse + `((:light . ,fc-font-name-weight-light) + (:regular . ,fc-font-name-weight-regular) + (:medium . ,fc-font-name-weight-medium) + (:demibold . ,fc-font-name-weight-demibold) + (:bold . ,fc-font-name-weight-bold) + (:black . ,fc-font-name-weight-black))) + +(defun fc-font-weight-translate-from-constant (number) + "Translate a Xft font weight constant NUMBER to symbol." + (let ((pair (assoc number fc-font-name-weight-mapping))) + (if pair (cdr pair)))) + +(defun fc-font-weight-translate-from-symbol (symbol) + "Translate SYMBOL (`:light', `:regular', `:medium', `:demibold', +`:bold' or `:black') to the corresponding Xft font weight constant." + (let ((pair (assoc symbol fc-font-name-weight-mapping-reverse))) + (if pair (cdr pair)))) + +(defun fc-font-weight-translate-to-string (num-or-sym) + (let* ((constant (if (symbolp num-or-sym) + (cdr (assoc num-or-sym fc-font-name-weight-mapping-reverse)) + num-or-sym)) + (pair (assoc constant fc-font-name-weight-mapping-string))) + (if pair (cdr pair)))) + +(defun fc-font-weight-translate-from-string (str) + (let ((pair (assoc str fc-font-name-weight-mapping-string-reverse))) + (if pair (cdr pair)))) + +(defun fc-copy-pattern-partial (pattern attribute-list) + "Return a copy of PATTERN restricted to ATTRIBUTE-LIST. + +PATTERN is a fontconfig pattern object. +ATTRIBUTE-LIST is a list of strings denoting font properties. +A new object is allocated and returned." + (let ((new (make-fc-pattern)) + (attrs attribute-list)) + ;;; We demand proper tail recursion! + (while (not (null attrs)) + (let ((get (intern (concat "fc-pattern-get-" (car attrs)))) + (set (intern (concat "fc-pattern-add-" (car attrs))))) + (if (and (fboundp get) (fboundp set)) + (funcall set new (funcall get pattern 0)) + (warn "property '%s' not defined, ignoring" (car attrs)))) + (setq attrs (cdr attrs))) + new)) + +(defun fc-pattern-get-all-attributes (fc-pattern fc-pattern-get-function) + (let ((count 0) + res end val) + (while (not end) + (setq val (funcall fc-pattern-get-function fc-pattern count)) + (if (or (equal val 'fc-result-no-id) + (equal val 'fc-result-no-match)) + (setq end t) + (setq res (append res (list val)) + count (+ count 1)))) + res)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; The fontconfig fontname UI +;; +;; The basic interfaces are defined as API wrappers in C in xft-font.c +;; #### which should be renamed to fontconfig.c. These are prefixed +;; with "fc-name-". These are +;; +;; fc-name-parse +;; fc-name-unparse +;; xft-name-unparse + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; The fontconfig font API +;; +;; The basic interfaces are defined as API wrappers in C in xft-font.c +;; #### which should be renamed to fontconfig.c. These are prefixed +;; with "fc-font-". These are +;; +;; fc-font-match +;; fc-list-fonts-pattern-objects +;; fc-font-sort +;; fc-font-real-pattern + +;; #### it might make sense to generalize `fc-try-font' by having a +;; global variable that contains a list of font name parsers. They are +;; tried in order, and the first one to return an fc-pattern is matched. + +(defun fc-try-font (font &optional device) + "Return list of pattern objects matching FONT on DEVICE. + +FONT may be a fontconfig pattern object or a fontconfig font name (a string). +Optional DEVICE is the device object to query, defaulting to the currently +selected device." + (fc-list-fonts-pattern-objects (or device (default-x-device)) + (if (fc-pattern-p font) + font + (fc-name-parse font)) + nil)) + +(defun fc-find-available-font-families (&optional device filter-fun) + "Find all available font families." + (let ((device (or device (default-x-device))) + (pattern (make-fc-pattern)) + (objectset '("family" "style"))) +; Xft2: does not work anymore +; (if (not fc-find-available-font-families-fc-fonts-only) +; (fc-pattern-add pattern fc-font-name-property-core t)) +; (fc-objectset-add objectset fc-font-name-property-encoding) + (let* ((all-fonts + (fc-list-fonts-pattern-objects device pattern objectset))) + (fc-delete-duplicates + (mapcar + '(lambda (pattern) + (fc-pattern-get-family pattern 0)) + (if filter-fun + (fc-filter all-fonts filter-fun) + all-fonts)))))) + +; Xft2: does not work anymore +; (defun fc-find-available-font-families-non-mule (&optional device) +; (fc-find-available-font-families +; device +; '(lambda (pattern) +; (let ((encodings (fc-pattern-get-all-attributes +; pattern 'fc-pattern-get-encoding))) +; ;; Be sure that the font support ISO-8859-1 +; (member "iso8859-1" encodings))))) + +(defun fc-find-available-weights-for-family (family &optional style device) + "Find available weights for font FAMILY." + (let* ((device (or device (default-x-device))) + (pattern (make-fc-pattern)) + (objectset '("weight"))) + (fc-pattern-add pattern fc-font-name-property-family family) + (if style + (fc-pattern-add pattern fc-font-name-property-style style)) + (mapcar + '(lambda (pattern) + (let ((fc-weight-constant (fc-pattern-get-weight pattern 0))) + (if fc-weight-constant + (fc-font-weight-translate-from-constant fc-weight-constant)))) + (fc-list-fonts-pattern-objects device pattern objectset)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; The XLFD fontname UI +;; + +;; xlfd-font-name-p + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Utility functions +;; + +(defun fc-pattern-get-successp (result) + (and (not (equal result 'fc-result-no-match)) + (not (equal result 'fc-result-no-id)) + (not (equal result 'fc-internal-error)))) + +;;; DELETE-DUPLICATES and REMOVE-DUPLICATES from cl-seq.el do not +;;; seem to work on list of strings... +;;; #### Presumably just use :test 'equal! +(defun fc-delete-duplicates (l) + (let ((res nil) + (in l)) + (while (not (null in)) + (if (not (member (car in) res)) + (setq res (append res (list (car in))))) + (setq in (cdr in))) + res)) + +;; #### Use delete-if with :test 'equal. +(defun fc-filter (l fun) + (let ((res nil) + (in l)) + (while (not (null in)) + (if (funcall fun (car in)) + (setq res (append res (list (car in))))) + (setq in (cdr in))) + res)) + +(provide 'fontconfig) + +;;; fontconfig.el ends here 1.76 +113 -0 XEmacs/xemacs/lwlib/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/ChangeLog,v retrieving revision 1.75 retrieving revision 1.76 diff -u -p -r1.75 -r1.76 --- ChangeLog 2005/11/22 07:14:40 1.75 +++ ChangeLog 2005/11/26 11:45:58 1.76 ＠＠ -1,3 +1,116 ＠＠ +2005-11-26 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Merge Xft. + + 2005-11-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * lwlib-colors: Improve comments. + + 2005-11-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * lwlib-colors: Remove or comment out dead code. + + 2005-09-26 Olivier Galibert <galibert(a)xemacs.org&gt; + + * xlwmenu.c: + * xlwmenuP.h: + Give USE_XFT_MENUBARS priority over USE_MOTIF. + + 2005-09-06 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * lwlib-fonts.c (xft_open_font_by_name): Fix heuristic for XLFDs. + + * xlwmenu.c (string_draw_range): Recommend persistent xftDraw. + + 2005-09-02 Daniel Pittman <daniel(a)rimspace.net&gt; + + * lwlib-fonts.c (xft_open_font_by_name): Eliminate code to avoid + use of scaled fonts (probably bogus, anyway). Add error message + in case of fatal failure to find any fonts at all. + <87ll2fucw1.fsf(a)rimspace.net&gt; + + * xlwmenu.c (string_draw_range): Plug leak of XftDraw. + + 2005-03-09 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xlwtabs.c (TabsGeometryManager): Fix "fat fingers" mistake. + + 2005-03-07 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * lwlib-Xaw.c (debug_gauge): Fix and suppress gauge debug message. + + * xlwtabs.c (TabsGeometryManager): Suppress "kludging" message, too. + (TabsGeometryManager): Make straight the paths of the layout, or + at least improve the approximation to Xt conventions by 50%. + + 2005-02-22 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xlwtabs.c(debug_tabs): Suppress debug output for now. + + 2005-02-18 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xlwtabs.c (TabsGeometryManager,TabsQueryGeometry): Improve comments. + (debug_tabs): New variable, substitute for debug_xft globally. + (TabsGeometryManager): Substitute "request" for "req". + + 2005-02-11 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xlwtabs.c (PreferredSize3): Let TabLayout choose constraints. + (TabLayout): Default size to current size. Fix header comment. + (TabsGeometryManager): Comment on redesigning internal API. + (TabsGeometryManager): Fix typo in format string. + + 2005-01-27 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xlwtabs.c (DrawTab): + Correct geometry when clearing rectangle. + Remove some "check me" comments. + Deemphasize a lot of debugging output. + (TabLayout): Add debugging fprintf. + (TabWidth): Deemphasize some debugging output. + + 2004-12-10 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * lwlib-Xaw.c (xaw_create_button): + (xaw_create_progress): + (xaw_create_text_field): + Changed XtCreateManagedWidget to XtCreateWidget when child is + managed later in the same function. + + (debug_gauge): New variable. + (lw_debug_print_xt_arglist): + (lw_debug_print_class_resources): + New debug functions. + + 2004-12-09 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xlwmenu.c (xlwMenuResources): Use "redundant" XftFont resource. + + * xlwtabs.c: + * xlwtabsP.h: + Use USE_XFT_TABS consistently. + + 2004-12-01 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xlwtabs.c: Move debug_xft to ../src/xft-fonts.c. + + 2004-11-20 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Xft branch based on "Xft reloaded #3" patch by Eric Knauel and + Mathias Neuebaur, and other contributors. + + * lwlib-fonts.h: + * lwlib-colors.h: + Declare common facilities use by Xft. + * lwlib-fonts.c: + * lwlib-colors.c: + Implement them. + * xlwtabs.c: + * xlwtabsP.h: + * xlwmenu.c: + * xlwmenuP.h: + Implement Xft text drawing. + 2005-11-22 Ben Wing <ben(a)xemacs.org&gt; * Makefile.in.in: 1.21 +3 -1 XEmacs/xemacs/lwlib/Makefile.in.in Index: Makefile.in.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/Makefile.in.in,v retrieving revision 1.20 retrieving revision 1.21 diff -u -p -r1.20 -r1.21 --- Makefile.in.in 2005/11/22 07:14:40 1.20 +++ Makefile.in.in 2005/11/26 11:45:58 1.21 ＠＠ -49,7 +49,7 ＠＠ vpath %.h ＠srcdir＠ VPATH=＠srcdir＠ #endif -objs = lwlib.o lwlib-utils.o ＠lwlib_objs＠ +objs = lwlib.o lwlib-utils.o lwlib-colors.o lwlib-fonts.o ＠lwlib_objs＠ all: liblw.a ＠＠ -110,6 +110,8 ＠＠ lwlib-Xlw.o: $(CONFIG_H) lwlib-Xlw.h lwl xlwtabs.h xlwgcs.h lwlib-Xm.o: $(CONFIG_H) lwlib-Xm.h lwlib-internal.h lwlib-utils.h lwlib.h xlwmenu.h lwlib-utils.o: $(CONFIG_H) lwlib-utils.h +lwlib-colors.o: $(CONFIG_H) lwlib-colors.h +lwlib-fonts.o: $(CONFIG_H) lwlib-fonts.h lwlib.o: $(CONFIG_H) lwlib-Xaw.h lwlib-Xlw.h lwlib-Xm.h lwlib-internal.h lwlib-utils.h lwlib.h xlwmenu.h xlwmenu.o: $(CONFIG_H) lwlib.h xlwmenu.h xlwmenuP.h xlwscrollbar.o: $(CONFIG_H) xlwscrollbar.h xlwscrollbarP.h 1.12 +73 -8 XEmacs/xemacs/lwlib/lwlib-Xaw.c Index: lwlib-Xaw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-Xaw.c,v retrieving revision 1.11 retrieving revision 1.12 diff -u -p -r1.11 -r1.12 --- lwlib-Xaw.c 2004/09/20 19:19:16 1.11 +++ lwlib-Xaw.c 2005/11/26 11:45:59 1.12 ＠＠ -52,6 +52,7 ＠＠ Boston, MA 02111-1307, USA. */ static void xaw_generic_callback (Widget, XtPointer, XtPointer); +extern int debug_xft; Boolean lw_xaw_widget_p (Widget widget) ＠＠ -738,7 +739,7 ＠＠ xaw_create_button (widget_instance *inst lw_add_value_args_to_args (val, al, &ac); if (!val->call_data) - button = XtCreateManagedWidget (val->name, labelWidgetClass, + button = XtCreateWidget (val->name, labelWidgetClass, instance->parent, al, ac); else ＠＠ -746,20 +747,21 ＠＠ xaw_create_button (widget_instance *inst if (val->type == TOGGLE_TYPE || val->type == RADIO_TYPE) { XtSetArg (al [ac], XtNstate, val->selected); ac++; - button = XtCreateManagedWidget + button = XtCreateWidget (val->name, val->type == TOGGLE_TYPE ? checkboxWidgetClass : radioWidgetClass, instance->parent, al, ac); } else { - button = XtCreateManagedWidget (val->name, commandWidgetClass, + button = XtCreateWidget (val->name, commandWidgetClass, instance->parent, al, ac); } XtRemoveAllCallbacks (button, XtNcallback); XtAddCallback (button, XtNcallback, xaw_generic_callback, (XtPointer)instance); } + /* #### this maybe can be folded into the XtCreateWidget calls above */ XtManageChild (button); return button; ＠＠ -788,7 +790,8 ＠＠ xaw_create_label (Widget parent, widget_ label = XtCreateManagedWidget (val->name, labelWidgetClass, parent, al, ac); - /* Do it again for arguments that have no effect until the widget is realized. */ + /* Do it again for arguments that have no effect until the widget is realized. + #### Uh, but the widget isn't realized until later? Do we mean "created"? */ ac = 0; lw_add_value_args_to_args (val, al, &ac); if (ac > 20) ＠＠ -798,6 +801,60 ＠＠ xaw_create_label (Widget parent, widget_ return label; } +static int debug_gauge = 0; + +static void +lw_debug_print_xt_arglist (ArgList al, int ac) +{ + int i; + for (i = 0; i < ac; i++) + fprintf (stderr, "Widget has arg %s with value %lu.\n", + al[i].name, (unsigned long) al[i].value); +} + +static void +lw_debug_print_class_resources (WidgetClass class_) +{ + Cardinal i; + do { + Cardinal m, n = class_->core_class.num_resources; + XtResourceList rl; + fprintf (stderr, "Class is %s (%p/%p) with %d resources.\n", + class_->core_class.class_name, class_, &(class_->core_class), n); + fprintf (stderr, " Class's resources are at %p. Converting...\n", + class_->core_class.resources); + /* resources may be compiled to an internal format */ + XtGetResourceList (class_, &rl, &m); + for (i = 0; i < m; i++) + fprintf (stderr, + " Class has a %s resource of type %s initialized from %s.\n", + rl[i].resource_class, rl[i].resource_type, rl[i].default_type); + /* special cases for commonly problematic resources */ + for (i = 0; i < m; i++) + { + if (!strcmp (rl[i].resource_class, "Font")) + { + fprintf (stderr, " Class has a Font resource.\n"); + fprintf (stderr, " Font resource is %s.\n", + (char *) rl[i].default_addr); + } + if (!strcmp (rl[i].resource_class, "FontSet")) + { + fprintf (stderr, " Class has a FontSet resource.\n"); + fprintf (stderr, " FontSet resource is %s.\n", + (char *) rl[i].default_addr); + } + if (!strcmp (rl[i].resource_class, "International")) + { + fprintf (stderr, " Class has an International resource.\n"); + fprintf (stderr, " International resource is %d.\n", + (int) rl[i].default_addr); + } + } + class_ = class_->core_class.superclass; + } while (class_ != NULL); +} + static Widget xaw_create_progress (widget_instance *instance) { ＠＠ -825,13 +882,21 ＠＠ xaw_create_progress (widget_instance *in /* add any args the user supplied for creation time */ lw_add_value_args_to_args (val, al, &ac); + + if (debug_gauge > 1) + lw_debug_print_class_resources (gaugeWidgetClass); + if (debug_gauge > 0) + lw_debug_print_xt_arglist (al, ac); + + scale = XtCreateWidget (val->name, gaugeWidgetClass, + instance->parent, al, ac); - scale = XtCreateManagedWidget (val->name, gaugeWidgetClass, - instance->parent, al, ac); /* add the callback */ if (val->call_data) - XtAddCallback (scale, XtNgetValue, xaw_generic_callback, (XtPointer)instance); + XtAddCallback (scale, XtNgetValue, xaw_generic_callback, + (XtPointer) instance); + /* #### this maybe can be folded into the XtCreateWidget call above */ XtManageChild (scale); return scale; ＠＠ -864,7 +929,7 ＠＠ xaw_create_text_field (widget_instance * /* add any args the user supplied for creation time */ lw_add_value_args_to_args (val, al, &ac); - text = XtCreateManagedWidget (val->name, asciiTextWidgetClass, + text = XtCreateWidget (val->name, asciiTextWidgetClass, instance->parent, al, ac); /* add the callback */ 1.15 +2 -2 XEmacs/xemacs/lwlib/lwlib-Xlw.c Index: lwlib-Xlw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-Xlw.c,v retrieving revision 1.14 retrieving revision 1.15 diff -u -p -r1.14 -r1.15 --- lwlib-Xlw.c 2005/03/09 05:58:54 1.14 +++ lwlib-Xlw.c 2005/11/26 11:45:59 1.15 ＠＠ -479,8 +479,8 ＠＠ xlw_create_clip_window (widget_instance Widget clip = 0; widget_value* val = instance->info->val; - XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; - XtSetArg (al [ac], XtNsensitive, TRUE); ac++; + XtSetArg (al [ac], XtNmappedWhenManaged, False); ac++; + XtSetArg (al [ac], XtNsensitive, True); ac++; /* add any args the user supplied for creation time */ lw_add_value_args_to_args (val, al, &ac); 1.38 +317 -107 XEmacs/xemacs/lwlib/xlwmenu.c Index: xlwmenu.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/xlwmenu.c,v retrieving revision 1.37 retrieving revision 1.38 diff -u -p -r1.37 -r1.38 --- xlwmenu.c 2004/09/20 19:19:17 1.37 +++ xlwmenu.c 2005/11/26 11:45:59 1.38 ＠＠ -45,6 +45,11 ＠＠ Boston, MA 02111-1307, USA. */ #define XmFONTLIST_DEFAULT_TAG XmSTRING_DEFAULT_CHARSET #endif /* XmVersion < 1.2 */ #endif + +/* #### we may want to turn off USE_XFT here if !USE_XFT_MENUBARS + In fact, maybe that's the right interface overall? */ +#include "lwlib-fonts.h" +#include "lwlib-colors.h" #include "xlwmenuP.h" #ifdef USE_DEBUG_MALLOC ＠＠ -69,7 +74,7 ＠＠ extern Widget lw_menubar_widget; static XtResource xlwMenuResources[] = { -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) /* There are three font list resources, so that we can accept either of the resources *fontList: or *font:, and so that we can tell the difference between them being specified, and being defaulted to a ＠＠ -87,6 +92,11 ＠＠ xlwMenuResources[] = #else {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), offset(menu.font), XtRString, (XtPointer) "XtDefaultFont"}, +#ifdef USE_XFT_MENUBARS + {XtNxftFont, XtCXftFont, XtRString, sizeof (String), + offset(menu.renderFontSpec), + XtRString, (XtPointer) "Helvetica-12:bold"}, +#endif # ifdef USE_XFONTSET /* #### Consider using the same method as for Motif; see the comment in XlwMenuInitialize(). */ ＠＠ -165,7 +175,7 ＠＠ static void Start (Widget w, XEvent *ev, static void Drag (Widget w, XEvent *ev, String *params, Cardinal *num_params); static void Select(Widget w, XEvent *ev, String *params, Cardinal *num_params); -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) static XFontStruct *default_font_of_font_list (XmFontList); #endif ＠＠ -241,57 +251,6 ＠＠ safe_strdup (char *s) #endif /* 0 */ -/* Replacement for XAllocColor() that tries to return the nearest - available color if the colormap is full. From FSF Emacs. */ - -static int -allocate_nearest_color (Display *display, Colormap screen_colormap, - XColor *color_def) -{ - int status = XAllocColor (display, screen_colormap, color_def); - if (status) - return status; - - { - /* If we got to this point, the colormap is full, so we're - going to try to get the next closest color. - The algorithm used is a least-squares matching, which is - what X uses for closest color matching with StaticColor visuals. */ - - int nearest, x; - unsigned long nearest_delta = ULONG_MAX; - - int no_cells = XDisplayCells (display, XDefaultScreen (display)); - /* Don't use alloca here because lwlib doesn't have the - necessary configuration information that src does. */ - XColor *cells = (XColor *) malloc (sizeof (XColor) * no_cells); - - for (x = 0; x < no_cells; x++) - cells[x].pixel = x; - - XQueryColors (display, screen_colormap, cells, no_cells); - - for (nearest = 0, x = 0; x < no_cells; x++) - { - long dred = (color_def->red >> 8) - (cells[x].red >> 8); - long dgreen = (color_def->green >> 8) - (cells[x].green >> 8); - long dblue = (color_def->blue >> 8) - (cells[x].blue >> 8); - unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue; - - if (delta < nearest_delta) - { - nearest = x; - nearest_delta = delta; - } - } - color_def->red = cells[nearest].red; - color_def->green = cells[nearest].green; - color_def->blue = cells[nearest].blue; - free (cells); - return XAllocColor (display, screen_colormap, color_def); - } -} - static void push_new_stack (XlwMenuWidget mw, widget_value *val) { ＠＠ -355,14 +314,14 ＠＠ close_to_reference_time (Widget w, Time /* Size code */ static int string_width (XlwMenuWidget mw, -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmString s #else char *s #endif ) { -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) Dimension width, height; XmStringExtent (mw->menu.font_list, s, &width, &height); return width; ＠＠ -372,10 +331,17 ＠＠ string_width (XlwMenuWidget mw, XmbTextExtents (mw->menu.font_set, s, strlen (s), &ri, &rl); return rl.width; # else +#ifdef USE_XFT_MENUBARS + XGlyphInfo glyphinfo; + XftTextExtents8 (XtDisplay (mw), mw->menu.renderFont, s, strlen (s), + &glyphinfo); + return glyphinfo.xOff; +#else XCharStruct xcs; int drop; XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs); return xcs.width; +#endif # endif /* USE_XFONTSET */ #endif } ＠＠ -402,22 +368,26 ＠＠ initialize_massaged_resource_char (void) static int string_width_u (XlwMenuWidget mw, -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmString string #else char *string #endif ) { -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) Dimension width, height; XmString newstring; #else # ifdef USE_XFONTSET XRectangle ri, rl; # else /* ! USE_XFONTSET */ +#ifdef USE_XFT_MENUBARS + XGlyphInfo glyphinfo; +#else XCharStruct xcs; int drop; +#endif # endif #endif char* newchars; ＠＠ -425,7 +395,7 ＠＠ string_width_u (XlwMenuWidget mw, char *chars; int i, j; -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) chars = ""; if (!XmStringGetLtoR (string, XmFONTLIST_DEFAULT_TAG, &chars)) chars = ""; ＠＠ -442,7 +412,7 ＠＠ string_width_u (XlwMenuWidget mw, newchars[j++] = chars[i]; newchars[j] = '\0'; -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) newstring = XmStringLtoRCreate (newchars, XmFONTLIST_DEFAULT_TAG); XmStringExtent (mw->menu.font_list, newstring, &width, &height); XmStringFree (newstring); ＠＠ -453,8 +423,14 ＠＠ string_width_u (XlwMenuWidget mw, XmbTextExtents (mw->menu.font_set, newchars, j, &ri, &rl); return rl.width; # else /* ! USE_XFONTSET */ +#ifdef USE_XFT_MENUBARS + XftTextExtents8 (XtDisplay (mw), mw->menu.renderFont, newchars, j, + &glyphinfo); + return glyphinfo.xOff; +#else XTextExtents (mw->menu.font, newchars, j, &drop, &drop, &drop, &xcs); return xcs.width; +#endif # endif /* USE_XFONTSET */ #endif } ＠＠ -621,7 +597,7 ＠＠ parameterize_string (const char *string, return result; } -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) static XmString resource_widget_value (XlwMenuWidget mw, widget_value *val) ＠＠ -769,20 +745,41 ＠＠ resource_widget_value (XlwMenuWidget mw, #endif /* !Motif */ +#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ + ? ((unsigned long) (x)) : ((unsigned long) (y))) + +#ifdef USE_XFT_MENUBARS +static int +x_xft_text_width (Display *dpy, XftFont *xft_font, char *run, int len) +{ + static XGlyphInfo glyphinfo; + + XftTextExtents8 (dpy, + xft_font, + run, len, &glyphinfo); + return glyphinfo.xOff; +} +#endif + /* Code for drawing strings. */ static void string_draw (XlwMenuWidget mw, Window window, int x, int y, +#ifdef USE_XFT_MENUBARS + XftColor *color, + XftColor *colorBg, +#else GC gc, -#ifdef NEED_MOTIF +#endif +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmString string #else char *string #endif ) { -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmStringDraw (XtDisplay (mw), window, mw->menu.font_list, string, gc, ＠＠ -792,15 +789,31 ＠＠ string_draw (XlwMenuWidget mw, 0, /* ???? layout_direction */ 0); #else -# ifdef USE_XFONTSET +# ifdef USE_XFT_MENUBARS + Display *display = XtDisplay (mw); + Visual *visual = DefaultVisualOfScreen (XtScreen (mw)); + Colormap cmap = mw->core.colormap; + XftDraw *xftDraw = XftDrawCreate (display, window, visual, cmap); + XftFont *renderFont = mw->menu.renderFont; + /* draw background rect */ + XftDrawRect (xftDraw, colorBg, + x, y, + x_xft_text_width (display, renderFont, string, strlen (string)), + renderFont->ascent + renderFont->descent); /* XXX */ + /* draw text */ + XftDrawString8 (xftDraw, color, renderFont, + x, y + mw->menu.font_ascent, string, strlen (string)); + XftDrawDestroy (xftDraw); +# else +# ifdef USE_XFONTSET XmbDrawString (XtDisplay (mw), window, mw->menu.font_set, gc, x, y + mw->menu.font_ascent, string, strlen (string)); -# else +# else XDrawString (XtDisplay (mw), window, gc, x, y + mw->menu.font_ascent, string, strlen (string)); -# endif /* USE_XFONTSET */ - -#endif +# endif /* USE_XFONTSET */ +# endif /* USE_XFT_MENUBARS */ +#endif /* NEED_MOTIF */ } static int ＠＠ -808,13 +821,18 ＠＠ string_draw_range ( XlwMenuWidget mw, Window window, int x, int y, +#ifdef USE_XFT_MENUBARS + XftColor *color, + XftColor *colorBg, +#else GC gc, +#endif char *string, int start, int end ) { -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) Dimension width, height; XmString newstring; int c; ＠＠ -851,18 +869,50 ＠＠ string_draw_range ( mw->menu.font_set, &string[start], end - start, &ri, &rl); return rl.width; # else +#ifdef USE_XFT_MENUBARS + if (end <= start) + return 0; + else + { + XGlyphInfo glyphinfo; + Display *display = XtDisplay (mw); + Visual *visual = DefaultVisualOfScreen (XtScreen (mw)); + Colormap cmap = mw->core.colormap; + XftFont *renderFont = mw->menu.renderFont; + /* #### should use parent frame's .xftDraw? */ + XftDraw *xftDraw = XftDrawCreate (display, window, visual, cmap); + /* draw background rect */ + XftDrawRect (xftDraw, colorBg, + x, y, + x_xft_text_width (display, + renderFont, &string[start], end - start), + renderFont->ascent + renderFont->descent); /* XXX */ + /* draw text */ + XftDrawString8 (xftDraw, color, renderFont, + x, y + mw->menu.font_ascent, + &string[start], end - start); + + XftTextExtents8 (display, renderFont, &string[start], end - start, + &glyphinfo); + + /* #### should use parent frame's .xftDraw */ + XftDrawDestroy (xftDraw); + return glyphinfo.xOff; + } +#else XCharStruct xcs; int drop; if (end <= start) return 0; - XDrawString ( + XDrawString ( /* XXX */ XtDisplay (mw), window, gc, x, y + mw->menu.font_ascent, &string[start], end - start); XTextExtents ( mw->menu.font, &string[start], end - start, &drop, &drop, &drop, &xcs); return xcs.width; +#endif # endif #endif } ＠＠ -871,8 +921,12 ＠＠ static void string_draw_u (XlwMenuWidget mw, Window window, int x, int y, +#ifdef USE_XFT_MENUBARS + XftColor *color, XftColor *colorBg, GC gc, +#else GC gc, -#ifdef NEED_MOTIF +#endif +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmString string #else char *string ＠＠ -882,7 +936,7 ＠＠ string_draw_u (XlwMenuWidget mw, int i, s = 0; char *chars; -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) chars = ""; if (!XmStringGetLtoR (string, XmFONTLIST_DEFAULT_TAG, &chars)) chars = ""; ＠＠ -893,8 +947,13 ＠＠ string_draw_u (XlwMenuWidget mw, if (chars[i] == '%' && chars[i+1] == '_') { int w; +#ifdef USE_XFT_MENUBARS + x += string_draw_range (mw, window, x, y, color, colorBg, chars, s, i); + w = string_draw_range (mw, window, x, y, color, colorBg, chars, i+2, i+3); +#else x += string_draw_range (mw, window, x, y, gc, chars, s, i); w = string_draw_range (mw, window, x, y, gc, chars, i+2, i+3); +#endif /* underline next character */ XDrawLine (XtDisplay (mw), window, gc, x - 1, ＠＠ -905,22 +964,37 ＠＠ string_draw_u (XlwMenuWidget mw, i += 2; } } +#ifdef USE_XFT_MENUBARS + x += string_draw_range (mw, window, x, y, color, colorBg, chars, s, i); +#else x += string_draw_range (mw, window, x, y, gc, chars, s, i); -#ifdef NEED_MOTIF +#endif +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XtFree (chars); #endif } -static void -binding_draw (XlwMenuWidget mw, Window w, int x, int y, GC gc, char *value) +static void /* XXX */ +binding_draw (XlwMenuWidget mw, Window w, int x, int y, +#ifdef USE_XFT_MENUBARS + XftColor *color, + XftColor *colorBg, +#else + GC gc, +#endif + char *value) { -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmString xm_value = XmStringCreateLtoR(value, XmSTRING_DEFAULT_CHARSET); string_draw (mw, w, x, y, gc, xm_value); XmStringFree (xm_value); #else +#ifdef USE_XFT_MENUBARS + string_draw (mw, w, x, y, color, colorBg, value); +#else string_draw (mw, w, x, y, gc, value); #endif +#endif } /* Low level code for drawing 3-D edges. */ ＠＠ -1562,21 +1636,57 ＠＠ label_button_draw (XlwMenuWidget mw, int y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; GC gc; +#ifdef USE_XFT_MENUBARS + XftColor color, colorBg; + Display *display = XtDisplay (mw); + Colormap cmap = mw->core.colormap; + Visual *visual; + int ignored, pixel, pixelBg; + + visual_info_from_widget ((Widget) mw, &visual, &ignored); +#endif + if (!label_offset) label_offset = mw->menu.shadow_thickness + mw->menu.horizontal_margin; - if (highlighted && (in_menubar || val->contents)) - gc = mw->menu.highlight_gc; + if (highlighted && (in_menubar || val->contents)) + { +#ifdef USE_XFT_MENUBARS + pixel = mw->menu.highlight_foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.highlight_gc; + } else if (in_menubar || val->contents) - gc = mw->menu.foreground_gc; + { +#ifdef USE_XFT_MENUBARS + pixel = mw->menu.foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.foreground_gc; + } else - gc = mw->menu.title_gc; + { +#ifdef USE_XFT_MENUBARS + pixel = mw->menu.title_foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.title_gc; + } +#ifdef USE_XFT_MENUBARS + color = xft_convert_color (display, cmap, visual, pixel, 0); + colorBg = xft_convert_color (display, cmap, visual, pixelBg, 0); +#endif /* Draw the label string. */ - string_draw_u (mw, - window, - x + label_offset, y + y_offset, + string_draw_u (mw, /* XXX */ + window, + x + label_offset, y + y_offset, +#ifdef USE_XFT_MENUBARS + &color, &colorBg, gc, +#else gc, +#endif resource_widget_value (mw, val)); } ＠＠ -1598,7 +1708,7 ＠＠ push_button_size (XlwMenuWidget mw, if (!in_menubar && val->key) { int w; -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmString key = XmStringCreateLtoR (val->key, XmSTRING_DEFAULT_CHARSET); w = string_width (mw, key); XmStringFree (key); ＠＠ -1627,6 +1737,16 ＠＠ push_button_draw (XlwMenuWidget mw, shadow_type type; Boolean menu_pb = in_menubar && (menu_item_type (val) == BUTTON_TYPE); +#ifdef USE_XFT_MENUBARS + XftColor color, colorBg; + Display *display = XtDisplay (mw); + Colormap cmap = mw->core.colormap; + Visual *visual; + int ignored, pixel, pixelBg, dim = 0; + + visual_info_from_widget ((Widget) mw, &visual, &ignored); +#endif + /* Draw the label string. */ if (!label_offset) label_offset = mw->menu.shadow_thickness + mw->menu.horizontal_margin; ＠＠ -1634,29 +1754,77 ＠＠ push_button_draw (XlwMenuWidget mw, if (highlighted) { if (val->enabled) - gc = mw->menu.highlight_gc; + { +#ifdef USE_XFT_MENUBARS + pixel = mw->menu.highlight_foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.highlight_gc; + } else - gc = mw->menu.inactive_gc; + { +#ifdef USE_XFT_MENUBARS + dim = 1; + pixel = mw->menu.foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.inactive_gc; } + } else if (menu_pb) { if (val->enabled) - gc = mw->menu.button_gc; + { +#ifdef USE_XFT_MENUBARS + pixel = mw->menu.button_foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.button_gc; + } else - gc = mw->menu.inactive_button_gc; + { +#ifdef USE_XFT_MENUBARS + dim = 1; + pixel = mw->menu.button_foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.inactive_button_gc; + } } else { if (val->enabled) - gc = mw->menu.foreground_gc; + { +#ifdef USE_XFT_MENUBARS + pixel = mw->menu.foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.foreground_gc; + } else - gc = mw->menu.inactive_gc; + { +#ifdef USE_XFT_MENUBARS + dim = 1; + pixel = mw->menu.foreground; + pixelBg = mw->core.background_pixel; +#endif + gc = mw->menu.inactive_gc; + } } +#ifdef USE_XFT_MENUBARS + color = xft_convert_color (display, cmap, visual, pixel, dim); + colorBg = xft_convert_color (display, cmap, visual, pixelBg, 0); +#endif + string_draw_u (mw, - window, - x + label_offset, y + y_offset, - gc, + window, + x + label_offset, y + y_offset, +#ifdef USE_XFT_MENUBARS + &color, &colorBg, gc, +#else + gc, +#endif resource_widget_value (mw, val)); /* Draw the keybindings */ ＠＠ -1670,7 +1838,13 ＠＠ push_button_draw (XlwMenuWidget mw, } binding_draw (mw, window, x + binding_offset + mw->menu.column_spacing, - y + y_offset, gc, val->key); + y + y_offset, +#ifdef USE_XFT_MENUBARS + &color, &colorBg, +#else + gc, +#endif + val->key); } /* Draw the shadow */ ＠＠ -2336,6 +2510,7 ＠＠ make_windows_if_needed (XlwMenuWidget mw return; root = RootWindowOfScreen (XtScreen(mw)); + /* use visual_info_from_widget() from lwlib-colors.c */ /* grab the visual and depth from the nearest shell ancestor */ visual = CopyFromParent; depth = CopyFromParent; ＠＠ -2615,13 +2790,19 ＠＠ static void make_drawing_gcs (XlwMenuWidget mw) { XGCValues xgcv; +#ifdef USE_XFT_MENUBARS + unsigned long flags = (GCForeground | GCBackground); +#else unsigned long flags = (GCFont | GCForeground | GCBackground); +#endif -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) xgcv.font = default_font_of_font_list (mw->menu.font_list)->fid; #else +#ifndef USE_XFT_MENUBARS xgcv.font = mw->menu.font->fid; #endif +#endif xgcv.foreground = mw->core.background_pixel; xgcv.background = mw->menu.foreground; ＠＠ -2645,18 +2826,21 ＠＠ make_drawing_gcs (XlwMenuWidget mw) else { /* color */ XColor xcolor; + Visual *visual; + int ignore; + visual_info_from_widget ((Widget) mw, &visual, &ignore); Colormap cmap = mw->core.colormap; xcolor.pixel = mw->core.background_pixel; XQueryColor (dpy, cmap, &xcolor); xcolor.red = (xcolor.red * 17) / 20; xcolor.green = (xcolor.green * 17) / 20; xcolor.blue = (xcolor.blue * 17) / 20; - if (allocate_nearest_color (dpy, cmap, &xcolor)) + if (x_allocate_nearest_color (dpy, cmap, visual, &xcolor)) xgcv.foreground = xcolor.pixel; } } xgcv.background = mw->core.background_pixel; - mw->menu.select_gc = XtGetGC ((Widget)mw, flags, &xgcv); + mw->menu.select_gc = XtGetGC ((Widget) mw, flags, &xgcv); xgcv.foreground = mw->menu.foreground; xgcv.background = mw->core.background_pixel; ＠＠ -2688,6 +2872,7 ＠＠ make_drawing_gcs (XlwMenuWidget mw) static void release_drawing_gcs (XlwMenuWidget mw) { + XtReleaseGC ((Widget) mw, mw->menu.foreground_gc); XtReleaseGC ((Widget) mw, mw->menu.button_gc); XtReleaseGC ((Widget) mw, mw->menu.highlight_gc); ＠＠ -2707,9 +2892,6 ＠＠ release_drawing_gcs (XlwMenuWidget mw) mw->menu.select_gc = (GC) -1; } -#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ - ? ((unsigned long) (x)) : ((unsigned long) (y))) - static void make_shadow_gcs (XlwMenuWidget mw) { ＠＠ -2717,9 +2899,20 ＠＠ make_shadow_gcs (XlwMenuWidget mw) unsigned long pm = 0; Display *dpy = XtDisplay ((Widget) mw); Colormap cmap = mw->core.colormap; + Visual *visual; + int ignored; XColor topc, botc; int top_frobbed = 0, bottom_frobbed = 0; + visual_info_from_widget ((Widget) mw, &visual, &ignored); + /* #### Apparently this is called before any shell has a visual? + or maybe the widget doesn't have a parent yet? */ + if (visual == CopyFromParent) + { + Screen *screen = DefaultScreenOfDisplay (dpy); + visual = DefaultVisualOfScreen (screen); + } + if (mw->menu.top_shadow_color == (Pixel) (-1)) mw->menu.top_shadow_color = mw->core.background_pixel; if (mw->menu.bottom_shadow_color == (Pixel) (-1)) ＠＠ -2734,7 +2927,7 ＠＠ make_shadow_gcs (XlwMenuWidget mw) topc.red = MINL (65535, topc.red * 1.2); topc.green = MINL (65535, topc.green * 1.2); topc.blue = MINL (65535, topc.blue * 1.2); - if (allocate_nearest_color (dpy, cmap, &topc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &topc)) { if (topc.pixel == mw->core.background_pixel) { ＠＠ -2742,7 +2935,7 ＠＠ make_shadow_gcs (XlwMenuWidget mw) topc.red = MINL (65535, topc.red + 0x8000); topc.green = MINL (65535, topc.green + 0x8000); topc.blue = MINL (65535, topc.blue + 0x8000); - if (allocate_nearest_color (dpy, cmap, &topc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &topc)) { mw->menu.top_shadow_color = topc.pixel; } ＠＠ -2763,7 +2956,7 ＠＠ make_shadow_gcs (XlwMenuWidget mw) botc.red = (botc.red * 3) / 5; botc.green = (botc.green * 3) / 5; botc.blue = (botc.blue * 3) / 5; - if (allocate_nearest_color (dpy, cmap, &botc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &botc)) { if (botc.pixel == mw->core.background_pixel) { ＠＠ -2771,7 +2964,7 ＠＠ make_shadow_gcs (XlwMenuWidget mw) botc.red = MINL (65535, botc.red + 0x4000); botc.green = MINL (65535, botc.green + 0x4000); botc.blue = MINL (65535, botc.blue + 0x4000); - if (allocate_nearest_color (dpy, cmap, &botc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &botc)) { mw->menu.bottom_shadow_color = botc.pixel; } ＠＠ -2854,7 +3047,7 ＠＠ release_shadow_gcs (XlwMenuWidget mw) static void extract_font_extents (XlwMenuWidget mw) { -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) /* Find the maximal ascent/descent of the fonts in the font list so that all menu items can be the same height... */ mw->menu.font_ascent = 0; ＠＠ -2939,13 +3132,18 ＠＠ extract_font_extents (XlwMenuWidget mw) mw->menu.font_descent = font->descent; } # else /* ! USE_XFONTSET */ +#ifdef USE_XFT_MENUBARS + mw->menu.font_ascent = mw->menu.renderFont->ascent; + mw->menu.font_descent = mw->menu.renderFont->descent; +#else mw->menu.font_ascent = mw->menu.font->ascent; mw->menu.font_descent = mw->menu.font->descent; +#endif # endif #endif /* NEED_MOTIF */ } -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) static XFontStruct * default_font_of_font_list (XmFontList font_list) { ＠＠ -3015,7 +3213,7 ＠＠ XlwMenuInitialize (Widget UNUSED (reques XCreatePixmapFromBitmapData (display, window, (char *) gray_bits, gray_width, gray_height, 1, 0, 1); -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) /* #### Even if it's a kludge!!!, we should consider doing the same for X Font Sets. */ /* The menu.font_list slot came from the *fontList resource (Motif standard.) ＠＠ -3037,6 +3235,14 ＠＠ XlwMenuInitialize (Widget UNUSED (reques mw->menu.font_list = mw->menu.fallback_font_list; #endif +#ifdef USE_XFT_MENUBARS + /* to do this right, we should add a new Xt Resource type + + conversion function + */ + mw->menu.renderFont = + xft_open_font_by_name (XtDisplay (mw), mw->menu.renderFontSpec); +#endif + make_drawing_gcs (mw); make_shadow_gcs (mw); extract_font_extents (mw); ＠＠ -3179,12 +3385,16 ＠＠ XlwMenuSetValues (Widget current, Widget if (newmw->core.background_pixel != oldmw->core.background_pixel || newmw->menu.foreground != oldmw->menu.foreground /* For the XEditResource protocol, which may want to change the font. */ -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) || newmw->menu.font_list != oldmw->menu.font_list || newmw->menu.font_list_2 != oldmw->menu.font_list_2 || newmw->menu.fallback_font_list != oldmw->menu.fallback_font_list #else +#ifdef USE_XFT_MENUBARS + || newmw->menu.renderFont != oldmw->menu.renderFont +#else || newmw->menu.font != oldmw->menu.font +#endif #endif ) { 1.5 +13 -1 XEmacs/xemacs/lwlib/xlwmenuP.h Index: xlwmenuP.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/xlwmenuP.h,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- xlwmenuP.h 2001/04/12 18:21:55 1.4 +++ xlwmenuP.h 2005/11/26 11:46:00 1.5 ＠＠ -4,6 +4,11 ＠＠ #include "xlwmenu.h" #include <X11/CoreP.h> +#ifdef USE_XFT_MENUBARS +#include <X11/Xft/Xft.h> +#endif + + /* Elements in the stack arrays. */ typedef struct _window_state { ＠＠ -22,12 +27,17 ＠＠ typedef struct _XlwMenu_part { /* slots set by the resources */ -#ifdef NEED_MOTIF +#if defined(NEED_MOTIF) && !defined(USE_XFT_MENUBARS) XmFontList font_list; XmFontList font_list_2; XmFontList fallback_font_list; #else XFontStruct * font; +#ifdef USE_XFT_MENUBARS + /* #### Fix naming convention here */ + String renderFontSpec; + XftFont *renderFont; +#endif # ifdef USE_XFONTSET XFontSet font_set; # endif ＠＠ -47,6 +57,8 ＠＠ typedef struct _XlwMenu_part Pixel top_shadow_color; Pixel bottom_shadow_color; Pixel select_color; +#ifdef USE_XFT_MENUBARS +#endif Pixmap top_shadow_pixmap; Pixmap bottom_shadow_pixmap; Cursor cursor_shape; 1.18 +31 -57 XEmacs/xemacs/lwlib/xlwscrollbar.c Index: xlwscrollbar.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/xlwscrollbar.c,v retrieving revision 1.17 retrieving revision 1.18 diff -u -p -r1.17 -r1.18 --- xlwscrollbar.c 2004/09/20 19:19:18 1.17 +++ xlwscrollbar.c 2005/11/26 11:46:00 1.18 ＠＠ -78,6 +78,8 ＠＠ Boston, MA 02111-1307, USA. */ #include <X11/StringDefs.h> #include <X11/bitmaps/gray> +#include "lwlib-colors.h" + #include "xlwscrollbarP.h" #include "xlwscrollbar.h" ＠＠ -523,66 +525,26 ＠＠ get_gc (XlwScrollBarWidget w, Pixel fg, return XtGetGC((Widget) w, mask, &values); } -/* Replacement for XAllocColor() that tries to return the nearest - available color if the colormap is full. From FSF Emacs. */ - -static int -allocate_nearest_color (Display *display, Colormap screen_colormap, - XColor *color_def) -{ - int status = XAllocColor (display, screen_colormap, color_def); - if (status) - return status; - - { - /* If we got to this point, the colormap is full, so we're - going to try to get the next closest color. - The algorithm used is a least-squares matching, which is - what X uses for closest color matching with StaticColor visuals. */ - - int nearest, x; - unsigned long nearest_delta = ULONG_MAX; - - int no_cells = XDisplayCells (display, XDefaultScreen (display)); - /* Don't use alloca here because lwlib doesn't have the - necessary configuration information that src does. */ - XColor *cells = (XColor *) malloc (sizeof (XColor) * no_cells); - - for (x = 0; x < no_cells; x++) - cells[x].pixel = x; - - XQueryColors (display, screen_colormap, cells, no_cells); - - for (nearest = 0, x = 0; x < no_cells; x++) - { - long dred = (color_def->red >> 8) - (cells[x].red >> 8); - long dgreen = (color_def->green >> 8) - (cells[x].green >> 8); - long dblue = (color_def->blue >> 8) - (cells[x].blue >> 8); - unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue; - - if (delta < nearest_delta) - { - nearest = x; - nearest_delta = delta; - } - } - color_def->red = cells[nearest].red; - color_def->green = cells[nearest].green; - color_def->blue = cells[nearest].blue; - free (cells); - return XAllocColor (display, screen_colormap, color_def); - } -} - static void make_shadow_pixels (XlwScrollBarWidget w) { - Display *dpy = XtDisplay((Widget) w); + Display *dpy = XtDisplay ((Widget) w); Colormap cmap = w->core.colormap; XColor topc, botc; int top_frobbed, bottom_frobbed; Pixel bg, fg; + Visual *visual; + int ignored; + visual_info_from_widget ((Widget) w, &visual, &ignored); + /* #### Apparently this is called before any shell has a visual? + or maybe the widget doesn't have a parent yet? */ + if (visual == CopyFromParent) + { + Screen *screen = DefaultScreenOfDisplay (dpy); + visual = DefaultVisualOfScreen (screen); + } + top_frobbed = bottom_frobbed = 0; bg = w->core.background_pixel; ＠＠ -595,11 +557,12 ＠＠ make_shadow_pixels (XlwScrollBarWidget w { topc.pixel = bg; XQueryColor (dpy, cmap, &topc); + /* #### can we use a (generalized) xft_convert_color here? */ /* don't overflow/wrap! */ topc.red = MINL(65535, topc.red * 1.2); topc.green = MINL(65535, topc.green * 1.2); topc.blue = MINL(65535, topc.blue * 1.2); - if (allocate_nearest_color (dpy, cmap, &topc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &topc)) { if (topc.pixel == bg) { ＠＠ -607,7 +570,7 ＠＠ make_shadow_pixels (XlwScrollBarWidget w topc.red = MINL(65535, topc.red + 0x8000); topc.green = MINL(65535, topc.green + 0x8000); topc.blue = MINL(65535, topc.blue + 0x8000); - if (allocate_nearest_color (dpy, cmap, &topc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &topc)) { w->sb.topShadowColor = topc.pixel; } ＠＠ -628,7 +591,7 ＠＠ make_shadow_pixels (XlwScrollBarWidget w botc.red = (botc.red * 3) / 5; botc.green = (botc.green * 3) / 5; botc.blue = (botc.blue * 3) / 5; - if (allocate_nearest_color (dpy, cmap, &botc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &botc)) { if (botc.pixel == bg) { ＠＠ -636,7 +599,7 ＠＠ make_shadow_pixels (XlwScrollBarWidget w botc.red = MINL(65535, botc.red + 0x4000); botc.green = MINL(65535, botc.green + 0x4000); botc.blue = MINL(65535, botc.blue + 0x4000); - if (allocate_nearest_color (dpy, cmap, &botc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &botc)) { w->sb.bottomShadowColor = botc.pixel; } ＠＠ -703,6 +666,17 ＠＠ make_trough_pixel (XlwScrollBarWidget w) Display *dpy = XtDisplay((Widget) w); Colormap cmap = w->core.colormap; XColor troughC; + Visual *visual; + int ignored; + + visual_info_from_widget ((Widget) w, &visual, &ignored); + /* #### Apparently this is called before any shell has a visual? + or maybe the widget doesn't have a parent yet? */ + if (visual == CopyFromParent) + { + Screen *screen = DefaultScreenOfDisplay (dpy); + visual = DefaultVisualOfScreen (screen); + } if (w->sb.troughColor == (Pixel)~0) w->sb.troughColor = w->core.background_pixel; ＠＠ -713,7 +687,7 ＠＠ make_trough_pixel (XlwScrollBarWidget w) troughC.red = (troughC.red * 4) / 5; troughC.green = (troughC.green * 4) / 5; troughC.blue = (troughC.blue * 4) / 5; - if (allocate_nearest_color (dpy, cmap, &troughC)) + if (x_allocate_nearest_color (dpy, cmap, visual, &troughC)) w->sb.troughColor = troughC.pixel; } } 1.6 +538 -174 XEmacs/xemacs/lwlib/xlwtabs.c Index: xlwtabs.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/xlwtabs.c,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- xlwtabs.c 2005/10/25 11:16:49 1.5 +++ xlwtabs.c 2005/11/26 11:46:00 1.6 ＠＠ -18,13 +18,6 ＠＠ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - /* Synched up with: Tabs.c 1.27. - - #### This file contains essential XEmacs related fixes to the original - verison of the Tabs widget. Be VERY careful about syncing if you ever - update to a more recent version. In general this is probably now a - bad idea. */ - /* * Tabs.c - Index Tabs composite widget * ＠＠ -56,6 +49,18 ＠＠ * the frame. */ + /* Synched up with: Tabs.c 1.27. + + This file contains essential XEmacs-related fixes to the original + version of the Tabs widget. Be VERY careful about syncing if you ever + update to a more recent version. In general this is probably now a + bad idea. + + #### We need to check that various windows (the whole widget, or a single + tab) are of "reasonable" size, ie, we need to try for more sanity in the + geometry management routines. + */ + /* * TODO: min child height = tab height */ ＠＠ -67,11 +72,17 ＠＠ #include <X11/IntrinsicP.h> #include <X11/StringDefs.h> +/* #### This may be risky, lwlib-internal.h redefines abort() */ +#include "lwlib-fonts.h" +#include "lwlib-colors.h" #include "lwlib-internal.h" #include "../src/xmu.h" #include "xlwtabsP.h" #include "xlwgcs.h" +#define XFT_USE_HEIGHT_NOT_ASCENT_DESCENT 0 + +/* #### These should probably be resources. */ #define MIN_WID 10 #define MIN_HGT 10 #define INDENT 3 /* tabs indented from edge by this much */ ＠＠ -138,6 +149,12 ＠＠ static XtResource resources[] = { offset(selectInsensitive), XtRImmediate, (XtPointer) True}, {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), offset(font), XtRString, (XtPointer) XtDefaultFont}, +#ifdef USE_XFT_TABS + /* #### Maybe use "-*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-1" here? */ + {XtNxftFont, XtCXftFont, XtRString, sizeof (String), + offset(renderFontSpec), XtRString, + (XtPointer) "AirCut-16" /* XtDefaultFont */}, +#endif {XtNinternalWidth, XtCWidth, XtRDimension, sizeof(Dimension), offset(internalWidth), XtRImmediate, (XtPointer)4 }, {XtNinternalHeight, XtCHeight, XtRDimension, sizeof(Dimension), ＠＠ -400,6 +417,27 ＠＠ WidgetClass tabsWidgetClass = (WidgetCla ((TabsConstraints)((tab)->core.constraints))->tabs.visible)  + +static int debug_tabs = 0; /* increase for more verbosity */ + +#ifdef USE_XFT_TABS +/* #### duplicated from xlwmenu.c -- CLEAN THIS SHIT UP! + Undeclared so define at top. */ +#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ + ? ((unsigned long) (x)) : ((unsigned long) (y))) + +static int +x_xft_text_width (Display *dpy, XftFont *xft_font, FcChar8 *run, int len) +{ + static XGlyphInfo glyphinfo; /* #### static? */ + + XftTextExtents8 (dpy, + xft_font, + run, len, &glyphinfo); + return glyphinfo.xOff; +} +#endif + /**************************************************************** * * Member Procedures ＠＠ -436,12 +474,27 ＠＠ TabsInit(Widget request, Widget new_, Ar */ newTw->tabs.tab_height = 2 * newTw->tabs.internalHeight + SHADWID ; - if( newTw->tabs.font != NULL ) +#ifdef USE_XFT_TABS + /* must get font here + to do this right, we should add a new Xt Resource type + + conversion function + */ + newTw->tabs.renderFont = + xft_open_font_by_name (XtDisplay ((Widget) newTw), + newTw->tabs.renderFontSpec); + if (newTw->tabs.renderFont != NULL) +#if XFT_USE_HEIGHT_NOT_ASCENT_DESCENT + newTw->tabs.tab_height += newTw->tabs.renderFont->height; +#else + newTw->tabs.tab_height += newTw->tabs.renderFont->ascent + + newTw->tabs.renderFont->descent; +#endif /* XFT_USE_HEIGHT_NOT_ASCENT_DESCENT */ +#else /* ! USE_XFT_TABS */ + if (newTw->tabs.font != NULL) newTw->tabs.tab_height += newTw->tabs.font->max_bounds.ascent + - newTw->tabs.font->max_bounds.descent ; + newTw->tabs.font->max_bounds.descent; +#endif /* ! USE_XFT_TABS */ - /* GC allocation is deferred until XtRealize() */ - /* if size not explicitly set, set it to our preferred size now. */ if( request->core.width == 0 || request->core.height == 0 ) ＠＠ -613,17 +666,31 ＠＠ TabsSetValues(Widget current, Widget UNU Boolean needRedraw = False ; Widget *childP ; int i ; - - if( tw->tabs.font != curtw->tabs.font || - tw->tabs.internalWidth != curtw->tabs.internalWidth || - tw->tabs.internalHeight != curtw->tabs.internalHeight ) + if( +#ifdef USE_XFT_TABS + tw->tabs.renderFont != curtw->tabs.renderFont || +#else + tw->tabs.font != curtw->tabs.font || +#endif + tw->tabs.internalWidth != curtw->tabs.internalWidth || + tw->tabs.internalHeight != curtw->tabs.internalHeight) { - tw->tabs.tab_height = 2 * tw->tabs.internalHeight + SHADWID ; + tw->tabs.tab_height = 2 * tw->tabs.internalHeight + SHADWID; - if( tw->tabs.font != NULL ) +#ifdef USE_XFT_TABS + if (tw->tabs.renderFont != NULL) +#if XFT_USE_HEIGHT_NOT_ASCENT_DESCENT + tw->tabs.tab_height += tw->tabs.renderFont->height; +#else + tw->tabs.tab_height += tw->tabs.renderFont->ascent + + tw->tabs.renderFont->descent; +#endif /* XFT_USE_HEIGHT_NOT_ASCENT_DESCENT */ +#else /* ! USE_XFT_TABS */ + if (tw->tabs.font != NULL) tw->tabs.tab_height += tw->tabs.font->max_bounds.ascent + - tw->tabs.font->max_bounds.descent ; + tw->tabs.font->max_bounds.descent; +#endif /* ! USE_XFT_TABS */ /* Tab size has changed. Resize all tabs and request a new size */ for(i=0, childP=tw->composite.children; ＠＠ -640,7 +707,12 ＠＠ TabsSetValues(Widget current, Widget UNU if( tw->core.background_pixel != curtw->core.background_pixel || tw->core.background_pixmap != curtw->core.background_pixmap || - tw->tabs.font != curtw->tabs.font ) +#ifdef USE_XFT_TABS + tw->tabs.renderFont != curtw->tabs.renderFont +#else + tw->tabs.font != curtw->tabs.font +#endif + ) if( XtIsRealized(new_) ) { TabsFreeGCs(tw) ; ＠＠ -755,83 +827,167 ＠＠ TabsAcceptFocus(Widget w, Time *UNUSED ( /* - * Return preferred size. Happily accept anything >= our preferred size. - * (TODO: is that the right thing to do? Should we always return "almost" - * if offered more than we need?) + * Return status, with preferred size in PREFERRED. + * + * According to the X Toolkit Intrinsics manual + * XtGeometryYes = accept INTENDED without change + * XtGeometryNo = request to stay _exactly_ the same + * XtGeometryAlmost = suggest PREFERRED as a compromise + * and the PREFERRED argument must be filled in completely (ie, any fields + * whose bits are set in the request_mode mask must correspond to the + * preferred geometry, which must be consistent with the return value). + * + * Assuming horizontal orientation, in XEmacs, we should always accept if + * the width is more than we need. There's no problem if there are only a + * couple of tabs packed to the left. OTOH there's probably something wrong + * if we're offered a height more than 1.5x or 2x the preferred height. + * (#### Do tab controls do vertical?) */ - -static XtGeometryResult -TabsQueryGeometry(Widget w, - XtWidgetGeometry *intended, XtWidgetGeometry *preferred) -{ - register TabsWidget tw = (TabsWidget)w ; - XtGeometryMask mode = intended->request_mode ; - preferred->request_mode = CWWidth | CWHeight ; - PreferredSize(tw, &preferred->width, &preferred->height, NULL,NULL) ; +/* compute the height above which we complain */ +#define TAB_HEIGHT_TOLERANCE(x) (2*x) - if( (!(mode & CWWidth) || intended->width == w->core.width) && - (!(mode & CWHeight) || intended->height == w->core.height) ) - return XtGeometryNo ; - - if( (!(mode & CWWidth) || intended->width >= preferred->width) && - (!(mode & CWHeight) || intended->height >= preferred->height) ) +static XtGeometryResult +TabsQueryGeometry (Widget w, + XtWidgetGeometry *intended, + XtWidgetGeometry *preferred) /* RETURN */ +{ + TabsWidget tw = (TabsWidget) w; + XtGeometryMask mode = intended->request_mode; + + preferred->request_mode = CWWidth | CWHeight; + PreferredSize (tw, &preferred->width, &preferred->height, NULL, NULL); + + /* If width is big enough, accept it. */ + if ((mode & CWWidth) && intended->width >= preferred->width) + preferred->width = intended->width; + + /* If height is within range, accept it. + #### If too tall, we could offer a compromise at TAB_HEIGHT_TOLERANCE. + Should we? */ + if ((mode & CWHeight) && intended->height >= preferred->height + && intended->height <= TAB_HEIGHT_TOLERANCE (preferred->height)) + preferred->height = intended->height; + + /* Compute return value. */ + if (preferred->width == ((mode & CWWidth) ? intended->width + : w->core.width) + && preferred->height == ((mode & CWHeight) ? intended->height + : w->core.height)) return XtGeometryYes; - - return XtGeometryAlmost; + else if (preferred->width == w->core.width + && preferred->height == w->core.height) + return XtGeometryNo; + else + return XtGeometryAlmost; } /* - * Geometry Manager; called when a child wants to be resized. + * Geometry Manager; called when TAB (a child) wants to be resized. + * + * According to the X Toolkit Intrinsics manual + * XtGeometryDone = accept REQUEST and do it (#### check this) + * XtGeometryYes = accept REQUEST without change + * XtGeometryNo = refuse REQUEST (ie, stay _exactly_ the same) + * XtGeometryAlmost = suggest REPLY as a compromise */ static XtGeometryResult -TabsGeometryManager(Widget w, XtWidgetGeometry *req, XtWidgetGeometry *reply) -{ - TabsWidget tw = (TabsWidget) XtParent(w); - Dimension s = SHADWID ; - TabsConstraints tab = (TabsConstraints)w->core.constraints; - XtGeometryResult result ; - Dimension rw, rh ; +TabsGeometryManager (Widget tab, + XtWidgetGeometry *request, + XtWidgetGeometry *reply) /* RETURN */ +{ + TabsWidget control = (TabsWidget) XtParent(tab); + Dimension s = SHADWID; + TabsConstraints constraint = (TabsConstraints) tab->core.constraints; + XtGeometryResult result, best_offer = XtGeometryYes; + Dimension rw, rh; + + static int debug_count = 0; + static int debug_mask = 1; + + /* Position request cannot be satisfied, so if tabs are not resizable, + no nontrivial request can be satisfied: return XGeometryNo. */ + if (!constraint->tabs.resizable) + return XtGeometryNo; + + fprintf (stderr, "Urk! label is resizable!\n"); + + /* Assume we will refuse these; toggle iff we accept them. + Reply won't specify any fields not in the request. */ + reply->request_mode = request->request_mode; + reply->x = tab->core.x; + reply->y = tab->core.y; + + /* If a position request would result in a change, best offer is + XtGeometryAlmost. Otherwise toggle reply->request_mode. */ + if ((request->request_mode & CWX) && request->x != tab->core.x) + best_offer = XtGeometryAlmost; + else + reply->request_mode &= ~CWX; + if ((request->request_mode & CWY) && request->y != tab->core.y) + best_offer = XtGeometryAlmost; + else + reply->request_mode &= ~CWY; - /* Position request always denied */ + /* Make all three fields in the reply valid */ + reply->width = (request->request_mode & CWWidth) + ? request->width : tab->core.width; + reply->height = (request->request_mode & CWHeight) + ? request->height : tab->core.height; + reply->border_width = (request->request_mode & CWBorderWidth) + ? request->border_width : tab->core.border_width; + + /* check if we can already offer a compromise */ + if (best_offer == XtGeometryAlmost && + reply->width == tab->core.width && + reply->height == tab->core.height && + reply->border_width == tab->core.border_width) + { + reply->request_mode &= ~(CWWidth | CWHeight | CWBorderWidth); + return best_offer; + } - if( ((req->request_mode & CWX) && req->x != w->core.x) || - ((req->request_mode & CWY) && req->y != w->core.y) || - !tab->tabs.resizable ) - return XtGeometryNo ; - - /* Make all three fields in the request valid */ - if( !(req->request_mode & CWWidth) ) - req->width = w->core.width; - if( !(req->request_mode & CWHeight) ) - req->height = w->core.height; - if( !(req->request_mode & CWBorderWidth) ) - req->border_width = w->core.border_width; - - if( req->width == w->core.width && - req->height == w->core.height && - req->border_width == w->core.border_width ) - return XtGeometryNo ; +#ifndef DONT_DEBUG_REQUESTS +#define DBG_REQUEST_PRINT(name,field,size) \ +do { \ + if (reply->field > size) \ + { \ + if (++debug_count == debug_mask) \ + { \ + debug_mask <<= 1; \ + fprintf (stderr, "ridiculous %s request #%d: %d > %d\n", \ + name, debug_count, reply->field, size); \ + } \ + reply->field = tab->core.field; \ + } \ +} while (0) + + DBG_REQUEST_PRINT ("width",width,1024); + DBG_REQUEST_PRINT ("height",height,768); + DBG_REQUEST_PRINT ("border_width",border_width,30); +#undef DBG_REQUEST_PRINT +#endif - rw = req->width + 2 * req->border_width ; - rh = req->height + 2 * req->border_width ; + rw = reply->width + 2 * reply->border_width; + rh = reply->height + 2 * reply->border_width; /* find out how big the children want to be now */ - MaxChild(tw, w, rw, rh) ; + MaxChild (control, tab, rw, rh); /* Size changes must see if the new size can be accommodated. - * The Tabs widget keeps all of its children the same - * size. A request to shrink will be accepted only if the + * The Tabs widget keeps all of its children the same height, but + * widths may vary. + * A request to shrink will be accepted only if the * new size is still big enough for all other children. A * request to shrink that is not big enough for all children * returns an "almost" response with the new proposed size * or a "no" response if unable to shrink at all. * - * A request to grow will be accepted only if the Tabs parent can + * A request to grow will be accepted only if the Tabs control can * grow to accommodate. * * TODO: ＠＠ -840,25 +996,33 ＠＠ TabsGeometryManager(Widget w, XtWidgetGe * for another day. */ - if (req->request_mode & (CWWidth | CWHeight | CWBorderWidth)) + if (request->request_mode & (CWWidth | CWHeight | CWBorderWidth)) { Dimension cw,ch ; /* children's preferred size */ Dimension aw,ah ; /* available size we can give child */ Dimension th ; /* space used by tabs */ Dimension wid,hgt ; /* Tabs widget size */ + int check_nrows; - cw = tw->tabs.max_cw ; - ch = tw->tabs.max_ch ; + cw = control->tabs.max_cw ; + ch = control->tabs.max_ch ; /* find out what *my* resulting preferred size would be */ - - PreferredSize2(tw, cw, ch, &wid, &hgt) ; + /* #### this whole API is wrong; what should happen is + 1. app should hint as to #rows and/or aspect ratio + 2. tab control should attempt to layout in current space + 3. if not all tabs fit, should request resize to achieve + layout hints + Probably can and should cache preferred size in widget, with + cache cleared when labels or core size changes. */ + PreferredSize2(control, cw, ch, &wid, &hgt) ; /* Would my size change? If so, ask to be resized. */ - if( wid != tw->core.width || hgt != tw->core.height ) + if (wid != control->core.width || hgt != control->core.height) { - Dimension oldWid = tw->core.width, oldHgt = tw->core.height ; + Dimension oldWid = control->core.width, + oldHgt = control->core.height; XtWidgetGeometry myrequest, myreply ; myrequest.width = wid ; ＠＠ -870,10 +1034,11 ＠＠ TabsGeometryManager(Widget w, XtWidgetGe * offer the child a compromise, then make this a query only. */ - if( (req->request_mode & XtCWQueryOnly) || rw < cw || rh < ch ) - myrequest.request_mode |= XtCWQueryOnly ; + if ((request->request_mode & XtCWQueryOnly) || rw < cw || rh < ch) + myrequest.request_mode |= XtCWQueryOnly; - result = XtMakeGeometryRequest((Widget)tw, &myrequest, &myreply) ; + result = XtMakeGeometryRequest ((Widget) control, + &myrequest, &myreply); /* !$＠# Athena Box widget changes the core size even if QueryOnly * is set. I'm convinced this is a bug. At any rate, to work ＠＠ -881,81 +1046,104 ＠＠ TabsGeometryManager(Widget w, XtWidgetGe * query geometry request. This is only partly effective, * as there may be other boxes further up the tree. */ - if( myrequest.request_mode & XtCWQueryOnly ) { - tw->core.width = oldWid ; - tw->core.height = oldHgt ; + if (myrequest.request_mode & XtCWQueryOnly) { + control->core.width = oldWid; + control->core.height = oldHgt; } /* based on the parent's response, determine what the * resulting Tabs widget size would be. */ - switch( result ) { + switch (result) { case XtGeometryYes: case XtGeometryDone: - tw->tabs.needs_layout = True ; - break ; + control->tabs.needs_layout = True; + break; case XtGeometryNo: - wid = tw->core.width ; - hgt = tw->core.height ; - break ; + wid = control->core.width; + hgt = control->core.height; + break; case XtGeometryAlmost: - wid = myreply.width ; - hgt = myreply.height ; - tw->tabs.needs_layout = True ; - break ; + wid = myreply.width; + hgt = myreply.height; + control->tabs.needs_layout = True; + break; } } /* Within the constraints imposed by the parent, what is * the max size we can give the child? */ - (void) TabLayout(tw, wid, hgt, &th, True) ; - aw = wid - 2*s ; - ah = hgt - th - 2*s ; + check_nrows = TabLayout (control, wid, hgt, &th, True); + aw = wid - 2*s; + if (check_nrows == 1) + { + ah = hgt - th - 2*s; + } + else + { + /* this rarely gets triggered, but when it does it seems to + get triggered forever after */ + int n = control->composite.num_children; + ah = control->tabs.tab_height; + if (debug_tabs > 0) + fprintf (stderr, "Kludging around %d != 1 rows," + " #children = %d, total height %d, using %d.\n", + check_nrows, n, th, ah); + } /* OK, make our decision. If requested size is >= max sibling * preferred size, AND requested size <= available size, then * we accept. Otherwise, we offer a compromise. */ - if( rw == aw && rh == ah ) + if (rw == aw && rh == ah) { /* Acceptable. If this wasn't a query, change *all* children * to this size. */ - if( req->request_mode & XtCWQueryOnly ) - return XtGeometryYes ; + if (request->request_mode & XtCWQueryOnly) + { + control->tabs.needs_layout = False; + return XtGeometryYes ; + } else { - Widget *childP = tw->composite.children ; - int i,bw ; - w->core.border_width = req->border_width ; - for(i=TabsNumChildren (tw); --i >= 0; ++childP) - if( TabVisible(*childP) ) + Widget *childP = control->composite.children; + int i, bw; + tab->core.border_width = request->border_width; + for (i = TabsNumChildren (control); --i >= 0; ++childP) + if (TabVisible (*childP)) { - bw = (*childP)->core.border_width ; - XtConfigureWidget(*childP, s,tw->tabs.tab_total+s, - rw-2*bw, rh-2*bw, bw) ; + bw = (*childP)->core.border_width; + XtConfigureWidget (*childP, s, control->tabs.tab_total+s, + rw-2*bw, rh-2*bw, bw); } #ifdef COMMENT /* TODO: under what conditions will we need to redraw? */ - XClearWindow(XtDisplay((Widget)tw), XtWindow((Widget)tw)) ; - XtClass(tw)->core_class.expose((Widget)tw,NULL,NULL) ; + XClearWindow (XtDisplay ((Widget) control), + XtWindow ((Widget) control)); + XtClass (control)->core_class.expose ((Widget)control, + NULL, NULL); #endif /* COMMENT */ - return XtGeometryDone ; + return XtGeometryDone; } } /* Cannot grant child's request. Describe what we *can* do * and return counter-offer. */ - reply->width = aw - 2 * req->border_width ; - reply->height = ah - 2 * req->border_width ; - reply->border_width = req->border_width ; - reply->request_mode = CWWidth | CWHeight | CWBorderWidth ; + control->tabs.needs_layout = False; + reply->width = aw - 2 * request->border_width ; + reply->height = ah - 2 * request->border_width ; + reply->request_mode &= + ~((reply->border_width == tab->core.border_width + ? CWBorderWidth : 0) + |(reply->width == tab->core.width ? CWWidth : 0) + |(reply->height == tab->core.height ? CWHeight : 0)); return XtGeometryAlmost ; } ＠＠ -1428,6 +1616,8 ＠＠ DrawTab(TabsWidget tw, Widget child, Boo GC gc ; int x,y ; + if (debug_tabs > 1) fprintf (stderr, "DrawTab called.\n"); + if( !XtIsRealized((Widget)tw)) return ; ＠＠ -1440,55 +1630,142 ＠＠ DrawTab(TabsWidget tw, Widget child, Boo Window win = XtWindow((Widget)tw) ; String lbl = tab->tabs.label != NULL ? tab->tabs.label : XtName(child) ; +#ifdef USE_XFT_TABS + XftColor color; + XftColor colorBG; + Colormap cmap = tw->core.colormap; + Visual *visual; + int ignored; + + visual_info_from_widget ((Widget) tw, &visual, &ignored); + colorBG = xft_convert_color (dpy, cmap, visual, + tw->core.background_pixel, 0); +#endif + + if (debug_tabs > 2) + fprintf (stderr, "(Re)drawing labels.\n"); - if( XtIsSensitive(child) ) + if (XtIsSensitive(child)) { - gc = tw->tabs.foregroundGC ; - XSetForeground(dpy, gc, tab->tabs.foreground) ; + gc = tw->tabs.foregroundGC; +#ifdef USE_XFT_TABS + color = xft_convert_color (dpy, cmap, visual, + tab->tabs.foreground, 0); +#else + XSetForeground(dpy, gc, tab->tabs.foreground); +#endif } else { /* grey pixel allocation deferred until now */ - if( !tab->tabs.greyAlloc ) + if (!tab->tabs.greyAlloc) { - if( tw->tabs.be_nice_to_cmap || tw->core.depth == 1 ) - tab->tabs.grey = tab->tabs.foreground ; + if (tw->tabs.be_nice_to_cmap || tw->core.depth == 1) + tab->tabs.grey = tab->tabs.foreground; else - tab->tabs.grey = AllocGreyPixel((Widget)tw, + tab->tabs.grey = AllocGreyPixel ((Widget) tw, tab->tabs.foreground, tw->core.background_pixel, - tw->tabs.insensitive_contrast ) ; - tab->tabs.greyAlloc = True ; + tw->tabs.insensitive_contrast); + tab->tabs.greyAlloc = True; } - gc = tw->tabs.greyGC ; - XSetForeground(dpy, gc, tab->tabs.grey) ; + gc = tw->tabs.greyGC; +#ifdef USE_XFT_TABS + color = xft_convert_color (dpy, cmap, visual, tab->tabs.grey, 0); +#else + XSetForeground(dpy, gc, tab->tabs.grey); +#endif } - x = tab->tabs.x ; - y = tab->tabs.y ; - if( child == tw->tabs.topWidget ) - y -= TABLDELTA ; + x = tab->tabs.x; + y = tab->tabs.y; + if (child == tw->tabs.topWidget) + y -= TABLDELTA; - if( tab->tabs.left_bitmap != None && tab->tabs.lbm_width > 0 ) + if (tab->tabs.left_bitmap != None && tab->tabs.lbm_width > 0) { - if( tab->tabs.lbm_depth == 1 ) + if (tab->tabs.lbm_depth == 1) XCopyPlane(dpy, tab->tabs.left_bitmap, win,gc, 0,0, tab->tabs.lbm_width, tab->tabs.lbm_height, - x+tab->tabs.lbm_x, y+tab->tabs.lbm_y, 1L) ; + x+tab->tabs.lbm_x, y+tab->tabs.lbm_y, 1L); else XCopyArea(dpy, tab->tabs.left_bitmap, win,gc, 0,0, tab->tabs.lbm_width, tab->tabs.lbm_height, - x+tab->tabs.lbm_x, y+tab->tabs.lbm_y) ; + x+tab->tabs.lbm_x, y+tab->tabs.lbm_y); } - if( lbl != NULL && tw->tabs.font != NULL ) - XDrawString(dpy,win,gc, - x+tab->tabs.l_x, y+tab->tabs.l_y, - lbl, (int)strlen(lbl)) ; + if (lbl != NULL && +#ifdef USE_XFT_TABS + tw->tabs.renderFont != NULL +#else + tw->tabs.font != NULL +#endif + ) + { +#ifdef USE_XFT_TABS + XftDraw *xftDraw = XftDrawCreate (dpy, win, visual, cmap); + XftFont *renderFont = tw->tabs.renderFont; + XGlyphInfo glyphinfo; + XftColor colorDBG; + XftColorAllocName (dpy, visual, cmap, "wheat", &colorDBG); + XftTextExtents8 (dpy, renderFont, lbl, (int) strlen (lbl), + &glyphinfo); + /* #### unnecessary? for the moment, give visual extent */ + /* draw background rect */ +#if 1 + if (debug_tabs > 2) + { + fprintf (stderr, "background color: pixel=%08lx, r=%04x," + " g=%04x, b=%04x, alpha=%04x.\n", + colorDBG.pixel, colorDBG.color.red, + colorDBG.color.green, colorDBG.color.blue, + colorDBG.color.alpha); + fprintf (stderr, "label geometry: x=%d, y=%d, xOff=%d," + " yOff=%d, width=%d, height=%d\n", + glyphinfo.x, glyphinfo.y, glyphinfo.xOff, + glyphinfo.yOff, glyphinfo.width, glyphinfo.height); + } + XftDrawRect (xftDraw, &colorDBG, + /* left, top, width, height */ + x+tab->tabs.l_x-glyphinfo.x, + y+tab->tabs.l_y-glyphinfo.y, + glyphinfo.width, glyphinfo.height); +#endif + /* draw text */ + if (debug_tabs > 2) + { + FcValue name; + FcValue size; + FcPatternGet (renderFont->pattern, FC_FAMILY, 0, &name); + FcPatternGet (renderFont->pattern, FC_SIZE, 0, &size); + fprintf (stderr, "label: %s.\n", lbl); + fprintf (stderr, "foreground color: pixel=%08lx, r=%04x," + " g=%04x, b=%04x, alpha=%04x.\n", + color.pixel, color.color.red, color.color.green, + color.color.blue, color.color.alpha); + fprintf (stderr, "extent: x=%d, y=%d, xOffset=%d," + " yOffset=%d, height=%d, width=%d.\n", + glyphinfo.x, glyphinfo.y, glyphinfo.xOff, + glyphinfo.yOff, glyphinfo.height, glyphinfo.width); + fprintf (stderr, "font: name=%s-%.1f," + " height=%d, ascent=%d, descent=%d.\n", + name.u.s, size.u.d, renderFont->height, + renderFont->ascent, renderFont->descent); + } + XftDrawString8 (xftDraw, &color, renderFont, + x+tab->tabs.l_x, y+tab->tabs.l_y, + lbl, (int) strlen (lbl)); + XftDrawDestroy (xftDraw); +#else + XDrawString(dpy,win,gc, + x+tab->tabs.l_x, y+tab->tabs.l_y, + lbl, (int)strlen(lbl)); +#endif + } } - if( child == tw->tabs.hilight ) - DrawHighlight(tw, child, False) ; + if (child == tw->tabs.hilight) + DrawHighlight(tw, child, False); } ＠＠ -1689,9 +1966,13 ＠＠ TabWidth(Widget w) TabsConstraints tab = (TabsConstraints) w->core.constraints ; TabsWidget tw = (TabsWidget)XtParent(w) ; String lbl = tab->tabs.label != NULL ? - tab->tabs.label : XtName(w) ; - XFontStruct *font = tw->tabs.font ; - int iw = tw->tabs.internalWidth ; + tab->tabs.label : XtName(w); +#ifdef USE_XFT_TABS + XftFont *font = tw->tabs.renderFont; +#else + XFontStruct *font = tw->tabs.font; +#endif + int iw = tw->tabs.internalWidth; tab->tabs.width = iw + SHADWID*2 ; tab->tabs.l_x = tab->tabs.lbm_x = SHADWID + iw ; ＠＠ -1705,10 +1986,27 ＠＠ TabWidth(Widget w) if( lbl != NULL && font != NULL ) { - tab->tabs.width += XTextWidth( font, lbl, (int)strlen(lbl) ) + iw ; +#ifdef USE_XFT_TABS + tab->tabs.width += x_xft_text_width (XtDisplay(tw), font, + lbl, (int)strlen(lbl)) + iw; + tab->tabs.l_y = (tw->tabs.tab_height + + tw->tabs.renderFont->ascent + /* #### how can this subtraction be correct? */ + - tw->tabs.renderFont->descent)/2; + if (debug_tabs > 2) + fprintf (stderr, "tab: height=%d, width=%d, baseline=%d.\n", + tw->tabs.tab_height, tab->tabs.width, tab->tabs.l_y); + if (debug_tabs > 1) + fprintf (stderr, "font: height=%d, ascent=%d, descent=%d.\n", + tw->tabs.renderFont->height, + tw->tabs.renderFont->ascent, + tw->tabs.renderFont->descent); +#else + tab->tabs.width += XTextWidth (font, lbl, (int)strlen(lbl)) + iw; tab->tabs.l_y = (tw->tabs.tab_height + tw->tabs.font->max_bounds.ascent - - tw->tabs.font->max_bounds.descent)/2 ; + tw->tabs.font->max_bounds.descent)/2; +#endif } } ＠＠ -1723,19 +2021,32 ＠＠ TabWidth(Widget w) * * TODO: if they require more than two rows and the total height:width * ratio is more than 2:1, then try something else. + * Gaak! This is actually already done in PreferredSize()! + * + * TODO SOONER: for reasons unclear, some applications (specifically + * XEmacs) give a nominal geometry (in the core record) which doesn't + * make much sense (eg, may be smaller than some of the tab children). + * This results in bizarre values for DISPLAY_ROWS and REPLY_HEIGHT. + * Specify a way to say "tell me what you really want" (eg, with WID + * and/or HGT == 0 or == Dimension_MAX), and use it where appropriate. + * LATE-BREAKING LOSE: This happens in PreferredSize(), not XEmacs! + * + * TODO EVEN SOONER: some applications lay out the tab control by + * repeatedly querying until a fixed width and height has been filled + * by the tabs (XEmacs). There should be an API to cache this? */ static int TabLayout(TabsWidget tw, - Dimension wid, - Dimension hgt, + Dimension wid, /* if 0, use core.width as guess */ + Dimension hgt, /* if 0, use core.height as guess */ Dimension *reply_height, Bool query_only) { int i, row, done = 0, display_rows = 0 ; int num_children = tw->composite.num_children ; Widget *childP ; Dimension w ; - Position x,y ; + Position x,y ; /* #### gaak, these are dimensions! */ TabsConstraints tab ; /* Algorithm: loop through children, assign X positions. If a tab ＠＠ -1750,22 +2061,33 ＠＠ TabLayout(TabsWidget tw, row = 0 ; x = INDENT ; y = 0 ; - wid -= INDENT ; + /* If wid or hgt is 0, we want to guess our own dimensions. + Currently the guessing functions are broken.... + #### When PreferredSize*() get fixed, fix this too. */ + if (debug_tabs > 0) + fprintf (stderr, "arg=%d,", wid); + wid = (wid ? wid : tw->core.width) - INDENT ; + hgt = hgt ? hgt : tw->core.height; + if (debug_tabs > 0) + fprintf (stderr, "wid=%d: x,w,y=", wid); for(i=num_children, childP=tw->composite.children; --i >= 0; ++childP) if( XtIsManaged(*childP) ) { tab = (TabsConstraints) (*childP)->core.constraints ; w = tab->tabs.width ; + if (debug_tabs > 0) + fprintf (stderr, "%d,%d,%d;", x, w, y); if( x + w > wid ) { /* new row */ - if (y + tw->tabs.tab_height > hgt && !done) + /* #### algorithm is not robust to wid < child's width */ + ++row; + x = INDENT ; + y += tw->tabs.tab_height ; + if (y > hgt && !done) { display_rows = row; done = 1; } - ++row; - x = INDENT ; - y += tw->tabs.tab_height ; } if( !query_only ) { tab->tabs.x = x ; ＠＠ -1777,10 +2099,11 ＠＠ TabLayout(TabsWidget tw, tab->tabs.visible = 1; } + if (debug_tabs > 0) + fprintf (stderr, "\n"); /* If there was only one row, increase the height by TABDELTA */ if( ++display_rows == 1 ) { - row++; y = TABDELTA ; if( !query_only ) for(i=num_children, childP=tw->composite.children; ＠＠ -1791,6 +2114,7 ＠＠ TabLayout(TabsWidget tw, tab->tabs.y = y ; } } + row++; y += tw->tabs.tab_height ; } else ＠＠ -1802,6 +2126,12 ＠＠ TabLayout(TabsWidget tw, tw->tabs.realRows = row; } + if (debug_tabs > 0 && (row > 1 || display_rows > 1)) + fprintf (stderr, "tab: %d display rows, #children = %d," + " total height %d, total rows %d%s.\n", + display_rows, num_children, y, row, + query_only ? " (query)" : ""); + if( reply_height != NULL ) *reply_height = y ; ＠＠ -1822,8 +2152,8 ＠＠ GetPreferredSizes(TabsWidget tw) - /* Find max preferred child size. Returned sizes include child - * border widths. If except is non-null, don't ask that one. + /* Find max preferred child size and store in control widget. + * If except is non-null, don't ask that one. */ static void ＠＠ -2009,7 +2339,10 ＠＠ PreferredSize3( int nrows ; if( tw->composite.num_children > 0 ) - nrows = TabLayout(tw, wid, hgt, &th, True) ; + /* used to be wid, hgt not 0, 0 but that's obviously wrong + since TabLayout wants dimensions of control parent but + wid, hgt are dimensions of some child */ + nrows = TabLayout(tw, 0, 0, &th, True) ; else { th = 0 ; nrows = 0 ; ＠＠ -2091,17 +2424,29 ＠＠ TabsAllocFgGC(TabsWidget tw) Widget w = (Widget) tw; XGCValues values ; - values.background = tw->core.background_pixel ; - values.font = tw->tabs.font->fid ; - values.line_style = LineOnOffDash ; - values.line_style = LineSolid ; + values.background = tw->core.background_pixel; + values.font = +#ifdef USE_XFT_TABS + None; +#else + tw->tabs.font->fid; +#endif + values.line_style = LineOnOffDash; + values.line_style = LineSolid; tw->tabs.foregroundGC = XtAllocateGC(w, w->core.depth, - GCBackground|GCFont|GCLineStyle, &values, - GCForeground, - GCSubwindowMode|GCGraphicsExposures|GCDashOffset| - GCDashList|GCArcMode) ; +#ifndef USE_XFT_TABS + GCFont| +#endif + GCBackground|GCLineStyle, + &values, + GCForeground, +#ifdef USE_XFT_TABS + GCFont| +#endif + GCSubwindowMode|GCGraphicsExposures|GCDashOffset| + GCDashList|GCArcMode); } static void ＠＠ -2110,30 +2455,49 ＠＠ TabsAllocGreyGC(TabsWidget tw) Widget w = (Widget) tw; XGCValues values ; - values.background = tw->core.background_pixel ; - values.font = tw->tabs.font->fid ; + values.background = tw->core.background_pixel; + values.font = +#ifdef USE_XFT_TABS + None; +#else + tw->tabs.font->fid; +#endif #ifdef HAVE_XMU - if( tw->tabs.be_nice_to_cmap || w->core.depth == 1) + if (tw->tabs.be_nice_to_cmap || w->core.depth == 1) { - values.fill_style = FillStippled ; + values.fill_style = FillStippled; tw->tabs.grey50 = - values.stipple = XmuCreateStippledPixmap(XtScreen(w), 1L, 0L, 1) ; + values.stipple = XmuCreateStippledPixmap(XtScreen(w), 1L, 0L, 1); tw->tabs.greyGC = XtAllocateGC(w, w->core.depth, - GCBackground|GCFont|GCStipple|GCFillStyle, &values, +#ifndef USE_XFT_TABS + GCFont| +#endif + GCBackground|GCStipple|GCFillStyle, &values, GCForeground, +#ifdef USE_XFT_TABS + GCFont| +#endif GCSubwindowMode|GCGraphicsExposures|GCDashOffset| - GCDashList|GCArcMode) ; + GCDashList|GCArcMode); } else #endif { tw->tabs.greyGC = XtAllocateGC(w, w->core.depth, - GCFont, &values, +#ifdef USE_XFT_TABS + 0L, +#else + GCFont, +#endif + &values, GCForeground, +#ifdef USE_XFT_TABS + GCFont| +#endif GCBackground|GCSubwindowMode|GCGraphicsExposures|GCDashOffset| - GCDashList|GCArcMode) ; + GCDashList|GCArcMode); } } 1.3 +7 -0 XEmacs/xemacs/lwlib/xlwtabsP.h Index: xlwtabsP.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/xlwtabsP.h,v retrieving revision 1.2 retrieving revision 1.3 diff -u -p -r1.2 -r1.3 --- xlwtabsP.h 2001/04/12 18:21:57 1.2 +++ xlwtabsP.h 2005/11/26 11:46:00 1.3 ＠＠ -41,6 +41,9 ＠＠ Boston, MA 02111-1307, USA. */ #endif #include "xlwtabs.h" +#ifdef USE_XFT_TABS +#include <X11/Xft/Xft.h> +#endif /* New fields for the Tabs widget class record */ typedef struct {XtPointer extension;} TabsClassPart; ＠＠ -70,6 +73,10 ＠＠ extern TabsClassRec tabsClassRec; typedef struct { /* resources */ XFontStruct *font ; +#ifdef USE_XFT_TABS + String renderFontSpec; + XftFont *renderFont; +#endif Dimension internalHeight, internalWidth ; Widget topWidget ; XtCallbackList callbacks ; 1.2 +361 -0 XEmacs/xemacs/lwlib/lwlib-colors.c Index: lwlib-colors.c =================================================================== RCS file: lwlib-colors.c diff -N lwlib-colors.c --- /dev/null Sat Nov 26 12:46:01 2005 +++ /tmp/cvsAAANcaWRX Sat Nov 26 12:46:02 2005 ＠＠ -0,0 +1,361 ＠＠ +/* Color data structures for X and Xft. + +Copyright (C) 2004 Free Software Foundation, Inc. + +Author: Stephen J. Turnbull <stephen(a)xemacs.org&gt; +Created: 24 Jul 2004 by Stephen J. Turnbull + +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 GNU Emacs. */ + +#include <config.h> +#include <limits.h> /* for ULONG_MAX */ +#include <stdlib.h> /* for malloc() */ +#include <stdio.h> +#include <X11/Xlib.h> +#include <X11/IntrinsicP.h> +#include <X11/ShellP.h> /* for ShellWidget */ +#include "lwlib-colors.h" + +static int debug_colors = 1; + +#ifdef __cplusplus +#define X_CLASSFIELD c_class +#else +#define X_CLASSFIELD class +#endif + +#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ + ? ((unsigned long) (x)) : ((unsigned long) (y))) + +/* WIDGET is an Xt widget, VISUAL and DEPTH are return values */ +void +visual_info_from_widget (Widget widget, Visual **visual, int *depth) +{ + /* grab the visual and depth from the nearest shell ancestor */ + Widget p = XtParent(widget); + + *visual = CopyFromParent; + *depth = -1; + while (*visual == CopyFromParent && p) + { + if (XtIsShell(p)) + { + *visual = ((ShellWidget)p)->shell.visual; + *depth = p->core.depth; + } + p = XtParent(p); + } + if (*visual == CopyFromParent || !*visual) + { + if (debug_colors > 1) + fprintf (stderr, "\nvisual_info_from_widget:" + " failed, using DefaultVisualOfScreen"); + *visual = DefaultVisualOfScreen (XtScreen (widget)); + *depth = DefaultDepthOfScreen (XtScreen (widget)); + } + else if (debug_colors > 1) + fprintf (stderr, "\nvisual_info_from_widget: succeeded"); +} + +/* Do we need all this hair on modern hardware? */ + +/* Replacement for XAllocColor() that tries to return the nearest + available color if the colormap is full. Original was from FSFmacs, + but rewritten by Jareth Hein <jareth(a)camelot-soft.com&gt; 97/11/25 + Modified by Lee Kindness <lkindness(a)csl.co.uk&gt; 31/08/99 to handle previous + total failure which was due to a read/write colorcell being the nearest + match - tries the next nearest... + + Return value is 1 for normal success, 2 for nearest color success, + 3 for Non-deallocable success. */ +int +x_allocate_nearest_color (Display *display, Colormap colormap, + Visual *visual, XColor *color_def) +{ + int status; + + /* #### [[Apparently this is often called with data derived from a widget + with no ShellWidget ancestor, or before the shell has a visual. + Currently this recovery code is in xlwmenu.c and xlwscrollbar.c, but + likely should come here.]] + I suspect the problem is that the visual-tracing code was improperly + written, missing a level of indirection. + CopyFromParent == NULL in XFree86/Darwin. + */ + if (visual == CopyFromParent || !visual) + { + Screen *screen = DefaultScreenOfDisplay (display); + fprintf (stderr, "\nx_allocate_nearest_color: bad visual (%08lx)", + (unsigned long) visual); + visual = DefaultVisualOfScreen (screen); + } + + if (visual->X_CLASSFIELD == DirectColor || visual->X_CLASSFIELD == TrueColor) + { + if (XAllocColor (display, colormap, color_def) != 0) + { + status = 1; + } + else + { + /* We're dealing with a TrueColor/DirectColor visual, so play games + with the RGB values in the XColor struct. */ + /* #### JH: I'm not sure how a call to XAllocColor can fail in a + TrueColor or DirectColor visual, so I will just reformat the + request to match the requirements of the visual, and re-issue + the request. If this fails for anybody, I wanna know about it + so I can come up with a better plan */ + + unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk; + junk = visual->red_mask; + rshift = 0; + while ((junk & 0x1) == 0) { + junk = junk >> 1; + rshift ++; + } + rbits = 0; + while (junk != 0) { + junk = junk >> 1; + rbits++; + } + junk = visual->green_mask; + gshift = 0; + while ((junk & 0x1) == 0) { + junk = junk >> 1; + gshift ++; + } + gbits = 0; + while (junk != 0) { + junk = junk >> 1; + gbits++; + } + junk = visual->blue_mask; + bshift = 0; + while ((junk & 0x1) == 0) { + junk = junk >> 1; + bshift ++; + } + bbits = 0; + while (junk != 0) { + junk = junk >> 1; + bbits++; + } + + color_def->red = color_def->red >> (16 - rbits); + color_def->green = color_def->green >> (16 - gbits); + color_def->blue = color_def->blue >> (16 - bbits); + if (XAllocColor (display, colormap, color_def) != 0) + status = 1; + else + { + int rd, gr, bl; + /* #### JH: I'm punting here, knowing that doing this will at + least draw the color correctly. However, unless we convert + all of the functions that allocate colors (graphics + libraries, etc) to use this function doing this is very + likely to cause problems later... */ + + if (rbits > 8) + rd = color_def->red << (rbits - 8); + else + rd = color_def->red >> (8 - rbits); + if (gbits > 8) + gr = color_def->green << (gbits - 8); + else + gr = color_def->green >> (8 - gbits); + if (bbits > 8) + bl = color_def->blue << (bbits - 8); + else + bl = color_def->blue >> (8 - bbits); + color_def->pixel = (rd << rshift) | (gr << gshift) | (bl << + bshift); + status = 3; + } + } + } + else + { + XColor *cells = NULL; + /* JH: I can't believe there's no way to go backwards from a + colormap ID and get its visual and number of entries, but X + apparently isn't built that way... */ + int no_cells = visual->map_entries; + status = 0; + + if (XAllocColor (display, colormap, color_def) != 0) + status = 1; + else while( status != 2 ) + { + /* If we got to this point, the colormap is full, so we're + going to try and get the next closest color. The algorithm used + is a least-squares matching, which is what X uses for closest + color matching with StaticColor visuals. */ + int nearest; + long nearest_delta, trial_delta; + int x; + + if( cells == NULL ) + { + /* #### this could be annoyingly slow + tell me again why lwlib can't use alloca & friends? */ + cells = (XColor *) malloc (sizeof(XColor)*no_cells); + for (x = 0; x < no_cells; x++) + cells[x].pixel = x; + + /* read the current colormap */ + XQueryColors (display, colormap, cells, no_cells); + } + + nearest = 0; + /* I'm assuming CSE so I'm not going to condense this. */ + nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8)) + * ((color_def->red >> 8) - (cells[0].red >> 8))) + + + (((color_def->green >> 8) - (cells[0].green >> 8)) + * ((color_def->green >> 8) - (cells[0].green >> + 8))) + + + (((color_def->blue >> 8) - (cells[0].blue >> 8)) + * ((color_def->blue >> 8) - (cells[0].blue >> + 8)))); + for (x = 1; x < no_cells; x++) + { + trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8)) + * ((color_def->red >> 8) - (cells[x].red >> 8))) + + + (((color_def->green >> 8) - (cells[x].green >> 8)) + * ((color_def->green >> 8) - (cells[x].green >> + 8))) + + + (((color_def->blue >> 8) - (cells[x].blue >> 8)) + * ((color_def->blue >> 8) - (cells[x].blue >> + 8)))); + + /* less? Ignore cells marked as previously failing */ + if( (trial_delta < nearest_delta) && + (cells[x].pixel != ULONG_MAX) ) + { + nearest = x; + nearest_delta = trial_delta; + } + } + color_def->red = cells[nearest].red; + color_def->green = cells[nearest].green; + color_def->blue = cells[nearest].blue; + if (XAllocColor (display, colormap, color_def) != 0) + status = 2; + else + /* LSK: Either the colour map has changed since + * we read it, or the colour is allocated + * read/write... Mark this cmap entry so it's + * ignored in the next iteration. + */ + cells[nearest].pixel = ULONG_MAX; + } + } + return status; +} + +#if 0 +/* Replacement for XAllocColor() that tries to return the nearest + available color if the colormap is full. From GNU Emacs. + #### Review this to see if there's anything our hairy version could use. */ + +int +FIXME_allocate_nearest_color (Display *display, Colormap screen_colormap, + XColor *color_def) +{ + int status = XAllocColor (display, screen_colormap, color_def); + if (status) + return status; + + { + /* If we got to this point, the colormap is full, so we're + going to try to get the next closest color. + The algorithm used is a least-squares matching, which is + what X uses for closest color matching with StaticColor visuals. */ + + int nearest, x; + unsigned long nearest_delta = ULONG_MAX; + + int no_cells = XDisplayCells (display, XDefaultScreen (display)); + /* Don't use alloca here because lwlib doesn't have the + necessary configuration information that src does. */ + XColor *cells = (XColor *) malloc (sizeof (XColor) * no_cells); + + for (x = 0; x < no_cells; x++) + cells[x].pixel = x; + + XQueryColors (display, screen_colormap, cells, no_cells); + + for (nearest = 0, x = 0; x < no_cells; x++) + { + long dred = (color_def->red >> 8) - (cells[x].red >> 8); + long dgreen = (color_def->green >> 8) - (cells[x].green >> 8); + long dblue = (color_def->blue >> 8) - (cells[x].blue >> 8); + unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue; + + if (delta < nearest_delta) + { + nearest = x; + nearest_delta = delta; + } + } + color_def->red = cells[nearest].red; + color_def->green = cells[nearest].green; + color_def->blue = cells[nearest].blue; + free (cells); + return XAllocColor (display, screen_colormap, color_def); + } +} +#endif + + +#ifdef USE_XFT + +XftColor +xft_convert_color (Display *dpy, Colormap cmap, Visual *visual, int c, int dim) +{ + static XColor color; /* #### why is this static ?? */ + XftColor result; + + color.pixel = c; + XQueryColor(dpy, cmap, &color); + + if (dim) + { + color.red = MINL (65535, color.red * 1.5); + color.green = MINL (65535, color.green * 1.5); + color.blue = MINL (65535, color.blue * 1.5); + x_allocate_nearest_color (dpy, cmap, visual, &color); + } + + result.pixel = color.pixel; + result.color.red = color.red; + result.color.green = color.green; + result.color.blue = color.blue; + result.color.alpha = 0xffff; + + return result; +} + +#endif /* USE_XFT */ + +/* end of lwlib-colors.c */ 1.2 +59 -0 XEmacs/xemacs/lwlib/lwlib-colors.h Index: lwlib-colors.h =================================================================== RCS file: lwlib-colors.h diff -N lwlib-colors.h --- /dev/null Sat Nov 26 12:46:01 2005 +++ /tmp/cvsAAAHeaiSX Sat Nov 26 12:46:02 2005 ＠＠ -0,0 +1,59 ＠＠ +/* Color data structures for X and Xft. + +Copyright (C) 2004 Free Software Foundation, Inc. + +Author: Stephen J. Turnbull <stephen(a)xemacs.org&gt; +Created: 24 Jul 2004 by Stephen J. Turnbull + +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 GNU Emacs. */ + +#ifndef INCLUDED_lwlib_colors_h_ +#define INCLUDED_lwlib_colors_h_ + +#include <X11/Xlib.h> + +/* WIDGET is an Xt widget, VISUAL and DEPTH are return values */ +void visual_info_from_widget (Widget widget, Visual **visual, int *depth); + +/* basic version from xlwmenu.c */ +int FIXME_allocate_nearest_color (Display *display, Colormap screen_colormap, + XColor *color_def); +/* haired-up version from ../src/objects-x.c */ +int x_allocate_nearest_color (Display *display, Colormap screen_colormap, + Visual *visual, XColor *color_def); + +#ifdef USE_XFT +#define _XFT_NO_COMPAT_ +/* shut up GCC */ +#define face_index face_index_arg +#define glyph_index glyph_index_arg +#include <X11/Xft/Xft.h> +#undef glyph_index +#undef face_index + +#if XFT_MAJOR < 2 +#error Xft versions < 2 not supported +#endif + +XftColor xft_convert_color (Display *dpy, Colormap cmap, Visual *visual, + int c, int dim); +#endif /* USE_XFT */ + +#endif /* INCLUDED_lwlib_colors_h_ */ 1.2 +115 -0 XEmacs/xemacs/lwlib/lwlib-fonts.c Index: lwlib-fonts.c =================================================================== RCS file: lwlib-fonts.c diff -N lwlib-fonts.c --- /dev/null Sat Nov 26 12:46:01 2005 +++ /tmp/cvsAAA1faGSX Sat Nov 26 12:46:02 2005 ＠＠ -0,0 +1,115 ＠＠ +/* Font handling code for X and Xft. + +Copyright (C) 2003 Eric Knauel +Copyright (C) 2004 Free Software Foundation, Inc. + +Author: Stephen J. Turnbull <stephen(a)xemacs.org&gt; +Created: 24 Jul 2004 by Stephen J. Turnbull + +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 GNU Emacs. */ + +#include <config.h> +#include <stdio.h> +#include <stdlib.h> +#include "lwlib-fonts.h" + +#if 0 +/* these are all from ../src; if we need them move the code */ +#include "lisp.h" +#include "device.h" +#include "device-impl.h" +#include "console-x-impl.h" +#include "xft-fonts.h" +#endif + +/* + * code for handling Xft + */ + +#ifdef USE_XFT + +/* helper function to correctly open Xft/core fonts by name + #### Can't we use FcParseName here? + #### Is this done so often that the logic needs to be hard-coded in C? + + Daniel Pittman sez: Older code tried to enforce that an XLFD font was + not scaled, while this version just doesn't care. I think that is a + better behavior, since if someone really wants a scaled font we should + oblige them. + + Stephen sez: This whole function was ill-conceived, and I'm not sure it + succeeds at any of the things it attempts to do. First, we should be + using fontconfig directly. I'm not sure what Xft (or fontconfig) will + try to do if passed an XLFD. As for scaled fonts, both options are + equally bad. The problem is that the X server will often scale bitmap + fonts willy-nilly; it's worth trying to avoid that, but I can't say + whether that's worth overriding somebody who knows what they're doing. + In any case, I think we should find out what Xft (fontconfig?) is able + and willing to do with XLFDs, and probably move the logic to LISP. +*/ +XftFont * +xft_open_font_by_name (Display *dpy, char *name) +{ + XftFont *res = NULL; + + /* if (!NILP (Fxft_xlfd_font_name_p (make_string (name, strlen (name))))) */ + /* #### this is bogus but ... */ + int count = 0; + char *pos = name; + /* extra parens shut up gcc */ + while ((pos = index (pos, '-'))) + { + count++; + pos++; + } + + /* #### hard-coding DefaultScreen is evil! */ + if (count == 14 /* fully-qualified XLFD */ + || (count < 14 /* heuristic for wildcarded XLFD */ + && count >= 5 + && index (name, '*'))) + res = XftFontOpenXlfd (dpy, DefaultScreen (dpy), name); + else + res = XftFontOpenName (dpy, DefaultScreen (dpy), name); + + /* Try for a generic monospace font + #### Why? Menus don't need to line up in columns! */ + if (!res) + res = XftFontOpenName (dpy, DefaultScreen (dpy), "monospace"); + /* Try for anything we can get */ + if (!res) + res = XftFontOpenName (dpy, DefaultScreen (dpy), ""); + + if (!res) + { + /* #### This is Just So Wrong ... ! */ + /* sorry folks ... */ + fprintf (stderr, + "Unable to find any usable XFT font, even the defaults!\n"); + abort (); + return 0; + } + + return res; +} + +#endif /* USE_XFT */ + +/* End of lwlib-fonts.c */ 1.2 +67 -0 XEmacs/xemacs/lwlib/lwlib-fonts.h Index: lwlib-fonts.h =================================================================== RCS file: lwlib-fonts.h diff -N lwlib-fonts.h --- /dev/null Sat Nov 26 12:46:01 2005 +++ /tmp/cvsAAAgha4SX Sat Nov 26 12:46:02 2005 ＠＠ -0,0 +1,67 ＠＠ +/* Font data structures for X and Xft. + +Copyright (C) 2004 Free Software Foundation, Inc. + +Author: Stephen J. Turnbull <stephen(a)xemacs.org&gt; +Created: 24 Jul 2004 by Stephen J. Turnbull + +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 GNU Emacs. */ + +#ifndef INCLUDED_lwlib_fonts_h_ +#define INCLUDED_lwlib_fonts_h_ + +/* get headers */ + +#ifdef USE_XFT +#define _XFT_NO_COMPAT_ +/* shut up GCC */ +#define face_index face_index_arg +#define glyph_index glyph_index_arg +#include <X11/Xft/Xft.h> +#undef glyph_index +#undef face_index + +#if XFT_MAJOR < 2 +#error Xft versions < 2 not supported +#endif +#endif /* USE_XFT */ + +/* Xt name macros */ + +#ifdef USE_XFT +#ifndef XtNxftFont +#define XtNxftFont "xftFont" +#endif +#ifndef XtCXftFont +#define XtCXftFont "XftFont" +#endif +#endif /* USE_XFT */ + +/* code 'n' stuff */ + +#ifdef USE_XFT +#define FCSTRLEN 512 + +/* non-Lisp prototypes */ +/* #### change this back to _open_name */ +XftFont *xft_open_font_by_name (Display *dpy, char *name); +#endif /* USE_XFT */ + +#endif /* INCLUDED_lwlib_fonts_h_ */ 1.324 +5 -0 XEmacs/xemacs/man/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/man/ChangeLog,v retrieving revision 1.323 retrieving revision 1.324 diff -u -p -r1.323 -r1.324 --- ChangeLog 2005/11/16 11:54:06 1.323 +++ ChangeLog 2005/11/26 11:46:03 1.324 ＠＠ -1,3 +1,8 ＠＠ +2005-11-22 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * internals/internals.texi (Working with Lisp Objects): Explain + better why DEFSYMBOL is usually preferable to intern. + 2005-11-08 Malcolm Purvis <malcolmp(a)xemacs.org&gt; * internals/internals.texi (The configure Script): Added the 1.893 +542 -1 XEmacs/xemacs/src/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v retrieving revision 1.892 retrieving revision 1.893 diff -u -p -r1.892 -r1.893 --- ChangeLog 2005/11/25 01:41:53 1.892 +++ ChangeLog 2005/11/26 11:46:05 1.893 ＠＠ -1,3 +1,542 ＠＠ +2005-11-26 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Merge Xft. + + 2005-11-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c: Improve comments. + + 2005-11-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.h: + * xft-fonts.c: + * redisplay-x.c: + Remove or comment out dead code. + + 2005-11-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_find_charset_font): Encapsulate debug print in macro. + + 2005-11-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.h: + * xft-fonts.c: + * objects-x.c: + Xft font names are encoded in UTF-8 (Qxft_font_name_encoding). + + 2005-11-06 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.h: + * xft-fonts.c: + Substitute new *LCRECORD* macros for #ifdef MC_ALLOC. + + 2005-09-10 Clemens Fruhwirth <clemens(a)endorphin.org&gt; + + * glyphs-x.c (update_widget_face): Wrap error checking of rf in an + #ifdef USE_XFT. + + 2005-09-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_initialize_font_instance): Must encode extname + twice, Qxft_font_name_encoding != Qx_font_name_encoding. + + 2005-09-25 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_finalize_font_instance): Add newline to message. + + 2005-09-24 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_find_charset_font): Give user more control of + debug verbosity. Reduce verbosity at debug_xft=1. Reduce + verbosity of truename by removing properties that are rarely + specified from fontconfig font name. + + 2005-09-24 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_find_charset_font): Work around buggy return + value in FcInit(). + + 2005-09-24 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c: Improve various header comments. + (x_font_instance_truename): Remove obsolete #ifdef 0 code. + + 2005-09-06 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * console-x-impl.h (struct x_frame): Rewrite comment. + + * redisplay-x.c (x_output_string): + * frame-x.c (x_delete_frame): + Improve style, let compiler optimize. + + 2005-09-05 Daniel Pittman <daniel(a)rimspace.net&gt; + + * console-x-impl.h (struct x_frame): New member xftDraw. + (FRAME_X_XFTDRAW): Accessor for xftDraw member. + + * redisplay-x.c (x_output_string): Lazily initialize frame's + xftDraw member, and don't destroy it here. + + * frame-x.c (x_delete_frame): Destroy xftDraw here. + + 2005-08-17 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.c (Ffc_pattern_create): Improve docstring, remove todo. + (fc_intern): Add todo. + + 2005-08-04 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.c (finalize_fc_pattern): New static function. + Add it to lcrecord implementation of fc_pattern. + + * xft-fonts.c (Ffc_pattern_destroy): Disable with #if 0. + + 2005-08-03 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + -- Minor cleanups. -- + + * xft-fonts.c (Ffc_font_real_pattern): + Update FIXME at top. + (Ffc_font_sort): + (Ffc_font_match): + Improve docstrings. + + * xft-fonts.c (Ffc_pattern_destroy): + Partially protect against double frees. + + -- Eliminate Lisp fc_fontset objects. -- + + * xft-fonts.c (fontset_to_list): New helper function. + (Ffc_list_fonts_pattern_objects): + (Ffc_font_sort): + Made to use `fontset_to_list' and return list. Updated docstrings. + + * xft-fonts.h (struct fc_pattern): Removed fc_fontset member. + (fc_fontset): Removed struct and lrecord declarations and typedef. + (XFCFONTSET): + (wrap_fcfontset): + (FCFONTSETP): + (CHECK_FCFONTSET): + (CONCHECK_FCFONTSET): + (XFCFONTSET_PTR): + Removed macros. + + * xft-fonts.c (fcfontset_description): + (fc_fontset): + (Ffc_fontset_p): + (Ffc_fontset_count): + (Ffc_fontset_destroy): + (Ffc_fontset_ref): + Removed unused functions. + (fcpattern_description): Removed fc_fontset member. + (Ffc_pattern_create): + (Ffc_name_parse): + (Ffc_pattern_duplicate): + (Ffc_pattern_destroy): + (Ffc_font_match): + (Ffc_font_real_pattern): + Removed reference to fc_fontset member. + (syms_of_xft_fonts): Removed DEFSYMBOLs, DEFSUBRs for fc_fontset. + + * lrecord.h (enum lrecord_type): Removed lrecord_fc_fontset. + Removed indicies, which depended on #ifdefs so can't be accurate. + + 2005-07-31 Daniel Pittman <daniel(a)rimspace.net&gt; + + * xft-fonts.c: Update Ffc_list_fonts_pattern_objects to use the + FontConfig API nicely, preventing it from rebuilding the list of + available fonts on *every* access. + + 2005-06-16 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.c: MC_ALLOC-ify. + * xft-fonts.h: MC_ALLOC-ify. + + 2005-04-16 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.c: Improve comment on property name hash table. + + (Ffc_list_fonts_pattern_objects): + (Ffc_font_sort): + (reinit_vars_of_xft_fonts): + Call FcInit only once in reinit_vars_of_xft_fonts. + + (Ffc_list_fonts_pattern_objects): + (Ffc_font_sort): + Signal error if returned FcFontSet object is NULL. + + (string_list_to_fcobjectset): Use fc_intern. + + * objects-x.c (): Move declaration of `name' out of #ifdef. + + 2005-04-14 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.c (fc_intern): val is const. + (xft_get_color): Use dead_wrong_type_argument. + + * objects-x.c (Qxft_font_name_encoding): New documentary #define. + (truename_via_XListFonts): Improve comments. + + Followup on Aidan's partial cleanup/Mulization. + + * objects-x.c (DEBUG_XFT0): + (DEBUG_XFT1): + (DEBUG_XFT2): + (PRINT_XFT_PATTERN): + (CHECKING_LANG): + Move to top of font object block. + (DEBUG_XFT3): + (DEBUG_XFT4): + New. + (x_initialize_font_instance): + (x_finalize_font_instance): + Use them. + + (x_font_instance_truename): Comment complaint about structure. + Clarify variable usage by moving declaration inside block. + + (x_find_charset_font): Clarify block structure by eliminating + early returns. Remove bogus "must free" comments. Free FcPattern + objects that were leaking. Use block structure to indicate + lifetimes of FcPattern objects. Use "font" rather than "pattern" + in names of FcPatterns that name fonts rather than search + criteria. Use shortnames more consistently in debug messages. + #ifdef shortname vs longname return values. Correct comment to + note that FcCharSets are Unparsed to ASCII. Don't ever fall + through to X core fonts if we had an Xft font (it should be NULL + anyway). Use Qxft_font_name_encoding; this means we have to parse + FONT separately for Qx_font_name_encoding. + + 2005-04-10 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Xft/fontconfig assumes that strings used as object names are + statically allocated. Implement a hash table to keep track of + them: + + * xft-fonts.c (reinit_vars_of_xft_fonts): Initialize hash table. + (fc_intern): + New static functions. + + (fc_property_name_hash_table): + (fc_standard_properties): + New static variables. + + * symsinit.h (reinit_vars_of_xft_fonts): Declare it. + + * emacs.c (main_1): Call it. Reorder complex_vars_of_xft_fonts. + + Renaming and reorganization: + + * xft-fonts.c: Group FcPattern stuff separately from FcFontSet in + preparation for removing latter from LISP visibility. Use + "pattern" for Lisp_Objects, reserve "fcpat" for FcPatterns. + Similarly change "object" to "property". + + (Ffc_pattern_destroy): + (Ffc_fontset_destroy): + Deprecate these; they should not be LISP-visible. + + (Ffc_pattern_print): Removed. + + (extract_fcapi_string): Make this a macro, because + in C "inline" is a hint. But this _must_ be a macro because it + implicitly uses alloca. + + 2005-04-09 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.c (fc-pattern-get-antialias): + (fc-pattern-get-dpi): + (fc-pattern-get-family): + (fc-pattern-get-file): + (fc-pattern-get-foundry): + (fc-pattern-get-minspace): + (fc-pattern-get-outline): + (fc-pattern-get-pixelsize): + (fc-pattern-get-rasterizer): + (fc-pattern-get-scalable): + (fc-pattern-get-scale): + (fc-pattern-get-size): + (fc-pattern-get-style): + (fc-pattern-get-xlfd): + (xft-pattern-get-core): + (xft-pattern-get-encoding): + (xft-pattern-get-render): + (fc_get_pattern_bool): + (fc_get_pattern_double): + (fc_get_pattern_integer): + (fc_get_pattern_string): + (xft_font_open_name): + Delete definitions of long-unused functions. + + (syms_of_xft_fonts): + Delete references. + + * xft-fonts.h (fc_get_pattern_bool): + (fc_get_pattern_double): + (fc_get_pattern_integer): + (fc_get_pattern_string): + Delete declarations of long-unused helper functions. + + * xft-fonts.c (Ffc_font_match): s/poosible/possible/ in docstring. + + 2005-04-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * objects-x.c: + * objects-x.c (x_initialize_font_instance): + * objects-x.c (CHECKING_LANG): + General mule-sanity cleanup for the debug messages, to eliminate + the issue Giacomo Boffi saw in + 16970.44359.621213.994821(a)boffi95.stru.polimi.it. + + * objects-x.c (x_find_charset_font): + Font names are also treated as UTF-8; relatedly, when passing back + the font's full name, the character coverage bitmap isn't included + any more, because that would make it an invalid UTF-8 string. + + 2005-03-10 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (charset_table): Fix ISO 639 code for Greek. Reported + by Stefan Holst <holst(a)mathematik.uni-mainz.de&gt;. + (charset_table): Add information for Hebrew, whine about ISO prices. + + 2005-03-09 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_font_instance_truename): Try to fix XListFonts + crash by not handing random Xft results to core Xlib functions. + Replace bizarre gymnastics with simple FcNameUnparse. + + 2005-03-07 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x-impl.h: Include lwlib-fonts.h + + * objects-x.c (x_font_instance_truename): + * glyphs-x.c (update_widget_face): + * frame-x.c (x_update_frame_external_traits): + Use the correct variant of FONT_INSTANCE_{X,XFT}_FONT. + Protect against access of uninitialized objects. + + * redisplay-x.c (x_get_gc): Fix typo. + * (x_output_string): Add comments, clarify logic slightly. + + 2005-03-05 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + 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&gt; + + * 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&gt; + + * objects-x.c (x_find_charset_font): ConfigSubstitute in the + _pattern_ before matching. + + 2005-02-24 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * faces.c (complex_vars_of_faces): Default to monospace-12 for + Xft. (Suggestion by Aidan Kehoe.) + + 2005-02-24 Hrvoje Niksic <hniksic(a)xemacs.org&gt; + + * xgccache.h (XE_GCONTEXT): Move out of DEBUG_XEMACS block. + + 2005-02-22 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.c (debug_xft): Suppress all debug output for now. + + 2005-02-21 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * emacs.c (xemacs-release-date): New version info variable. + * config.h.in (XEMACS_RELEASE_DATE): New config.h macro. + + * emacs.c (inhibit-early-packages): + (inhibit-all-packages): + (xemacs-extra-name): Improve docstrings. + + 2005-02-21 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_finalize_font_instance): Improve debug message. + + 2005-02-20 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_initialize_font_instance): Estimate average cell + width based on dimensions of "representative" string. Suppress + some excessive debug output. Get rid of spurious tests. + + 2005-02-11 Eric Knauel <eric(a)xemacs.org&gt; + + * xft-fonts.c: throw away old code that was wrapped inside + comments + + 2005-02-11 Eric Knauel <eric(a)xemacs.org&gt; + + * xft-fonts.h: New prototype + + * xft-fonts.c (Ffc_name_parse, Ffc_pattern_add, Ffc_pattern_del) + (Ffc_pattern_get, fc_font_real_pattern) + (string_list_to_fcobjectset): Use extract_fcapi_string() + (extract_fcapi_string): New function + + 2005-02-09 Eric Knauel <eric(a)xemacs.org&gt; + + * xft-fonts.c (string_list_to_fcobjectset): Use loop macro instead + of for. + + 2005-02-03 Eric Knauel <eric(a)xemacs.org&gt; + + * lrecord.h (enum lrecord_type): remove lrecord for FcObjectSets + + * xft-fonts.h (struct fc_fontset): remove lrecord for FcObjectSets + + * xft-fonts.c (DEFINE_LRECORD_IMPLEMENTATION): + (Ffc_objectset_create, Ffc_objectset_p, Ffc_objectset_add) + (Ffc_objectset_destroy): remove lrecord for FcObjectSets + (Ffc_list_fonts_pattern_objects): adapt for new representation of + FcObjectSets + (string_list_to_fcobjectset): New utility function + + 2005-02-01 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * redisplay-x.c (separate_textual_runs): Check for MULE properly. + + 2005-01-28 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * glyphs-widget.c (Fwidget_logical_to_character_height): + (Fwidget_logical_to_character_width): + (layout_query_geometry): + (widget_update): + Fix typos in docstrings and preceding comments. + + 2005-01-26 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * redisplay-x.c (x_output_string): Position strikethru by dl + geometry. Kludge to fix remnants from antialiased underscores. + + 2004-12-19 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * compiler.h (UNUSED): Document make-docfile.c hack. + + 2004-12-19 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * glyphs-x.c,objects-x.c: Deemphasize warnings (to debug or alert). + + * redisplay-x.c: Don't abort() when ichar_to_unicode returns error. + + 2004-12-19 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * keymap.c (Fwhere_is_internal): Rewrite docstring. + + 2004-12-17 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * regex.c (re_match_2_internal): DEBUG_PRINT "can match null". + + 2004-12-10 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * redisplay-x.c (x_text_width_single_run): Whitespace improvement. + + 2004-12-09 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * glyphs-widget.c (image_instantiator_progress_gauge): + (image_instantiator_format_create_glyphs_widget): + Fix typo guage->gauge. + + * emacs.c (main_1): Casting out devils (size_t). + + * compiler.h (USED_IF_XFT): New variant. + * objects-x.c (x_font_spec_matches_charset): + * redisplay-x.c (x_text_width_single_run): + Use it. + + * config.h.in: Support USE_XFT_TABS and USE_XFT_GAUGE. + + 2004-11-28 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * objects-x.c (x_initialize_font_instance): Make sure + FONT_INSTANCE_X_FONT is cleared for Xft fonts. Add comments. + Fiddle whitespace. + (x_print_font_instance): Clarify printed font instance. + + 2004-11-27 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + * xft-fonts.h: Declare debug_xft. + + * objects-x.c (x_font_instance_truename): + Convert Xft* identifiers to Fc* versions. + + (x_initialize_font_instance): + (x_find_charset_font): + Condition debugging on debug_xft. Get rid of unneeded "#### + debug" markers. Change fprintf to stderr_out. + + (x_find_charset_font): Restore missing argument to + DebugFcTypeOfValue. Remove nonworking debug cruft. + + (FcResultToString): + (FcTypeOfValueToString): + (x_find_charset_font): + Change DebugFc* to Fc*ToString. + + 2004-11-20 Stephen J. Turnbull <stephen(a)xemacs.org&gt; + + Xft branch based on "Xft reloaded #3" patch by Eric Knauel and + Mathias Neuebaur, and other contributors. + + * xft-fonts.h: New file. Declares new Lisp objects wrapping + FcPattern, FcFontSet, and FcObjectSet. + * xft-fonts.c: New file. Implements new Lisp objects wrapping + FcPattern, FcFontSet, and FcObjectSet. + * objects-x-impl.h: Declare XftFont component of font instance. + * objects-x.c: Implement XftFont component of font instance. + * redisplay-x.c: Implement drawing via Xft. + 2005-11-21 Marcus Crestani <crestani(a)xemacs.org&gt; Incremental Garbage Collector ＠＠ -2805,7 +3344,9 ＠＠ 2004-12-15 Stephen J. Turnbull <stephen(a)xemacs.org&gt; - * EmacsManager.c (EmacsManagerChangeSize): Respect XtGeometryNo. + * EmacsManager.c (EmacsManagerChangeSize): + Respect XtGeometryNo, and exit immediately if geometry change + refused. Fixes notorious metacity maximize bug. 2004-12-07 Malcolm Purvis <malcolmp(a)xemacs.org&gt; 1.123 +3 -0 XEmacs/xemacs/src/Makefile.in.in Index: Makefile.in.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Makefile.in.in,v retrieving revision 1.122 retrieving revision 1.123 diff -u -p -r1.122 -r1.123 --- Makefile.in.in 2005/11/25 01:41:55 1.122 +++ Makefile.in.in 2005/11/26 11:46:06 1.123 ＠＠ -133,6 +133,9 ＠＠ gui_objs += toolbar.o #ifdef HAVE_X_WINDOWS x_objs=console-x.o device-x.o event-Xt.o frame-x.o \ glyphs-x.o objects-x.o redisplay-x.o select-x.o xgccache.o intl-x.o +#ifdef USE_XFT +x_objs += xft-fonts.o +#endif x_gui_objs=$(gui_objs:.o=-x.o) #ifdef HAVE_TOOLBARS x_gui_objs += toolbar-common.o 1.11 +12 -0 XEmacs/xemacs/src/compiler.h Index: compiler.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/compiler.h,v retrieving revision 1.10 retrieving revision 1.11 diff -u -p -r1.10 -r1.11 --- compiler.h 2005/10/25 11:16:21 1.10 +++ compiler.h 2005/11/26 11:46:07 1.11 ＠＠ -211,6 +211,13 ＠＠ Boston, MA 02111-1307, USA. */ #endif /* ATTRIBUTE_CONST */ /* Unused declarations; g++ and icc do not support this. */ +/* + NOTE: These macros MUST be named UNUSED (exactly) or something + prefixed with USED_IF_, or DEFUN docstrings will be parsed incorrectly. + See comments in make_docfile.c (write_c_args). You'd think that this + wouldn't happen, but unfortunately we do indeed have some arguments + of DEFUNs unused for GNU compatibility or because features are missing. +*/ #ifndef UNUSED_ARG # define UNUSED_ARG(decl) unused_##decl #endif ＠＠ -230,6 +237,11 ＠＠ Boston, MA 02111-1307, USA. */ # define USED_IF_MULE_OR_CHECK_TEXT(decl) decl # else # define USED_IF_MULE_OR_CHECK_TEXT(decl) UNUSED (decl) +# endif +# ifdef USE_XFT +# define USED_IF_XFT(decl) decl +# else +# define USED_IF_XFT(decl) UNUSED (decl) # endif #endif /* UNUSED */ 1.104 +7 -0 XEmacs/xemacs/src/config.h.in Index: config.h.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v retrieving revision 1.103 retrieving revision 1.104 diff -u -p -r1.103 -r1.104 --- config.h.in 2005/11/25 01:41:56 1.103 +++ config.h.in 2005/11/26 11:46:07 1.104 ＠＠ -206,6 +206,13 ＠＠ things are arranged in config.h.in. In /* Compile in support for the X window system? */ #undef HAVE_X_WINDOWS +/* Compile with support for Xft? */ +#undef USE_XFT +/* Per-widget stuff will go away? */ +#undef USE_XFT_MENUBARS +#undef USE_XFT_TABS +#undef USE_XFT_GAUGE + /* Defines for building X applications */ #ifdef HAVE_X_WINDOWS /* The following will be defined if xmkmf thinks they are necessary */ 1.5 +15 -0 XEmacs/xemacs/src/console-x-impl.h Index: console-x-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x-impl.h,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- console-x-impl.h 2005/11/25 01:41:58 1.4 +++ console-x-impl.h 2005/11/26 11:46:07 1.5 ＠＠ -308,6 +308,17 ＠＠ struct x_frame #endif /* XIM_XLIB */ #endif /* HAVE_XIM */ +#ifdef USE_XFT + /* The Xft Drawable wrapper for this device. + #### Should this be per-device, or per-frame? */ + /* This is persistent to take advantage of the ability of Xft's glyph + cache in the server, and avoid rendering the font again and again... + + This is created the first time through redisplay, and destroyed when our + connection to the X display is destroyed. */ + XftDraw *xftDraw; +#endif + /* 1 if the frame is completely visible on the display, 0 otherwise. if 0 the frame may have been iconified or may be totally or partially hidden by another X window */ ＠＠ -366,6 +377,10 ＠＠ DECLARE_LRECORD (x_frame, Lisp_X_Frame); #endif /* HAVE_TOOLBARS */ #define FRAME_X_GEOM_FREE_ME_PLEASE(f) (FRAME_X_DATA (f)->geom_free_me_please) + +#ifdef USE_XFT +#define FRAME_X_XFTDRAW(f) (FRAME_X_DATA (f)->xftDraw) +#endif #define FRAME_X_TOTALLY_VISIBLE_P(f) (FRAME_X_DATA (f)->totally_visible_p) #define FRAME_X_TOP_LEVEL_FRAME_P(f) (FRAME_X_DATA (f)->top_level_frame_p) 1.22 +13 -0 XEmacs/xemacs/src/console-x.h Index: console-x.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x.h,v retrieving revision 1.21 retrieving revision 1.22 diff -u -p -r1.21 -r1.22 --- console-x.h 2005/01/17 10:10:18 1.21 +++ console-x.h 2005/11/26 11:46:07 1.22 ＠＠ -51,6 +51,19 ＠＠ Boston, MA 02111-1307, USA. */ #include <X11/xpm.h> #endif +#ifdef USE_XFT +/* shut up GCC */ +#define face_index face_index_arg +#define glyph_index glyph_index_arg +#include <X11/Xft/Xft.h> +#undef glyph_index +#undef face_index +/* #### this should be made gone */ +#ifndef XFT_VERSION +#define XFT_VERSION 1 +#endif +#endif + /* R5 defines the XPointer type, but R4 doesn't. R4 also doesn't define a version number, but R5 does. */ #if (XlibSpecificationRelease < 5) 1.162 +23 -1 XEmacs/xemacs/src/emacs.c Index: emacs.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v retrieving revision 1.161 retrieving revision 1.162 diff -u -p -r1.161 -r1.162 --- emacs.c 2005/11/25 01:42:00 1.161 +++ emacs.c 2005/11/26 11:46:07 1.162 ＠＠ -1021,7 +1021,10 ＠＠ main_1 (int argc, Wexttext **argv, Wextt if (argmatch (argv, argc, "-si", "--show-inline-info", 0, NULL, &skip_args)) { #if defined (PDUMP) && defined (DUMP_IN_EXEC) && !defined (WIN32_NATIVE) - printf ("%u %u\n", dumped_data_max_size (), dumped_data_align_offset ()); + /* #### We really should check for sizeof (size_t) > sizeof (long) */ + printf ("%lu %lu\n", (unsigned long) dumped_data_max_size (), + (unsigned long) dumped_data_align_offset ()); + #else printf ("Portable dumper not configured for dumping into executable or windows native; -si just forces exit.\n"); #endif ＠＠ -1612,6 +1615,11 ＠＠ main_1 (int argc, Wexttext **argv, Wextt syms_of_input_method_xlib (); #endif #endif /* HAVE_XIM */ + +#ifdef USE_XFT + syms_of_xft_fonts(); +#endif + #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_MS_WINDOWS ＠＠ -2192,6 +2200,11 ＠＠ main_1 (int argc, Wexttext **argv, Wextt #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_X_DIALOGS) || defined (HAVE_TOOLBARS) vars_of_gui_x (); #endif + +#ifdef USE_XFT + vars_of_xft_fonts (); +#endif + #endif /* HAVE_X_WINDOWS */ ＠＠ -2318,6 +2331,9 ＠＠ main_1 (int argc, Wexttext **argv, Wextt #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_X_DIALOGS) || defined (HAVE_TOOLBARS) reinit_vars_of_gui_x (); #endif +#ifdef USE_XFT + reinit_vars_of_xft_fonts (); +#endif #endif /* HAVE_X_WINDOWS */ #ifdef MULE ＠＠ -2384,6 +2400,12 ＠＠ main_1 (int argc, Wexttext **argv, Wextt just-previous complex-vars calls). We will in fact do conversion quite soon, e.g. in complex_vars_of_glyphs_x(). */ inhibit_non_essential_conversion_operations = 0; + +#ifdef USE_XFT + /* This uses coding systems. Must be done before faces are init'ed. */ + /* not in xft reloaded #3 */ + complex_vars_of_xft_fonts (); +#endif /* Depends on specifiers. */ complex_vars_of_faces (); 1.89 +1 -1 XEmacs/xemacs/src/event-Xt.c Index: event-Xt.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-Xt.c,v retrieving revision 1.88 retrieving revision 1.89 diff -u -p -r1.88 -r1.89 --- event-Xt.c 2005/11/16 07:22:46 1.88 +++ event-Xt.c 2005/11/26 11:46:07 1.89 ＠＠ -2986,7 +2986,7 ＠＠ Boolean EmacsXtCvtStringToPixel ( } else { status = XParseColor (dpy, colormap, (char*)str, &screenColor); if (status) { - status = allocate_nearest_color (dpy, colormap, visual, &screenColor); + status = x_allocate_nearest_color (dpy, colormap, visual, &screenColor); } } } else { 1.49 +69 -1 XEmacs/xemacs/src/faces.c Index: faces.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v retrieving revision 1.48 retrieving revision 1.49 diff -u -p -r1.48 -r1.49 --- faces.c 2005/10/24 10:07:36 1.48 +++ faces.c 2005/11/26 11:46:08 1.49 ＠＠ -1060,8 +1060,11 ＠＠ mark_face_cachels (face_cachel_dynarr *e } /* 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) ＠＠ -1411,6 +1414,7 ＠＠ merge_face_cachel_data (struct window *w } /* Initialize a cachel. */ +/* #### Xft: this function will need to be changed for new font model. */ void reset_face_cachel (struct face_cachel *cachel) ＠＠ -1492,6 +1496,7 ＠＠ mark_face_cachels_as_clean (struct windo 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) { ＠＠ -1686,6 +1691,43 ＠＠ get_extent_fragment_face_cache_index (st } } +/* Return a cache index for window W from merging the faces in FACE_LIST. + COUNT is the number of faces in the list. + + The default face should not be included in the list, as it is always + implicitly merged into the cachel. + + WARNING: this interface may change. */ + +face_index +merge_face_list_to_cache_index (struct window *w, + Lisp_Object *face_list, int count) +{ + int i; + face_index findex = 0; + struct face_cachel cachel; + + reset_face_cachel (&cachel); + + for (i = 0; i < count; i++) + { + Lisp_Object face = face_list[i]; + + if (!NILP (face)) + { + CHECK_FACE(face); /* #### presumably unnecessary */ + findex = get_builtin_face_cache_index (w, face); + merge_face_cachel_data (w, findex, &cachel); + } + } + + /* Now finally merge in the default face. */ + findex = get_builtin_face_cache_index (w, Vdefault_face); + merge_face_cachel_data (w, findex, &cachel); + + return get_merged_face_cache_index (w, &cachel); +} +  /***************************************************************************** interface functions ＠＠ -2006,9 +2048,24 ＠＠ complex_vars_of_faces (void) const Ascbyte *fonts[] = { +#ifdef USE_XFT + /************** Xft fonts *************/ + + /* 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? + 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 */ +#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-*", ＠＠ -2086,6 +2143,13 ＠＠ complex_vars_of_faces (void) 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. ＠＠ -2133,6 +2197,7 ＠＠ complex_vars_of_faces (void) "-*-*-*-*-*-*-*-120-*-*-*-*-*-*", "-*-*-*-*-*-*-*-*-*-*-*-*-*-*", "*" +#endif }; const Ascbyte **fontptr; ＠＠ -2212,6 +2277,8 ＠＠ complex_vars_of_faces (void) { Lisp_Object fg_fb = Qnil, bg_fb = Qnil; + /* #### gui-element face doesn't have a font property? + But it gets referred to later! */ #ifdef HAVE_GTK /* We need to put something in there, or error checking gets #%!＠#ed up before the styles are set, which override the ＠＠ -2283,6 +2350,7 ＠＠ complex_vars_of_faces (void) Vwidget_face = Fmake_face (Qwidget, build_msg_string ("widget face"), Qnil); + /* #### weird ... the gui-element face doesn't have its own font yet */ set_specifier_fallback (Fget (Vwidget_face, Qfont, Qunbound), Fget (Vgui_element_face, Qfont, Qunbound)); set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound), 1.16 +7 -1 XEmacs/xemacs/src/faces.h Index: faces.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.h,v retrieving revision 1.15 retrieving revision 1.16 diff -u -p -r1.15 -r1.16 --- faces.h 2005/11/25 01:42:02 1.15 +++ faces.h 2005/11/26 11:46:08 1.16 ＠＠ -164,7 +164,9 ＠＠ struct face_cachel 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; ＠＠ -263,6 +265,10 ＠＠ void reset_face_cachel (struct face_cach void reset_face_cachels (struct window *w); face_index get_builtin_face_cache_index (struct window *w, Lisp_Object face); +/* WARNING: this interface may change. */ +face_index merge_face_list_to_cache_index (struct window *w, + Lisp_Object *face_list, int count); + #ifdef MEMORY_USAGE_STATS int compute_face_cachel_usage (face_cachel_dynarr *face_cachels, struct overhead_stats *ovstats); 1.72 +33 -3 XEmacs/xemacs/src/frame-x.c Index: frame-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-x.c,v retrieving revision 1.71 retrieving revision 1.72 diff -u -p -r1.71 -r1.72 --- frame-x.c 2005/11/25 01:42:02 1.71 +++ frame-x.c 2005/11/26 11:46:08 1.72 ＠＠ -2625,6 +2625,19 ＠＠ x_delete_frame (struct frame *f) DtDndDropUnregister (FRAME_X_TEXT_WIDGET (f)); #endif /* HAVE_CDE */ +#ifdef USE_XFT + /* If we have an XftDraw structure, we need to free it here. + We can't ever have an XftDraw without a Display, so we are safe + to free it in here, and we avoid too much playing around with the + malloc checking hooks this way. */ + if (FRAME_X_XFTDRAW (f)) + { + XftDrawDestroy (FRAME_X_XFTDRAW (f)); + FRAME_X_XFTDRAW (f) = NULL; + } +#endif + + assert (FRAME_X_SHELL_WIDGET (f) != 0); dpy = XtDisplay (FRAME_X_SHELL_WIDGET (f)); ＠＠ -2702,11 +2715,28 ＠＠ x_update_frame_external_traits (struct f { Lisp_Object font = FACE_FONT (Vdefault_face, frame, Vcharset_ascii); + /* #### what to do about Xft? I don't think the font is actually used + to compute cell size for computing frame pixel dimensions (see call + to EmacsFrameRecomputeCellSize() below); where is it used? -- sjt + What does XtSetValues() do if that resource isn't present? */ if (!EQ (font, Vthe_null_font_instance)) { - XtSetArg (al[ac], XtNfont, - (void *) FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font))); - ac++; + if (0) + ; +#ifdef USE_XFT + else if (FONT_INSTANCE_X_XFTFONT (XFONT_INSTANCE (font))) + { + XtSetArg (al[ac], XtNxftFont, + (void *) FONT_INSTANCE_X_XFTFONT (XFONT_INSTANCE (font))); + ac++; + } +#endif + else if (FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font))) + { + XtSetArg (al[ac], XtNfont, + (void *) FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font))); + ac++; + } } } else 1.27 +1 -0 XEmacs/xemacs/src/glyphs-eimage.c Index: glyphs-eimage.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-eimage.c,v retrieving revision 1.26 retrieving revision 1.27 diff -u -p -r1.26 -r1.27 --- glyphs-eimage.c 2005/09/27 05:48:25 1.26 +++ glyphs-eimage.c 2005/11/26 11:46:08 1.27 ＠＠ -36,6 +36,7 ＠＠ Boston, MA 02111-1307, USA. */ TIFF code by Jareth Hein for 21.0 TODO: Convert images.el to C and stick it in here? + This file is really repetitious; can we refactor? */ #include <config.h> 1.18 +7 -7 XEmacs/xemacs/src/glyphs-widget.c Index: glyphs-widget.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-widget.c,v retrieving revision 1.17 retrieving revision 1.18 diff -u -p -r1.17 -r1.18 --- glyphs-widget.c 2004/11/04 23:06:33 1.17 +++ glyphs-widget.c 2005/11/26 11:46:08 1.18 ＠＠ -346,7 +346,7 ＠＠ widget_property (Lisp_Object image_insta #### property is still a valid function since we have to be able to extract information from the actual widget. - #### update_widget should probably be re-written to use the + #### widget_update should probably be re-written to use the instantiator. We probably want to keep a record of the differences also to make this easy. We would also need a pending_instantiator so that changes could be delayed. */ ＠＠ -1296,7 +1296,7 ＠＠ layout_post_instantiate (Lisp_Object UNU allow users to stack widgets vertically or horizontally. These layouts also allow the widgets to be centered (space evenly distributed), left or right justified (fixed spacing widgets - stacked against the left, righ, top or bottom edge). Unfortunately + stacked against the left, right, top or bottom edge). Unfortunately this doesn't allow widgets in different layouts to be aligned. For instance how should the search dialog be organized for alignment? The obvious choice of two vertical columns does not work since the ＠＠ -1642,8 +1642,8 ＠＠ native_layout_layout (Lisp_Object image_ DEFUN ("widget-logical-to-character-width", Fwidget_logical_to_character_width, 1, 3, 0, /* Convert the width in logical widget units to characters. -Logical widget units do not take into account adjusments made for -layout borders, so this adjusment is approximated. +Logical widget units do not take into account adjustments made for +layout borders, so this adjustment is approximated. */ (width, UNUSED (face), domain)) { ＠＠ -1668,7 +1668,7 ＠＠ layout borders, so this adjusment is app DEFUN ("widget-logical-to-character-height", Fwidget_logical_to_character_height, 1, 3, 0, /* Convert the height in logical widget units to characters. -Logical widget units do not take into account adjusments made for +Logical widget units do not take into account adjustments made for layout borders, so this adjustment is approximated. If the components of a widget layout are justified to the top or the ＠＠ -1819,7 +1819,7 ＠＠ static void image_instantiator_scrollbar IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face); } -static void image_instantiator_progress_guage (void) +static void image_instantiator_progress_gauge (void) { INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (progress_gauge, "progress-gauge"); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, validate, widget); ＠＠ -1927,7 +1927,7 ＠＠ image_instantiator_format_create_glyphs_ image_instantiator_edit_fields(); image_instantiator_combo_box(); image_instantiator_scrollbar(); - image_instantiator_progress_guage(); + image_instantiator_progress_gauge(); image_instantiator_tree_view(); image_instantiator_tab_control(); image_instantiator_labels(); 1.84 +34 -14 XEmacs/xemacs/src/glyphs-x.c Index: glyphs-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-x.c,v retrieving revision 1.83 retrieving revision 1.84 diff -u -p -r1.83 -r1.84 --- glyphs-x.c 2005/09/27 05:48:26 1.83 +++ glyphs-x.c 2005/11/26 11:46:08 1.84 ＠＠ -239,7 +239,7 ＠＠ convert_EImage_to_XImage (Lisp_Object de color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0; color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0; color.flags = DoRed | DoGreen | DoBlue; - res = allocate_nearest_color (dpy, cmap, vis, &color); + res = x_allocate_nearest_color (dpy, cmap, vis, &color); if (res > 0 && res < 3) { DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long); ＠＠ -2364,21 +2364,41 ＠＠ update_widget_face (widget_value* wv, Li bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)); lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel); + { + Lisp_Object face = IMAGE_INSTANCE_WIDGET_FACE (ii); + Lisp_Font_Instance *fi = + XFONT_INSTANCE (query_string_font (IMAGE_INSTANCE_WIDGET_TEXT (ii), + face, + domain)); + XFontStruct *fs = FONT_INSTANCE_X_FONT (fi); +#ifdef USE_XFT + XftFont *rf = FONT_INSTANCE_X_XFTFONT (fi); + + if (rf) + { + /* #### What to do about Motif? */ + lw_add_widget_value_arg (wv, XtNxftFont, (XtArgVal) rf); + } +#endif + + if (fs) + { #ifdef LWLIB_WIDGETS_MOTIF - fontList = XmFontListCreate - (FONT_INSTANCE_X_FONT - (XFONT_INSTANCE (query_string_font - (IMAGE_INSTANCE_WIDGET_TEXT (ii), - IMAGE_INSTANCE_WIDGET_FACE (ii), - domain))), XmSTRING_DEFAULT_CHARSET); - lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList); + fontList = XmFontListCreate (fs, XmSTRING_DEFAULT_CHARSET); + lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal) fontList); #endif - lw_add_widget_value_arg - (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT - (XFONT_INSTANCE (query_string_font - (IMAGE_INSTANCE_WIDGET_TEXT (ii), - IMAGE_INSTANCE_WIDGET_FACE (ii), - domain)))); + lw_add_widget_value_arg (wv, XtNfont, (XtArgVal) fs); + } + +#ifdef USE_XFT + /* #### sanity check, should wrap in appropriate ERROR_CHECK macro */ + if (!rf && !fs) + warn_when_safe_lispobj + (intern ("xft"), Qdebug, + Fcons (build_string ("missing font in update_widget_face"), + Fface_name (face))); +#endif + } wv->change = VISIBLE_CHANGE; /* #### Megahack - but its just getting too complicated to do this in the right place. */ 1.22 +3 -0 XEmacs/xemacs/src/inline.c Index: inline.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/inline.c,v retrieving revision 1.21 retrieving revision 1.22 diff -u -p -r1.21 -r1.22 --- inline.c 2005/11/07 08:49:25 1.21 +++ inline.c 2005/11/26 11:46:09 1.22 ＠＠ -100,6 +100,9 ＠＠ Boston, MA 02111-1307, USA. */ #ifdef HAVE_X_WINDOWS #include "glyphs-x.h" +#ifdef USE_XFT +#include "xft-fonts.h" +#endif #endif #ifdef HAVE_MS_WINDOWS 1.136 +1 -0 XEmacs/xemacs/src/lisp.h Index: lisp.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.135 retrieving revision 1.136 diff -u -p -r1.135 -r1.136 --- lisp.h 2005/11/25 01:42:04 1.135 +++ lisp.h 2005/11/26 11:46:09 1.136 ＠＠ -5415,6 +5415,7 ＠＠ extern Lisp_Object Vcharset_katakana_jis 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.45 +1 -0 XEmacs/xemacs/src/lrecord.h Index: lrecord.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v retrieving revision 1.44 retrieving revision 1.45 diff -u -p -r1.44 -r1.45 --- lrecord.h 2005/11/25 01:42:05 1.44 +++ lrecord.h 2005/11/26 11:46:09 1.45 ＠＠ -281,6 +281,7 ＠＠ enum lrecord_type lrecord_type_image_instance, lrecord_type_glyph, lrecord_type_face, + lrecord_type_fc_pattern, lrecord_type_database, lrecord_type_tooltalk_message, lrecord_type_tooltalk_pattern, 1.6 +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.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- objects-impl.h 2005/10/24 10:07:39 1.5 +++ objects-impl.h 2005/11/26 11:46:09 1.6 ＠＠ -125,8 +125,13 ＠＠ struct Lisp_Font_Instance 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 ＠＠ struct Lisp_Font_Instance }; #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 ＠＠ struct Lisp_Font_Instance #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.2 +23 -1 XEmacs/xemacs/src/objects-x-impl.h Index: objects-x-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x-impl.h,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- objects-x-impl.h 2002/06/20 21:18:40 1.1 +++ objects-x-impl.h 2005/11/26 11:46:09 1.2 ＠＠ -29,6 +29,10 ＠＠ Boston, MA 02111-1307, USA. */ #include "objects-impl.h" #include "objects-x.h" +#ifdef USE_XFT +/* for resource name definitions, etc */ +#include "../lwlib/lwlib-fonts.h" +#endif #ifdef HAVE_X_WINDOWS ＠＠ -39,11 +43,19 ＠＠ Boston, MA 02111-1307, USA. */ struct x_color_instance_data { XColor color; + /* Yes, it looks crazy to have both the XColor and the XftColor, but + pragmatically both are used. */ +#ifdef USE_XFT + XftColor xftColor; +#endif char dealloc_on_gc; }; #define X_COLOR_INSTANCE_DATA(c) ((struct x_color_instance_data *) (c)->data) #define COLOR_INSTANCE_X_COLOR(c) (X_COLOR_INSTANCE_DATA (c)->color) +#ifdef USE_XFT +#define COLOR_INSTANCE_X_XFTCOLOR(c) (X_COLOR_INSTANCE_DATA (c)->xftColor) +#endif #define COLOR_INSTANCE_X_DEALLOC(c) (X_COLOR_INSTANCE_DATA (c)->dealloc_on_gc) /***************************************************************************** ＠＠ -53,11 +65,21 ＠＠ struct x_color_instance_data struct x_font_instance_data { /* X-specific information */ - XFontStruct *font; + /* Yes, it looks crazy to have both the XFontStruct and the XftFont, but + pragmatically both are used (lwlib delegates labels to the widget sets, + which internally use XFontStructs). */ + XFontStruct * font; +#ifdef USE_XFT + XftFont *xftFont; +#endif + }; #define X_FONT_INSTANCE_DATA(f) ((struct x_font_instance_data *) (f)->data) #define FONT_INSTANCE_X_FONT(f) (X_FONT_INSTANCE_DATA (f)->font) +#ifdef USE_XFT +#define FONT_INSTANCE_X_XFTFONT(f) (X_FONT_INSTANCE_DATA (f)->xftFont) +#endif #endif /* HAVE_X_WINDOWS */ 1.29 +756 -269 XEmacs/xemacs/src/objects-x.c Index: objects-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v retrieving revision 1.28 retrieving revision 1.29 diff -u -p -r1.28 -r1.29 --- objects-x.c 2005/01/28 02:58:52 1.28 +++ objects-x.c 2005/11/26 11:46:09 1.29 ＠＠ -38,6 +38,10 ＠＠ Boston, MA 02111-1307, USA. */ #include "console-x-impl.h" #include "objects-x-impl.h" +#ifdef USE_XFT +#include "xft-fonts.h" +#endif + int x_handle_non_fully_specified_fonts;  ＠＠ -45,185 +49,6 ＠＠ int x_handle_non_fully_specified_fonts; /* color instances */ /************************************************************************/ -/* Replacement for XAllocColor() that tries to return the nearest - available color if the colormap is full. Original was from FSFmacs, - but rewritten by Jareth Hein <jareth(a)camelot-soft.com&gt; 97/11/25 - Modified by Lee Kindness <lkindness(a)csl.co.uk&gt; 31/08/99 to handle previous - total failure which was due to a read/write colorcell being the nearest - match - tries the next nearest... - - Return value is 1 for normal success, 2 for nearest color success, - 3 for Non-deallocable success. */ -int -allocate_nearest_color (Display *display, Colormap colormap, Visual *visual, - XColor *color_def) -{ - int status; - - if (visual->X_CLASSFIELD == DirectColor || visual->X_CLASSFIELD == TrueColor) - { - if (XAllocColor (display, colormap, color_def) != 0) - { - status = 1; - } - else - { - /* We're dealing with a TrueColor/DirectColor visual, so play games - with the RGB values in the XColor struct. */ - /* #### JH: I'm not sure how a call to XAllocColor can fail in a - TrueColor or DirectColor visual, so I will just reformat the - request to match the requirements of the visual, and re-issue - the request. If this fails for anybody, I wanna know about it - so I can come up with a better plan */ - - unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk; - junk = visual->red_mask; - rshift = 0; - while ((junk & 0x1) == 0) { - junk = junk >> 1; - rshift ++; - } - rbits = 0; - while (junk != 0) { - junk = junk >> 1; - rbits++; - } - junk = visual->green_mask; - gshift = 0; - while ((junk & 0x1) == 0) { - junk = junk >> 1; - gshift ++; - } - gbits = 0; - while (junk != 0) { - junk = junk >> 1; - gbits++; - } - junk = visual->blue_mask; - bshift = 0; - while ((junk & 0x1) == 0) { - junk = junk >> 1; - bshift ++; - } - bbits = 0; - while (junk != 0) { - junk = junk >> 1; - bbits++; - } - - color_def->red = color_def->red >> (16 - rbits); - color_def->green = color_def->green >> (16 - gbits); - color_def->blue = color_def->blue >> (16 - bbits); - if (XAllocColor (display, colormap, color_def) != 0) - status = 1; - else - { - int rd, gr, bl; - /* #### JH: I'm punting here, knowing that doing this will at - least draw the color correctly. However, unless we convert - all of the functions that allocate colors (graphics - libraries, etc) to use this function doing this is very - likely to cause problems later... */ - - if (rbits > 8) - rd = color_def->red << (rbits - 8); - else - rd = color_def->red >> (8 - rbits); - if (gbits > 8) - gr = color_def->green << (gbits - 8); - else - gr = color_def->green >> (8 - gbits); - if (bbits > 8) - bl = color_def->blue << (bbits - 8); - else - bl = color_def->blue >> (8 - bbits); - color_def->pixel = (rd << rshift) | (gr << gshift) | (bl << - bshift); - status = 3; - } - } - } - else - { - XColor *cells = NULL; - /* JH: I can't believe there's no way to go backwards from a - colormap ID and get its visual and number of entries, but X - apparently isn't built that way... */ - int no_cells = visual->map_entries; - status = 0; - - if (XAllocColor (display, colormap, color_def) != 0) - status = 1; - else while( status != 2 ) - { - /* If we got to this point, the colormap is full, so we're - going to try and get the next closest color. The algorithm used - is a least-squares matching, which is what X uses for closest - color matching with StaticColor visuals. */ - int nearest; - long nearest_delta, trial_delta; - int x; - - if( cells == NULL ) - { - cells = alloca_array (XColor, no_cells); - for (x = 0; x < no_cells; x++) - cells[x].pixel = x; - - /* read the current colormap */ - XQueryColors (display, colormap, cells, no_cells); - } - - nearest = 0; - /* I'm assuming CSE so I'm not going to condense this. */ - nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8)) - * ((color_def->red >> 8) - (cells[0].red >> 8))) - + - (((color_def->green >> 8) - (cells[0].green >> 8)) - * ((color_def->green >> 8) - (cells[0].green >> - 8))) - + - (((color_def->blue >> 8) - (cells[0].blue >> 8)) - * ((color_def->blue >> 8) - (cells[0].blue >> - 8)))); - for (x = 1; x < no_cells; x++) - { - trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8)) - * ((color_def->red >> 8) - (cells[x].red >> 8))) - + - (((color_def->green >> 8) - (cells[x].green >> 8)) - * ((color_def->green >> 8) - (cells[x].green >> - 8))) - + - (((color_def->blue >> 8) - (cells[x].blue >> 8)) - * ((color_def->blue >> 8) - (cells[x].blue >> - 8)))); - - /* less? Ignore cells marked as previously failing */ - if( (trial_delta < nearest_delta) && - (cells[x].pixel != ULONG_MAX) ) - { - nearest = x; - nearest_delta = trial_delta; - } - } - color_def->red = cells[nearest].red; - color_def->green = cells[nearest].green; - color_def->blue = cells[nearest].blue; - if (XAllocColor (display, colormap, color_def) != 0) - status = 2; - else - /* LSK: Either the colour map has changed since - * we read it, or the colour is allocated - * read/write... Mark this cmap entry so it's - * ignored in the next iteration. - */ - cells[nearest].pixel = ULONG_MAX; - } - } - return status; -} - static int x_parse_nearest_color (struct device *d, XColor *color, Lisp_Object name, Error_Behavior errb) ＠＠ -246,7 +71,7 ＠＠ x_parse_nearest_color (struct device *d, name, Qcolor, errb); return 0; } - result = allocate_nearest_color (dpy, cmap, visual, color); + result = x_allocate_nearest_color (dpy, cmap, visual, color); if (!result) { maybe_signal_error (Qgui_error, "Couldn't allocate color", ＠＠ -262,6 +87,9 ＠＠ x_initialize_color_instance (Lisp_Color_ Lisp_Object device, Error_Behavior errb) { XColor color; +#ifdef USE_XFT + XftColor xftColor; +#endif int result; result = x_parse_nearest_color (XDEVICE (device), &color, name, errb); ＠＠ -277,6 +105,17 ＠＠ x_initialize_color_instance (Lisp_Color_ else COLOR_INSTANCE_X_DEALLOC (c) = 1; COLOR_INSTANCE_X_COLOR (c) = color; + +#ifdef USE_XFT + xftColor.pixel = color.pixel; + xftColor.color.red = color.red; + xftColor.color.green = color.green; + xftColor.color.blue = color.blue; + xftColor.color.alpha = 0xffff; + + COLOR_INSTANCE_X_XFTCOLOR (c) = xftColor; +#endif + return 1; } ＠＠ -366,96 +205,248 ＠＠ x_color_list (void) /* font instances */ /************************************************************************/ +#ifdef USE_XFT +/* #### all these #defines should probably move to xft-fonts.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); \ + FcChar8 *name = FcNameUnparse (pattern); \ + \ + eicpy_ext(eistrpxft_name, name, Qxft_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, Qxft_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) { Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - XFontStruct *xf; - const Extbyte *extname; + Extbyte *extname; + XFontStruct *fs = NULL; /* _F_ont _S_truct */ +#ifdef USE_XFT + XftFont *rf = NULL; /* _R_ender _F_ont (X Render extension) */ +#else +#define rf (0) +#endif +#ifdef USE_XFT + DEBUG_XFT1 (2, "attempting to initialize font spec %s\n", + XSTRING_DATA(f->name)); + /* #### serialize (optimize) these later... */ + /* #### This function really needs to go away. + The problem is that the fontconfig/Xft functions work much too hard + to ensure that something is returned; but that something need not be + at all close to what we asked for. */ + LISP_STRING_TO_EXTERNAL (f->name, extname, Qxft_font_name_encoding); + rf = xft_open_font_by_name (dpy, extname); +#endif LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding); - xf = XLoadQueryFont (dpy, extname); - - if (!xf) + fs = XLoadQueryFont (dpy, extname); + + if (!fs && !rf) { - maybe_signal_error (Qgui_error, "Couldn't load font", f->name, Qfont, - errb); + /* #### should this refer to X and/or Xft? */ + maybe_signal_error (Qgui_error, "Couldn't load font", f->name, + Qfont, errb); return 0; } - if (!xf->max_bounds.width) + if (fs && !fs->max_bounds.width) { /* yes, this has been known to happen. */ - XFreeFont (dpy, xf); + XFreeFont (dpy, fs); + fs = NULL; maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont, errb); - return 0; + if (!rf) + return 0; } - /* Don't allocate the data until we're sure that we will succeed, - or the finalize method may get fucked. */ + /* Now that we're sure that we will succeed, we can allocate data without + fear that the finalize method may get fucked. */ f->data = xnew (struct x_font_instance_data); - FONT_INSTANCE_X_FONT (f) = xf; - f->ascent = xf->ascent; - f->descent = xf->descent; - f->height = xf->ascent + xf->descent; - { - /* following change suggested by Ted Phelps <phelps(a)dstc.edu.au&gt; */ - int def_char = 'n'; /*xf->default_char;*/ - int byte1, byte2; - - once_more: - byte1 = def_char >> 8; - byte2 = def_char & 0xFF; + +#ifdef USE_XFT + FONT_INSTANCE_X_XFTFONT (f) = rf; + if (rf) + /* Have an Xft font, initialize font info from it. */ + { + DEBUG_XFT4 (2, "pre-initial ascent %d descent %d width %d height %d\n", + f->ascent, f->descent, f->width, f->height); - if (xf->per_char) + /* #### This shit is just plain wrong unless we have a character cell + font. It really hoses us on large repertoire Unicode fonts with + "double-width" characters. */ + f->ascent = rf->ascent; + f->descent = rf->descent; { - /* Old versions of the R5 font server have garbage (>63k) as - def_char. 'n' might not be a valid character. */ - if (byte1 < (int) xf->min_byte1 || - byte1 > (int) xf->max_byte1 || - byte2 < (int) xf->min_char_or_byte2 || - byte2 > (int) xf->max_char_or_byte2) - f->width = 0; - else - f->width = xf->per_char[(byte1 - xf->min_byte1) * - (xf->max_char_or_byte2 - - xf->min_char_or_byte2 + 1) + - (byte2 - xf->min_char_or_byte2)].width; + /* This is an approximation that AFAIK only gets used to compute + cell size for estimating window dimensions. The test_string8 + is an ASCII string whose characters should approximate the + distribution of widths expected in real text. */ + static const char test_string8[] = "Mmneei"; + static const int len = sizeof (test_string8) - 1; + XGlyphInfo glyphinfo; + + XftTextExtents8 (dpy, rf, test_string8, len, &glyphinfo); + /* #### maybe should be glyphinfo.xOff - glyphinfo.x? */ + f->width = (2*glyphinfo.width + len)/(2*len); } - else - f->width = xf->max_bounds.width; + f->height = rf->height; + f->proportional_p = 1; /* we can't recognize monospaced fonts! */ + + DEBUG_XFT4 (0, "initialized metrics ascent %d descent %d width %d height %d\n", + f->ascent, f->descent, f->width, f->height); + /* we also output on initialization of any font below */ + DEBUG_XFT1 (2, "initialized Xft font %s\n", XSTRING_DATA(f->name)); + fs = NULL; /* we don' need no steenkin' X font */ + } + else + { + DEBUG_XFT1 (0, "couldn't initialize Xft font %s\n", + XSTRING_DATA(f->name)); + } +#endif - /* Some fonts have a default char whose width is 0. This is no good. - If that's the case, first try 'n' as the default char, and if n has - 0 width too (unlikely) then just use the max width. */ - if (f->width == 0) + FONT_INSTANCE_X_FONT (f) = fs; + if (fs) + /* Have to use a core font, initialize font info from it. */ + { + f->ascent = fs->ascent; + f->descent = fs->descent; + f->height = fs->ascent + fs->descent; { - if (def_char == (int) xf->default_char) - f->width = xf->max_bounds.width; + /* following change suggested by Ted Phelps <phelps(a)dstc.edu.au&gt; */ + int def_char = 'n'; /*fs->default_char;*/ + int byte1, byte2; + + once_more: + byte1 = def_char >> 8; + byte2 = def_char & 0xFF; + + if (fs->per_char) + { + /* Old versions of the R5 font server have garbage (>63k) as + def_char. 'n' might not be a valid character. */ + if (byte1 < (int) fs->min_byte1 || + byte1 > (int) fs->max_byte1 || + byte2 < (int) fs->min_char_or_byte2 || + byte2 > (int) fs->max_char_or_byte2) + f->width = 0; + else + f->width = fs->per_char[(byte1 - fs->min_byte1) * + (fs->max_char_or_byte2 - + fs->min_char_or_byte2 + 1) + + (byte2 - fs->min_char_or_byte2)].width; + } else + f->width = fs->max_bounds.width; + + /* Some fonts have a default char whose width is 0. This is no good. + If that's the case, first try 'n' as the default char, and if n has + 0 width too (unlikely) then just use the max width. */ + if (f->width == 0) { - def_char = xf->default_char; - goto once_more; + if (def_char == (int) fs->default_char) + f->width = fs->max_bounds.width; + else + { + def_char = fs->default_char; + goto once_more; + } } } - } - /* If all characters don't exist then there could potentially be - 0-width characters lurking out there. Not setting this flag - trips an optimization that would make them appear to have width - to redisplay. This is bad. So we set it if not all characters - have the same width or if not all characters are defined. - */ - /* #### This sucks. There is a measurable performance increase - when using proportional width fonts if this flag is not set. - Unfortunately so many of the fucking X fonts are not fully - defined that we could almost just get rid of this damn flag and - make it an assertion. */ - f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width || - (x_handle_non_fully_specified_fonts && - !xf->all_chars_exist)); + /* If all characters don't exist then there could potentially be + 0-width characters lurking out there. Not setting this flag + trips an optimization that would make them appear to have width + to redisplay. This is bad. So we set it if not all characters + have the same width or if not all characters are defined. */ + /* #### This sucks. There is a measurable performance increase + when using proportional width fonts if this flag is not set. + Unfortunately so many of the fucking X fonts are not fully + defined that we could almost just get rid of this damn flag and + make it an assertion. */ + f->proportional_p = (fs->min_bounds.width != fs->max_bounds.width || + (x_handle_non_fully_specified_fonts && + !fs->all_chars_exist)); + } + +#ifdef USE_XFT + if (debug_xft > 0) + { + int n = 3, d = 5; + /* check for weirdness */ + if (n * f->height < d * f->width) + stderr_out ("font %s: width:height is %d:%d, larger than %d:%d\n", + XSTRING_DATA(f->name), f->width, f->height, n, d); + if (f->height <= 0 || f->width <= 0) + stderr_out ("bogus dimensions of font %s: width = %d, height = %d\n", + XSTRING_DATA(f->name), f->width, f->height); + stderr_out ("initialized font %s\n", XSTRING_DATA(f->name)); + } +#else +#undef rf +#endif + return 1; } ＠＠ -464,21 +455,39 ＠＠ x_print_font_instance (Lisp_Font_Instanc Lisp_Object printcharfun, int UNUSED (escapeflag)) { - write_fmt_string (printcharfun, " 0x%lx", - (unsigned long) FONT_INSTANCE_X_FONT (f)->fid); + if (FONT_INSTANCE_X_FONT (f)) + 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)) + write_fmt_string (printcharfun, " xft font: 0x%lx", + (unsigned long) FONT_INSTANCE_X_XFTFONT (f)); +#endif } static void x_finalize_font_instance (Lisp_Font_Instance *f) { +#ifdef USE_XFT + DEBUG_XFT1 (0, "finalizing %s\n", (STRINGP (f->name) + ? (char *) XSTRING_DATA (f->name) + : "(unnamed font)")); +#endif + if (f->data) { if (DEVICE_LIVE_P (XDEVICE (f->device))) { Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device)); - XFreeFont (dpy, FONT_INSTANCE_X_FONT (f)); + if (FONT_INSTANCE_X_FONT (f)) + XFreeFont (dpy, FONT_INSTANCE_X_FONT (f)); +#ifdef USE_XFT + if (FONT_INSTANCE_X_XFTFONT (f)) + XftFontClose (dpy, FONT_INSTANCE_X_XFTFONT (f)); +#endif } xfree (f->data, void *); f->data = 0; ＠＠ -487,6 +496,13 ＠＠ x_finalize_font_instance (Lisp_Font_Inst /* Determining the truename of a font is hard. (Big surprise.) + This is not true for fontconfig. Each font has a (nearly) canonical + representation up to permutation of the order of properties. It is + possible to construct a name which exactly identifies the properties of + the current font. However, it is theoretically possible that there exists + another font with a super set of those properties that would happen to get + selected. -- sjt + By "truename" we mean an XLFD-form name which contains no wildcards, yet which resolves to *exactly* the same font as the one which we already have the (probably wildcarded) name and `XFontStruct' of. ＠＠ -695,10 +711,12 ＠＠ truename_via_XListFonts (Display *dpy, E #else /* But the world I live in is much more perverse. */ names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count); + /* Find the lexicographic minimum of names[]. + (#### Should we be comparing case-insensitively?) */ while (count--) - /* !!#### Not Mule-friendly */ - /* If names[count] is lexicographically less than result, use it. - (#### Should we be comparing case-insensitively?) */ + /* [[ !!#### Not Mule-friendly ]] + Doesn't matter, XLFDs are HPC (old) or Latin1 (modern). If they + aren't, who knows what they are? -- sjt */ if (result == 0 || (strcmp (result, names [count]) < 0)) result = names [count]; #endif ＠＠ -773,29 +791,61 ＠＠ static Lisp_Object x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb) { struct device *d = XDEVICE (f->device); + Display *dpy = DEVICE_X_DISPLAY (d); + Extbyte *nameext; + char* xlfd; - if (NILP (FONT_INSTANCE_TRUENAME (f))) + /* #### restructure this so that we return a valid truename at the end, + and otherwise only return when we return something desperate that + doesn't get stored for future use. */ + +#ifdef USE_XFT + /* First, try an Xft font. */ + if (NILP (FONT_INSTANCE_TRUENAME (f)) && FONT_INSTANCE_X_XFTFONT (f)) { - Display *dpy = DEVICE_X_DISPLAY (d); - { - Extbyte *nameext; - - LISP_STRING_TO_EXTERNAL (f->name, nameext, Qx_font_name_encoding); - FONT_INSTANCE_TRUENAME (f) = - x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f)); - } - if (NILP (FONT_INSTANCE_TRUENAME (f))) + /* The font is already open, we just unparse. */ + FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern); + if (res) { - Lisp_Object font_instance = wrap_font_instance (f); + FONT_INSTANCE_TRUENAME (f) = make_string (res, strlen (res)); + free (res); + return FONT_INSTANCE_TRUENAME (f); + } + else + { + maybe_signal_error (Qgui_error, + "Couldn't unparse Xft font to truename", + Qnil, Qfont, errb); + /* used to return Qnil here */ + } + } +#endif /* USE_XFT */ + /* OK, fall back to core font. */ + if (NILP (FONT_INSTANCE_TRUENAME (f)) + && FONT_INSTANCE_X_FONT (f)) + { + nameext = &xlfd[0]; + LISP_STRING_TO_EXTERNAL (f->name, nameext, Qx_font_name_encoding); - maybe_signal_error (Qgui_error, "Couldn't determine font truename", - font_instance, Qfont, errb); - /* Ok, just this once, return the font name as the truename. - (This is only used by Fequal() right now.) */ - return f->name; - } + FONT_INSTANCE_TRUENAME (f) = + x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f)); } + + if (NILP (FONT_INSTANCE_TRUENAME (f))) + { + /* Urk, no luck. Whine about our bad luck and exit. */ + Lisp_Object font_instance = wrap_font_instance (f); + + + maybe_signal_error (Qgui_error, "Couldn't determine font truename", + font_instance, Qfont, errb); + /* Ok, just this once, return the font name as the truename. + (This is only used by Fequal() right now.) */ + return f->name; + } + + /* Return what we found. */ return FONT_INSTANCE_TRUENAME (f); } ＠＠ -806,8 +856,13 ＠＠ x_font_instance_properties (Lisp_Font_In int i; Lisp_Object result = Qnil; Display *dpy = DEVICE_X_DISPLAY (d); - XFontProp *props = FONT_INSTANCE_X_FONT (f)->properties; + XFontProp *props = NULL; + + /* #### really should hack Xft fonts, too + Strategy: fontconfig must have an iterator for this purpose. */ + if (! FONT_INSTANCE_X_FONT (f)) return result; + props = FONT_INSTANCE_X_FONT (f)->properties; for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--) { Lisp_Object name, value; ＠＠ -887,13 +942,31 ＠＠ x_font_list (Lisp_Object pattern, Lisp_O #ifdef MULE static int -x_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset, +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; ＠＠ -901,6 +974,12 ＠＠ x_font_spec_matches_charset (struct devi 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)) { ＠＠ -939,6 +1018,151 ＠＠ x_font_spec_matches_charset (struct devi ERROR_ME, 0) >= 0); } +#ifdef USE_XFT +/* #### debug functions: find a better place for us */ +const char *FcResultToString (FcResult r); +const char * +FcResultToString (FcResult r) +{ + static char buffer[256]; + switch (r) + { + case FcResultMatch: + return "FcResultMatch"; + case FcResultNoMatch: + return "FcResultNoMatch"; + case FcResultTypeMismatch: + return "FcResultTypeMismatch"; + case FcResultNoId: + return "FcResultNoId"; + default: + snprintf (buffer, 255, "FcResultUndocumentedValue (%d)", r); + return buffer; + } +} + +const char *FcTypeOfValueToString (FcValue v); +const char * +FcTypeOfValueToString (FcValue v) +{ + static char buffer[256]; + switch (v.type) + { + case FcTypeMatrix: + return "FcTypeMatrix"; + case FcTypeString: + return "FcTypeString"; + case FcTypeVoid: + return "FcTypeVoid"; + case FcTypeDouble: + return "FcTypeDouble"; + case FcTypeInteger: + return "FcTypeInteger"; + case FcTypeBool: + return "FcTypeBool"; + case FcTypeCharSet: + return "FcTypeCharSet"; + case FcTypeLangSet: + return "FcTypeLangSet"; + /* #### There is no union member of this type, but there are void* and + FcPattern* members, as of fontconfig.h FC_VERSION 10002 */ + case FcTypeFTFace: + return "FcTypeFTFace"; + default: + snprintf (buffer, 255, "FcTypeUndocumentedType (%d)", v.type); + return buffer; + } +} + +static FcCharSet * +mule_to_fc_charset (Lisp_Object cs) +{ + int ucode, i, j; + FcCharSet *fccs; + + CHECK_CHARSET (cs); + fccs = FcCharSetCreate (); + /* #### do we also need to deal with 94 vs. 96 charsets? + ie, how are SP and DEL treated in ASCII? non-graphic should return -1 */ + if (1 == XCHARSET_DIMENSION (cs)) + /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */ + for (i = 0; i < 96; i++) + { + ucode = ((int *) XCHARSET_TO_UNICODE_TABLE (cs))[i]; + if (ucode >= 0) + /* #### should check for allocation failure */ + FcCharSetAddChar (fccs, (FcChar32) ucode); + } + else if (2 == XCHARSET_DIMENSION (cs)) + /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */ + for (i = 0; i < 96; i++) + for (j = 0; j < 96; j++) + { + ucode = ((int **) XCHARSET_TO_UNICODE_TABLE (cs))[i][j]; + if (ucode >= 0) + /* #### should check for allocation failure */ + FcCharSetAddChar (fccs, (FcChar32) ucode); + } + else + { + FcCharSetDestroy (fccs); + fccs = NULL; + } + return fccs; +} + +struct charset_reporter { + Lisp_Object *charset; + /* This is a debug facility, require ASCII. */ + Extbyte *language; /* ASCII, please */ + FcChar8 *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 SET_DEBUG_FONTNAME(name) \ + do { name = \ + debug_xft > 2 ? eistr_fullname \ +: debug_xft > 1 ? eistr_longname \ +: eistr_shortname } while (0) + +#endif /* USE_XFT */ + /* find a font spec that matches font spec FONT and also matches (the registry of) CHARSET. */ static Lisp_Object ＠＠ -947,18 +1171,277 ＠＠ x_find_charset_font (Lisp_Object device, { Extbyte **names; int count = 0; - Lisp_Object result = Qnil; const Extbyte *patternext; + Lisp_Object result = Qunbound; int i; + /* #### with Xft need to handle second stage here -- sjt + Hm. Or maybe not. That would be cool. :-) */ if (stage) return Qnil; - LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding); +#ifdef USE_XFT + /* Fontconfig converts all FreeType names to UTF-8 before passing them + back to callers---see fcfreetype.c (FcFreeTypeQuery). + I don't believe this is documented. */ + + DEBUG_XFT1 (1, "confirming charset for font instance %s\n", + XSTRING_DATA(font)); + + /* #### this looks like a fair amount of work, but the basic design + has never been rethought, and it should be + + what really should happen here is that we use FcFontSort (FcFontList?) + to get a list of matching fonts, then pick the first (best) one that + gives language or repertoire coverage. + */ + + FcInit (); /* No-op if already initialized. + In fontconfig 2.3.2, this cannot return + failure, but that looks like a bug. We + check for it with FcGetCurrentConfig(), + which *can* fail. */ + if (!FcConfigGetCurrent()) /* #### We should expose FcInit* interfaces + to LISP and decide when to reinitialize + intelligently. */ + stderr_out ("Failed fontconfig initialization\n"); + else + { + FcPattern *fontxft; /* long-lived, freed at end of this block */ + FcResult fcresult; + FcConfig *fcc; + FcChar8 *lang = "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, Qxft_font_name_encoding); + fcc = FcConfigGetCurrent (); + + /* parse the name, do the substitutions, and match the font */ + + { + FcPattern *p = FcNameParse (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, name, Qxft_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, name, Qxft_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, name, Qxft_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. */ + + struct charset_reporter *cr; + for (cr = charset_table; + cr->charset && !EQ (*(cr->charset), charset); + cr++) + ; + + if (cr->rfc3066) + { + if (debug_xft > 0) + { + SET_DEBUG_FONTNAME (name); + CHECKING_LANG (0, eidata(name), cr->language); + } + lang = 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 = 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(lang); + + if (fccs) + { + /* check for character set coverage */ + int i = 0; + FcCharSet *v; + FcResult r = FcPatternGetCharSet (fontxft, FC_CHARSET, i, &v); + + if (r == FcResultTypeMismatch) + { + DEBUG_XFT0 (0, "Unexpected type return in charset value\n"); + result = Qnil; + } + else if (r == FcResultMatch && FcCharSetIsSubset (fccs, v)) + { + /* The full pattern with the bitmap coverage is massively + unwieldy, but the shorter names are's just *wrong*. We + should have the full thing internally as truename, and + filter stuff the client doesn't want to see on output. + Should we just store it into the truename right here? */ + if (debug_xft > 0) + { + SET_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 + { + if (debug_xft > 0) + { + SET_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) + { + if (debug_xft > 0) + { + SET_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 + { + if (debug_xft > 0) + { + SET_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 SET_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; ＠＠ -1041,6 +1524,10 ＠＠ fixed-width fonts. Since most people do cause problems this is set to nil by default. */ ); x_handle_non_fully_specified_fonts = 0; + +#ifdef USE_XFT + Fprovide (intern ("xft-fonts")); +#endif } void 1.5 +7 -2 XEmacs/xemacs/src/objects-x.h Index: objects-x.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.h,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- objects-x.h 2002/06/20 21:18:40 1.4 +++ objects-x.h 2005/11/26 11:46:10 1.5 ＠＠ -28,11 +28,16 ＠＠ Boston, MA 02111-1307, USA. */ #define INCLUDED_objects_x_h_ #include "objects.h" +#include "../lwlib/lwlib-colors.h" /* for x_allocate_nearest_color */ #ifdef HAVE_X_WINDOWS -int allocate_nearest_color (Display *display, Colormap screen_colormap, - Visual *visual, XColor *color_def); +#ifdef USE_XFT +EXFUN (Ffc_font_real_pattern, 2); +#endif + +/* Lisp_Object Fxlfd_font_name_p; */ + #endif /* HAVE_X_WINDOWS */ #endif /* INCLUDED_objects_x_h_ */ 1.31 +21 -5 XEmacs/xemacs/src/objects.c Index: objects.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v retrieving revision 1.30 retrieving revision 1.31 diff -u -p -r1.30 -r1.31 --- objects.c 2005/11/25 01:42:06 1.30 +++ objects.c 2005/11/26 11:46:10 1.31 ＠＠ -294,6 +294,7 ＠＠ static const struct memory_description f { 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 } ＠＠ -370,19 +371,23 ＠＠ DEFINE_LRECORD_IMPLEMENTATION ("font-ins 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; ＠＠ -407,6 +412,7 ＠＠ these objects are GCed, the underlying X 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, ＠＠ -509,6 +515,15 ＠＠ the first found is used. This returns a 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. */ ＠＠ -898,7 +913,7 ＠＠ font_instantiate (Lisp_Object UNUSED (sp 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); } ＠＠ -1150,6 +1165,7 ＠＠ syms_of_objects (void) 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.11 +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.11 diff -u -p -r1.10 -r1.11 --- objects.h 2004/09/14 14:32:52 1.10 +++ objects.h 2005/11/26 11:46:10 1.11 ＠＠ -58,10 +58,11 ＠＠ DECLARE_LRECORD (font_instance, Lisp_Fon #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.41 +412 -114 XEmacs/xemacs/src/redisplay-x.c Index: redisplay-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-x.c,v retrieving revision 1.40 retrieving revision 1.41 diff -u -p -r1.40 -r1.41 --- redisplay-x.c 2005/01/24 23:34:07 1.40 +++ redisplay-x.c 2005/11/26 11:46:10 1.41 ＠＠ -58,7 +58,7 ＠＠ Boston, MA 02111-1307, USA. */ #include <X11/bitmaps/gray> /* Number of pixels below each line. */ -int x_interline_space; /* #### implement me */ +int x_interline_space; /* #### this needs to be implemented, but per-font */ #define EOL_CURSOR_WIDTH 5 ＠＠ -73,7 +73,12 ＠＠ static void x_output_eol_cursor (struct static void x_clear_frame (struct frame *f); static void x_clear_frame_windows (Lisp_Object window); +#ifdef USE_XFT +#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ + ? ((unsigned long) (x)) : ((unsigned long) (y))) +#endif /* USE_XFT */ + /* Note: We do not use the Xmb*() functions and XFontSets. Those functions are generally losing for a number of reasons: ＠＠ -83,6 +88,11 ＠＠ static void x_clear_frame_windows (Lisp_ to try to deal with this, but that would generally fail because an XFontSet is tied to one locale and won't have the other character sets in it. + + The following aren't true any more, but that doesn't make Xmb*() + usable. One wonders about Xft and Pango, etc, tho'. Except they + aren't cross-platform solutions. FMH, as jwz would say. -- sjt + [[ 2) Not all (or even very many) OS's support the useful locales. For example, as far as I know SunOS and Solaris only support the Japanese locale if you get the ＠＠ -98,8 +108,10 ＠＠ static void x_clear_frame_windows (Lisp_ I can find what the multi-byte text format for the Japanese locale under SunOS and Solaris is, but I assume it's EUC. + ]] */ +/* #### Break me out into a separate header */ struct textual_run { Lisp_Object charset; ＠＠ -120,6 +132,25 ＠＠ struct textual_run Returns the number of runs actually used. */ +/* Notes on Xft implementation + + - Xft Reloaded, v.4, uses a function like that in redisplay-msw.c to + handle all characters. However, instead of using an appropriate + character width for each run, it just uses UTF-8 for all runs. This + is not obviously a bad idea, but (for Han characters etc) the estimate + of TEXT_STORAGE allocation needed is (3 * len), and for characters not + in the BMP, it's (4 * len). + - With Unicode, we're no longer going to have repertoires reified as + charsets. (Not that we ever really did, what with corporate variants, + and so on.) So we really should be querying the face for the desired + font, rather than the character for the charset, and that's what would + determine the separation into runs. + - The widechar versions of fontconfig (and therefore Xft) functions + seem to be just bigendian Unicode. So there's actually no need to use + the 8-bit versions in computing runs and runes, it would seem. + - Mule won't "just work"; substantially more effort seems needed. +*/ + static int separate_textual_runs (unsigned char *text_storage, struct textual_run *run_storage, ＠＠ -139,7 +170,7 ＠＠ separate_textual_runs (unsigned char *te { Ichar ch = str[i]; Lisp_Object charset; - int byte1, byte2; + int byte1, byte2; /* #### why aren't these UExtbytes? */ int dimension; int graphic; ＠＠ -151,7 +182,11 ＠＠ separate_textual_runs (unsigned char *te { 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) { ＠＠ -172,6 +207,7 ＠＠ separate_textual_runs (unsigned char *te #endif } +#ifndef USE_XFT if (graphic == 0) { byte1 &= 0x7F; ＠＠ -192,10 +228,53 ＠＠ separate_textual_runs (unsigned char *te byte1 = char_converter.reg[1]; byte2 = char_converter.reg[2]; } -#endif +#endif /* MULE */ *text_storage++ = (unsigned char) byte1; 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 */ } if (runs_so_far) ＠＠ -216,13 +295,34 ＠＠ separate_textual_runs (unsigned char *te /****************************************************************************/ static int -x_text_width_single_run (struct face_cachel *cachel, struct textual_run *run) +x_text_width_single_run (struct frame * USED_IF_XFT (f), + struct face_cachel *cachel, struct textual_run *run) { Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset); Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); if (!fi->proportional_p) return fi->width * run->len; - else +#ifdef USE_XFT + else if (FONT_INSTANCE_X_XFTFONT(fi)) + { + static XGlyphInfo glyphinfo; + struct device *d = XDEVICE (f->device); + Display *dpy = DEVICE_X_DISPLAY (d); + + if (run->dimension == 2) { + XftTextExtents16 (dpy, + FONT_INSTANCE_X_XFTFONT(fi), + (XftChar16 *) run->ptr, run->len, &glyphinfo); + } else { + XftTextExtents8 (dpy, + FONT_INSTANCE_X_XFTFONT(fi), + run->ptr, run->len, &glyphinfo); + } + + return glyphinfo.xOff; + } +#endif + else if (FONT_INSTANCE_X_FONT (fi)) { if (run->dimension == 2) return XTextWidth16 (FONT_INSTANCE_X_FONT (fi), ＠＠ -231,17 +331,23 ＠＠ x_text_width_single_run (struct face_cac return XTextWidth (FONT_INSTANCE_X_FONT (fi), (char *) run->ptr, run->len); } + else + abort(); + return 0; /* shut up GCC */ } /* x_text_width - Given a string and a face, return the string's length in pixels when - displayed in the font associated with the face. + Given a string and a merged face, return the string's length in pixels + when displayed in the fonts associated with the face. */ -static int -x_text_width (struct frame *UNUSED (f), struct face_cachel *cachel, +/* #### Break me out into a separate header */ +int x_text_width (struct frame *f, struct face_cachel *cachel, + const Ichar *str, Charcount len); +int +x_text_width (struct frame *f, struct face_cachel *cachel, const Ichar *str, Charcount len) { /* !!#### Needs review */ ＠＠ -254,7 +360,7 ＠＠ x_text_width (struct frame *UNUSED (f), nruns = separate_textual_runs (text_storage, runs, str, len); for (i = 0; i < nruns; i++) - width_so_far += x_text_width_single_run (cachel, runs + i); + width_so_far += x_text_width_single_run (f, cachel, runs + i); return width_so_far; } ＠＠ -319,7 +425,9 ＠＠ x_output_display_block (struct window *w int start, int end, int start_pixpos, int cursor_start, int cursor_width, int cursor_height) { +#ifndef USE_XFT struct frame *f = XFRAME (w->frame); +#endif Ichar_dynarr *buf = Dynarr_new (Ichar); Lisp_Object window; ＠＠ -502,13 +610,17 ＠＠ x_output_display_block (struct window *w x_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex, 0, cursor_start, cursor_width, cursor_height); - /* #### This is really conditionalized well for optimized - performance. */ if (dl->modeline && !EQ (Qzero, w->modeline_shadow_thickness) +#ifndef USE_XFT + /* This optimization doesn't work right with some Xft fonts, which + leave antialiasing turds at the boundary. I don't know if this + is an Xft bug or not, but I think it is. See x_output_string. */ && (f->clear || f->windows_structure_changed - || w->shadow_thickness_changed)) + || w->shadow_thickness_changed) +#endif + ) bevel_modeline (w, dl); Dynarr_free (buf); ＠＠ -662,7 +774,13 ＠＠ x_get_gc (struct device *d, Lisp_Object mask = GCGraphicsExposures | GCClipMask | GCClipXOrigin | GCClipYOrigin; mask |= GCFillStyle; - if (!NILP (font)) + if (!NILP (font) +#ifdef USE_XFT + /* Only set the font if it's a core font */ + /* the renderfont will be set elsewhere (not part of gc) */ + && !FONT_INSTANCE_X_XFTFONT (XFONT_INSTANCE (font)) +#endif + ) { gcv.font = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font))->fid; mask |= GCFont; ＠＠ -671,7 +789,7 ＠＠ x_get_gc (struct device *d, Lisp_Object /* evil kludge! */ if (!NILP (fg) && !COLOR_INSTANCEP (fg) && !INTP (fg)) { - /* #### I fixed once case where this was getting it. It was a + /* #### I fixed one case where this was getting hit. It was a bad macro expansion (compiler bug). */ stderr_out ("Help! x_get_gc got a bogus fg value! fg = "); debug_print (fg); ＠＠ -729,6 +847,9 ＠＠ x_get_gc (struct device *d, Lisp_Object mask |= GCLineWidth; } +#if 0 + debug_out ("\nx_get_gc: calling gc_cache_lookup\n"); +#endif return gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); } ＠＠ -774,7 +895,7 ＠＠ x_output_string (struct window *w, struc /* General variables */ struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); - Lisp_Object window; + Lisp_Object window = wrap_window (w); Display *dpy = DEVICE_X_DISPLAY (d); Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); ＠＠ -790,7 +911,8 ＠＠ x_output_string (struct window *w, struc /* Text-related variables */ Lisp_Object bg_pmap; GC bgc, gc; - int height; + int height = DISPLAY_LINE_HEIGHT (dl); + int ypos = DISPLAY_LINE_YPOS (dl); int len = Dynarr_length (buf); unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); struct textual_run *runs = alloca_array (struct textual_run, len); ＠＠ -798,11 +920,31 ＠＠ x_output_string (struct window *w, struc int i; struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); - window = wrap_window (w); + int use_x_font = 1; /* #### bogus!! + The logic of this function needs review! */ +#ifdef USE_XFT + Colormap cmap = DEVICE_X_COLORMAP (d); + Visual *visual = DEVICE_X_VISUAL (d); + static XftColor fg, bg; + XftDraw *xftDraw; + + /* Lazily initialize frame's xftDraw member. */ + if (!FRAME_X_XFTDRAW (f)) { + FRAME_X_XFTDRAW (f) = XftDrawCreate (dpy, x_win, visual, cmap); + } + xftDraw = FRAME_X_XFTDRAW (f); + /* #### This will probably cause asserts when passed a Lisp integer for a + color. See ca. line 759 this file. + #### Maybe xft_convert_color should take an XColor, not a pixel. */ +#define XFT_FROB_LISP_COLOR(color, dim) \ + xft_convert_color (dpy, cmap, visual, \ + COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (color)).pixel, \ + (dim)) +#endif + if (width < 0) width = x_text_width (f, cachel, Dynarr_atp (buf, 0), Dynarr_length (buf)); - height = DISPLAY_LINE_HEIGHT (dl); /* Regularize the variables passed in. */ ＠＠ -816,12 +958,9 ＠＠ x_output_string (struct window *w, struc xpos -= xoffset; /* make sure the area we are about to display is subwindow free. */ - redisplay_unmap_subwindows_maybe (f, clip_start, DISPLAY_LINE_YPOS (dl), - clip_end - clip_start, DISPLAY_LINE_HEIGHT (dl)); + redisplay_unmap_subwindows_maybe (f, clip_start, ypos, + clip_end - clip_start, height); - nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), - Dynarr_length (buf)); - cursor_clip = (cursor_start >= clip_start && cursor_start < clip_end); ＠＠ -858,14 +997,21 ＠＠ x_output_string (struct window *w, struc && !NILP (w->text_cursor_visible_p)) || NILP (bg_pmap)) bgc = 0; else - bgc = x_get_gc (d, Qnil, cachel->foreground, cachel->background, - bg_pmap, Qnil); + { + bgc = x_get_gc (d, Qnil, cachel->foreground, cachel->background, + bg_pmap, Qnil); + } if (bgc) - XFillRectangle (dpy, x_win, bgc, clip_start, - DISPLAY_LINE_YPOS (dl), clip_end - clip_start, - height); + { + XFillRectangle (dpy, x_win, bgc, clip_start, + ypos, clip_end - clip_start, + height); + } + nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), + Dynarr_length (buf)); + for (i = 0; i < nruns; i++) { Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); ＠＠ -876,7 +1022,7 ＠＠ x_output_string (struct window *w, struc if (EQ (font, Vthe_null_font_instance)) continue; - this_width = x_text_width_single_run (cachel, runs + i); + this_width = x_text_width_single_run (f, cachel, runs + i); need_clipping = (dl->clip || clip_start > xpos || clip_end < xpos + this_width); ＠＠ -895,8 +1041,8 ＠＠ x_output_string (struct window *w, struc ypos1_string = dl->ypos - fi->ascent; ypos2_string = dl->ypos + fi->descent; - ypos1_line = DISPLAY_LINE_YPOS (dl); - ypos2_line = ypos1_line + DISPLAY_LINE_HEIGHT (dl); + ypos1_line = ypos; + ypos2_line = ypos1_line + height; /* Make sure we don't clear below the real bottom of the line. */ ＠＠ -922,14 +1068,20 ＠＠ x_output_string (struct window *w, struc else { redisplay_clear_region (window, findex, clear_start, - DISPLAY_LINE_YPOS (dl), clear_end - clear_start, + ypos, clear_end - clear_start, height); } } if (cursor && cursor_cachel && focus && NILP (bar_cursor_value)) - gc = x_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); + { +#ifdef USE_XFT + fg = XFT_FROB_LISP_COLOR (cursor_cachel->foreground, 0); + bg = XFT_FROB_LISP_COLOR (cursor_cachel->background, 0); +#endif + gc = x_get_gc (d, font, cursor_cachel->foreground, + cursor_cachel->background, Qnil, Qnil); + } else if (cachel->dim) { /* Ensure the gray bitmap exists */ ＠＠ -939,53 +1091,135 ＠＠ x_output_string (struct window *w, struc gray_width, gray_height); /* Request a GC with the gray stipple pixmap to draw dimmed text */ +#ifdef USE_XFT + fg = XFT_FROB_LISP_COLOR (cachel->foreground, 1); + bg = XFT_FROB_LISP_COLOR (cachel->background, 0); +#endif gc = x_get_gc (d, font, cachel->foreground, cachel->background, Qdim, Qnil); } else - gc = x_get_gc (d, font, cachel->foreground, cachel->background, - Qnil, Qnil); - - if (need_clipping) { - XRectangle clip_box[1]; - - clip_box[0].x = 0; - clip_box[0].y = 0; - clip_box[0].width = clip_end - clip_start; - clip_box[0].height = height; - - XSetClipRectangles (dpy, gc, clip_start, DISPLAY_LINE_YPOS (dl), - clip_box, 1, Unsorted); +#ifdef USE_XFT + fg = XFT_FROB_LISP_COLOR (cachel->foreground, 0); + bg = XFT_FROB_LISP_COLOR (cachel->background, 0); +#endif + gc = x_get_gc (d, font, cachel->foreground, cachel->background, + Qnil, Qnil); } +#ifdef USE_XFT + { + XftFont *rf = FONT_INSTANCE_X_XFTFONT (fi); - if (runs[i].dimension == 1) - (bgc ? XDrawString : XDrawImageString) (dpy, x_win, gc, xpos, - dl->ypos, (char *) runs[i].ptr, - runs[i].len); - else - (bgc ? XDrawString16 : XDrawImageString16) (dpy, x_win, gc, xpos, - dl->ypos, - (XChar2b *) runs[i].ptr, - runs[i].len); + if (rf) + { + use_x_font = 0; + if (need_clipping) + { + Region clip_reg = XCreateRegion(); + XRectangle clip_box = { clip_start, ypos, + clip_end - clip_start, height }; + + XUnionRectWithRegion (&clip_box, clip_reg, clip_reg); + XftDrawSetClip(xftDraw, clip_reg); + XDestroyRegion(clip_reg); + } + + if (!bgc) + { + /* #### Neither rect_height nor XftTextExtents as computed + below handles the vertical space taken up by antialiasing, + which for some fonts (eg, Bitstream Vera Sans Mono-16 on + my Mac PowerBook G4) leaves behind orphaned dots on + insertion or deletion earlier in the line, especially in + the case of the underscore character. + Interestingly, insertion or deletion of a single character + immediately after a refresh does not leave any droppings, + but any further insertions or deletions do. + While adding a pixel to rect_height (mostly) takes care of + this, it trashes aggressively laid-out elements like the + modeline (overwriting part of the bevel). + OK, unconditionally redraw the bevel, and increment + rect_height by 1. See x_output_display_block. -- sjt */ + struct textual_run *run = &runs[i]; + int rect_width = x_text_width_single_run (f, cachel, run); +#ifndef USE_XFTTEXTENTS_TO_AVOID_FONT_DROPPINGS + int rect_height = FONT_INSTANCE_ASCENT(fi) + + FONT_INSTANCE_DESCENT(fi) + 1; +#else + int rect_height = FONT_INSTANCE_ASCENT(fi) + + FONT_INSTANCE_DESCENT(fi); + XGlyphInfo gi; + if (run->dimension == 2) { + XftTextExtents16 (dpy, + FONT_INSTANCE_X_XFTFONT(fi), + (XftChar16 *) run->ptr, run->len, &gi); + } else { + XftTextExtents8 (dpy, + FONT_INSTANCE_X_XFTFONT(fi), + run->ptr, run->len, &gi); + } + rect_height = rect_height > gi.height + ? rect_height : gi.height; +#endif + + XftDrawRect (xftDraw, &bg, + xpos, ypos, rect_width, rect_height); + } + + if (runs[i].dimension == 1) + XftDrawString8 (xftDraw, &fg, rf, xpos, dl->ypos, + runs[i].ptr, runs[i].len); + else + XftDrawString16 (xftDraw, &fg, rf, xpos, dl->ypos, + (XftChar16 *) runs[i].ptr, runs[i].len); + } + } +#endif + { + if (use_x_font) + { + if (need_clipping) + { + XRectangle clip_box[1]; + + clip_box[0].x = 0; + clip_box[0].y = 0; + clip_box[0].width = clip_end - clip_start; + clip_box[0].height = height; + + XSetClipRectangles (dpy, gc, clip_start, ypos, + clip_box, 1, YXBanded); + } + + if (runs[i].dimension == 1) + (bgc ? XDrawString : XDrawImageString) + (dpy, x_win, gc, xpos, dl->ypos, + (char *) runs[i].ptr, runs[i].len); + else + (bgc ? XDrawString16 : XDrawImageString16) + (dpy, x_win, gc, xpos, dl->ypos, + (XChar2b *) runs[i].ptr, runs[i].len); + } + } /* We draw underlines in the same color as the text. */ if (cachel->underline) { int upos, uthick; unsigned long upos_ext, uthick_ext; - XFontStruct *xfont; - - xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); - if (!XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &upos_ext)) - upos = dl->descent / 2; - else + XFontStruct *fs = + use_x_font ? FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)) : 0; + /* #### the logic of the next two may be suboptimal: we may want + to use the POSITION and/or THICKNESS information with Xft */ + if (fs && XGetFontProperty (fs, XA_UNDERLINE_POSITION, &upos_ext)) upos = (int) upos_ext; - if (!XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &uthick_ext)) - uthick = 1; else + upos = dl->descent / 2; + if (fs && XGetFontProperty (fs, XA_UNDERLINE_THICKNESS, &uthick_ext)) uthick = (int) uthick_ext; - + else + uthick = 1; if (dl->ypos + upos < dl->ypos + dl->descent - dl->clip) { if (dl->ypos + upos + uthick > dl->ypos + dl->descent - dl->clip) ＠＠ -1008,22 +1242,29 ＠＠ x_output_string (struct window *w, struc { int ascent, descent, upos, uthick; unsigned long ascent_ext, descent_ext, uthick_ext; - XFontStruct *xfont; - - xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); + XFontStruct *fs = FONT_INSTANCE_X_FONT (fi); - if (!XGetFontProperty (xfont, XA_STRIKEOUT_ASCENT, &ascent_ext)) - ascent = xfont->ascent; - else - ascent = (int) ascent_ext; - if (!XGetFontProperty (xfont, XA_STRIKEOUT_DESCENT, &descent_ext)) - descent = xfont->descent; - else - descent = (int) descent_ext; - if (!XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &uthick_ext)) - uthick = 1; + if (!use_x_font) + { + ascent = dl->ascent; + descent = dl->descent; + uthick = 1; + } else - uthick = (int) uthick_ext; + { + if (!XGetFontProperty (fs, XA_STRIKEOUT_ASCENT, &ascent_ext)) + ascent = fs->ascent; + else + ascent = (int) ascent_ext; + if (!XGetFontProperty (fs, XA_STRIKEOUT_DESCENT, &descent_ext)) + descent = fs->descent; + else + descent = (int) descent_ext; + if (!XGetFontProperty (fs, XA_UNDERLINE_THICKNESS, &uthick_ext)) + uthick = 1; + else + uthick = (int) uthick_ext; + } upos = ascent - ((ascent + descent) / 2) + 1; ＠＠ -1046,37 +1287,88 ＠＠ x_output_string (struct window *w, struc /* Restore the GC */ if (need_clipping) { - XSetClipMask (dpy, gc, None); - XSetClipOrigin (dpy, gc, 0, 0); +#ifdef USE_XFT + if (!use_x_font) + { + XftDrawSetClip(xftDraw, 0); + } + else + { +#endif + XSetClipMask (dpy, gc, None); + XSetClipOrigin (dpy, gc, 0, 0); +#ifdef USE_XFT + } +#endif } /* If we are actually superimposing the cursor then redraw with just the appropriate section highlighted. */ if (cursor_clip && !cursor && focus && cursor_cachel) { - GC cgc; - XRectangle clip_box[1]; - - cgc = x_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); - - clip_box[0].x = 0; - clip_box[0].y = 0; - clip_box[0].width = cursor_width; - clip_box[0].height = height; - - XSetClipRectangles (dpy, cgc, cursor_start, DISPLAY_LINE_YPOS (dl), - clip_box, 1, Unsorted); - - if (runs[i].dimension == 1) - XDrawImageString (dpy, x_win, cgc, xpos, dl->ypos, - (char *) runs[i].ptr, runs[i].len); - else - XDrawImageString16 (dpy, x_win, cgc, xpos, dl->ypos, - (XChar2b *) runs[i].ptr, runs[i].len); +#ifdef USE_XFT + if (!use_x_font) /* Xft */ + { + XftFont *rf = FONT_INSTANCE_X_XFTFONT (fi); + + { /* set up clipping */ + Region clip_reg = XCreateRegion(); + XRectangle clip_box = { cursor_start, ypos, + cursor_width, height }; + + XUnionRectWithRegion (&clip_box, clip_reg, clip_reg); + XftDrawSetClip(xftDraw, clip_reg); + XDestroyRegion(clip_reg); + } + { /* draw background rectangle & draw text */ + int rect_height = FONT_INSTANCE_ASCENT(fi) + + FONT_INSTANCE_DESCENT(fi); + int rect_width = x_text_width_single_run(f, cachel, &runs[i]); + XftColor xft_color; + + xft_color = XFT_FROB_LISP_COLOR (cursor_cachel->background, 0); + XftDrawRect (xftDraw, &xft_color, + xpos, ypos, rect_width, rect_height); + + xft_color = XFT_FROB_LISP_COLOR (cursor_cachel->foreground, 0); + if (runs[i].dimension == 1) + XftDrawString8 (xftDraw, &xft_color, rf, xpos, dl->ypos, + runs[i].ptr, runs[i].len); + else + XftDrawString16 (xftDraw, &xft_color, rf, xpos, dl->ypos, + (XftChar16 *) runs[i].ptr, runs[i].len); + } - XSetClipMask (dpy, cgc, None); - XSetClipOrigin (dpy, cgc, 0, 0); + XftDrawSetClip(xftDraw, 0); + } + else /* core font, not Xft */ + { +#endif + GC cgc; + XRectangle clip_box[1]; + + cgc = x_get_gc (d, font, cursor_cachel->foreground, + cursor_cachel->background, Qnil, Qnil); + + clip_box[0].x = 0; + clip_box[0].y = 0; + clip_box[0].width = cursor_width; + clip_box[0].height = height; + + XSetClipRectangles (dpy, cgc, cursor_start, ypos, + clip_box, 1, YXBanded); + if (runs[i].dimension == 1) + XDrawImageString (dpy, x_win, cgc, xpos, dl->ypos, + (char *) runs[i].ptr, runs[i].len); + else + XDrawImageString16 (dpy, x_win, cgc, xpos, dl->ypos, + (XChar2b *) runs[i].ptr, runs[i].len); + + XSetClipMask (dpy, cgc, None); + XSetClipOrigin (dpy, cgc, 0, 0); +#ifdef USE_XFT + } +#endif } xpos += this_width; ＠＠ -1102,11 +1394,11 ＠＠ x_output_string (struct window *w, struc This is bogus as all hell, however. The cursor handling in this function is way bogus and desperately needs to be - cleaned up. (In particular, the drawing of the cursor should + cleaned up. (In particular, the drawing of the cursor should really really be separated out of this function. This may be a bit tricky now because this function itself does way too much stuff, a lot of which needs to be moved into - redisplay.c) This is the only way to be able to easily add + redisplay.c.) This is the only way to be able to easily add new cursor types or (e.g.) make the bar cursor be able to span two characters instead of overlaying just one. */ int bogusly_obtained_ascent_value = ＠＠ -1125,12 +1417,12 ＠＠ x_output_string (struct window *w, struc tmp_y = dl->ypos - bogusly_obtained_ascent_value; tmp_height = cursor_height; - if (tmp_y + tmp_height > (int) (DISPLAY_LINE_YPOS(dl) + height)) + if (tmp_y + tmp_height > (int) (ypos + height)) { - tmp_y = DISPLAY_LINE_YPOS (dl) + height - tmp_height; - if (tmp_y < (int) DISPLAY_LINE_YPOS (dl)) - tmp_y = DISPLAY_LINE_YPOS (dl); - tmp_height = DISPLAY_LINE_YPOS (dl) + height - tmp_y; + tmp_y = ypos + height - tmp_height; + if (tmp_y < (int) ypos) + tmp_y = ypos; + tmp_height = ypos + height - tmp_y; } if (need_clipping) ＠＠ -1141,7 +1433,8 ＠＠ x_output_string (struct window *w, struc clip_box[0].width = clip_end - clip_start; clip_box[0].height = tmp_height; XSetClipRectangles (dpy, gc, clip_start, tmp_y, - clip_box, 1, Unsorted); + /* #### why not Unsorted? */ + clip_box, 1, YXBanded); } if (!focus && NILP (bar_cursor_value)) ＠＠ -1162,6 +1455,11 ＠＠ x_output_string (struct window *w, struc XSetClipOrigin (dpy, gc, 0, 0); } } + +#ifdef USE_XFT +#undef XFT_FROB_LISP_COLOR +#endif + } void ＠＠ -1625,7 +1923,7 ＠＠ x_generate_shadow_pixels (struct frame * topc.red = MINL (65535, (unsigned long) topc.red * 6 / 5); topc.green = MINL (65535, (unsigned long) topc.green * 6 / 5); topc.blue = MINL (65535, (unsigned long) topc.blue * 6 / 5); - if (allocate_nearest_color (dpy, cmap, visual, &topc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &topc)) { *top_shadow = topc.pixel; top_frobbed = 1; ＠＠ -1641,7 +1939,7 ＠＠ x_generate_shadow_pixels (struct frame * botc.red = (unsigned short) ((unsigned long) botc.red * 3 / 5); botc.green = (unsigned short) ((unsigned long) botc.green * 3 / 5); botc.blue = (unsigned short) ((unsigned long) botc.blue * 3 / 5); - if (allocate_nearest_color (dpy, cmap, visual, &botc)) + if (x_allocate_nearest_color (dpy, cmap, visual, &botc)) { *bottom_shadow = botc.pixel; bottom_frobbed = 1; 1.98 +7 -3 XEmacs/xemacs/src/redisplay.c Index: redisplay.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v retrieving revision 1.97 retrieving revision 1.98 diff -u -p -r1.97 -r1.98 --- redisplay.c 2005/10/25 11:16:27 1.97 +++ redisplay.c 2005/11/26 11:46:10 1.98 ＠＠ -4177,9 +4177,13 ＠＠ tail_recurse: dash_pixsize = redisplay_text_width_string (w, findex, &ch, Qnil, 0, 1); - - num_to_add = (max_pixsize - cur_pixsize) / dash_pixsize; - num_to_add++; + + if (dash_pixsize == 0) + num_to_add = 0; + else { + num_to_add = (max_pixsize - cur_pixsize) / dash_pixsize; + num_to_add++; + } } while (num_to_add--) 1.54 +4 -0 XEmacs/xemacs/src/symsinit.h Index: symsinit.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symsinit.h,v retrieving revision 1.53 retrieving revision 1.54 diff -u -p -r1.53 -r1.54 --- symsinit.h 2005/10/04 17:51:24 1.53 +++ symsinit.h 2005/11/26 11:46:10 1.54 ＠＠ -160,6 +160,7 ＠＠ void syms_of_objects (void); void syms_of_objects_mswindows (void); void syms_of_objects_tty (void); void syms_of_objects_x (void); +void syms_of_xft_fonts (void); EXTERN_C void syms_of_postgresql (void); void syms_of_print (void); void syms_of_process (void); ＠＠ -397,6 +398,8 ＠＠ void reinit_vars_of_mule_wnn (void); void vars_of_nt (void); void vars_of_number (void); void vars_of_objects (void); +void vars_of_xft_fonts (void); +void reinit_vars_of_xft_fonts (void); void reinit_vars_of_objects (void); void vars_of_objects_tty (void); void vars_of_objects_mswindows (void); ＠＠ -481,6 +484,7 ＠＠ void complex_vars_of_emacs (void); void complex_vars_of_minibuf (void); void reinit_complex_vars_of_minibuf (void); void complex_vars_of_keymap (void); +void complex_vars_of_xft_fonts (void); /* Late initialization -- stuff pertaining only to interactive usage, I/O, or Lisp reading. (Dump-time and run-time, but the code itself 1.12 +18 -10 XEmacs/xemacs/src/toolbar-common.c Index: toolbar-common.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/toolbar-common.c,v retrieving revision 1.11 retrieving revision 1.12 diff -u -p -r1.11 -r1.12 --- toolbar-common.c 2005/01/24 23:34:12 1.11 +++ toolbar-common.c 2005/11/26 11:46:11 1.12 ＠＠ -144,7 +144,8 ＠＠ static void __prepare_button_area (struc (w, toolbar_findex, sx + x_adj, sy + y_adj, swidth + width_adj, sheight + height_adj, abs(shadow_thickness), - EDGE_ALL, (shadow_thickness < 0) ? EDGE_BEVEL_IN : EDGE_BEVEL_OUT)); + EDGE_ALL, (shadow_thickness < 0) ? EDGE_BEVEL_IN + : EDGE_BEVEL_OUT)); } /* Handle the borders... */ ＠＠ -173,7 +174,7 ＠＠ common_output_toolbar_button (struct fra struct window *w; int vertical = tb->vertical; int border_width = tb->border_width; - face_index toolbar_findex; + face_index button_findex; if (vertical) { ＠＠ -211,16 +212,23 ＠＠ common_output_toolbar_button (struct fra shadow_thickness = 0; } - toolbar_findex = get_builtin_face_cache_index (w, Vtoolbar_face); - - __prepare_button_area (f, tb); - /* #### It is currently possible for users to trash us by directly changing the toolbar glyphs. Avoid crashing in that case. */ if (GLYPHP (glyph)) - instance = glyph_image_instance (glyph, window, ERROR_ME_DEBUG_WARN, 1); + { + /* WARNING: this interface may change */ + Lisp_Object face_list[2] = { XGLYPH_FACE (glyph), Vtoolbar_face }; + + button_findex = merge_face_list_to_cache_index (w, face_list, 2); + instance = glyph_image_instance (glyph, window, ERROR_ME_DEBUG_WARN, 1); + } else - instance = Qnil; + { + button_findex = get_builtin_face_cache_index (w, Vtoolbar_face); + instance = Qnil; + } + + __prepare_button_area (f, tb); if (IMAGE_INSTANCEP (instance)) { ＠＠ -263,7 +271,7 ＠＠ common_output_toolbar_button (struct fra redisplay_output_pixmap (w, instance, &db, &dga, - toolbar_findex, 0, 0, 0, 0); + button_findex, 0, 0, 0, 0); } else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_TEXT) { ＠＠ -309,7 +317,7 ＠＠ common_output_toolbar_button (struct fra MAYBE_DEVMETH (d, output_string, (w, &dl, buf, tb->x + x_offset, 0, 0, width, - toolbar_findex, 0, 0, 0, 0)); + button_findex, 0, 0, 0, 0)); Dynarr_free (buf); } 1.13 +74 -42 XEmacs/xemacs/src/xgccache.c Index: xgccache.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/xgccache.c,v retrieving revision 1.12 retrieving revision 1.13 diff -u -p -r1.12 -r1.13 --- xgccache.c 2005/02/15 03:17:07 1.12 +++ xgccache.c 2005/11/26 11:46:11 1.13 ＠＠ -158,6 +158,10 ＠＠ gc_cache_lookup (struct gc_cache *cache, struct gc_cache_cell *cell, *next, *prev; struct gcv_and_mask gcvm; +#ifdef DEBUG_XEMACS + (void) describe_gc_cache (cache, DGCCFLAG_DISABLE); +#endif + if ((!!cache->head) != (!!cache->tail)) ABORT (); if (cache->head && (cache->head->prev || cache->tail->next)) ABORT (); ＠＠ -196,6 +200,9 ＠＠ gc_cache_lookup (struct gc_cache *cache, will be less likely to be collected than a cell that was accessed less recently. */ +#if 0 + debug_out ("Returning cached GC: %08lx\n", XE_GCONTEXT(cell)); +#endif if (cell == cache->tail) return cell->gc; ＠＠ -226,6 +233,7 ＠＠ gc_cache_lookup (struct gc_cache *cache, cache->head = cell->next; cache->head->prev = 0; if (cache->tail == cell) cache->tail = 0; /* only one */ + debug_out ("Cache full, freeing GC: %08lx\n ", XE_GCONTEXT(cell)); XFreeGC (cache->dpy, cell->gc); cache->delete_count++; #ifdef GCCACHE_HASH ＠＠ -264,68 +272,92 ＠＠ gc_cache_lookup (struct gc_cache *cache, /* debug */ assert (cell->gc == gc_cache_lookup (cache, gcv, mask)); +#if 0 + debug_out ("Returning new GC: %08lx\n ", XE_GCONTEXT(cell)); +#endif return cell->gc; }  #ifdef DEBUG_XEMACS + +/* FLAGS + The flags argument is a bitwise or of any of the following: -void describe_gc_cache (struct gc_cache *cache); + DGCCFLAG_SUMMARY Summary statistics for cache + DGCCFLAG_LIST_CELLS If summary is being printed, print cell IDs too. + DGCCFLAG_CELL_DETAILS If cell IDs are being printed, additionally + print the internal fields used and values. + + DGCCFLAG_DEFAULT A predefined combination giving whatever the + maintainers are currently interested in seeing. +*/ void -describe_gc_cache (struct gc_cache *cache) +describe_gc_cache (struct gc_cache *cache, int flags) { int count = 0; struct gc_cache_cell *cell = cache->head; + + if (! flags & DGCCFLAG_SUMMARY) return; + stderr_out ("\nsize: %d", cache->size); stderr_out ("\ncreated: %d", cache->create_count); stderr_out ("\ndeleted: %d", cache->delete_count); - while (cell) - { - struct gc_cache_cell *cell2; - int i = 0; - stderr_out ("\n%d:\t0x%lx GC: 0x%08lx hash: 0x%08lx\n", - count, (long) cell, (long) cell->gc, gc_cache_hash (&cell->gcvm)); - for (cell2 = cache->head; cell2; cell2 = cell2->next, i++) - if (count != i && - gc_cache_hash (&cell->gcvm) == gc_cache_hash (&cell2->gcvm)) - stderr_out ("\tHASH COLLISION with cell %d\n", i); - stderr_out ("\tmask: %8lx\n", cell->gcvm.mask); + if (flags & DGCCFLAG_LIST_CELLS) + while (cell) + { + struct gc_cache_cell *cell2; + int i = 0; + stderr_out ("\n%d:\t0x%lx GC: 0x%08lx hash: 0x%08lx\n", + count, (long) cell, (long) XE_GCONTEXT(cell), + gc_cache_hash (&cell->gcvm)); + + for (cell2 = cache->head; cell2; cell2 = cell2->next, i++) + if (count != i && + gc_cache_hash (&cell->gcvm) == gc_cache_hash (&cell2->gcvm)) + stderr_out ("\tHASH COLLISION with cell %d\n", i); + stderr_out ("\tmask: %8lx\n", cell->gcvm.mask); + + if (flags & DGCCFLAG_CELL_DETAILS) + { #define FROB(field) do { \ if ((int)cell->gcvm.gcv.field != (~0)) \ stderr_out ("\t%-12s%8x\n", #field ":", (int)cell->gcvm.gcv.field); \ } while (0) - FROB (function); - FROB (plane_mask); - FROB (foreground); - FROB (background); - FROB (line_width); - FROB (line_style); - FROB (cap_style); - FROB (join_style); - FROB (fill_style); - FROB (fill_rule); - FROB (arc_mode); - FROB (tile); - FROB (stipple); - FROB (ts_x_origin); - FROB (ts_y_origin); - FROB (font); - FROB (subwindow_mode); - FROB (graphics_exposures); - FROB (clip_x_origin); - FROB (clip_y_origin); - FROB (clip_mask); - FROB (dash_offset); + FROB (function); + FROB (plane_mask); + FROB (foreground); + FROB (background); + FROB (line_width); + FROB (line_style); + FROB (cap_style); + FROB (join_style); + FROB (fill_style); + FROB (fill_rule); + FROB (arc_mode); + FROB (tile); + FROB (stipple); + FROB (ts_x_origin); + FROB (ts_y_origin); + FROB (font); + FROB (subwindow_mode); + FROB (graphics_exposures); + FROB (clip_x_origin); + FROB (clip_y_origin); + FROB (clip_mask); + FROB (dash_offset); #undef FROB + } + + count++; + if (cell->next && cell == cache->tail) + stderr_out ("\nERROR! tail is here!\n\n"); + else if (!cell->next && cell != cache->tail) + stderr_out ("\nERROR! tail is not at the end\n\n"); + cell = cell->next; + } /* while (cell) */ - count++; - if (cell->next && cell == cache->tail) - stderr_out ("\nERROR! tail is here!\n\n"); - else if (!cell->next && cell != cache->tail) - stderr_out ("\nERROR! tail is not at the end\n\n"); - cell = cell->next; - } if (count != cache->size) stderr_out ("\nERROR! count should be %d\n\n", cache->size); } 1.5 +14 -0 XEmacs/xemacs/src/xgccache.h Index: xgccache.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/xgccache.h,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- xgccache.h 2005/02/15 03:17:07 1.4 +++ xgccache.h 2005/11/26 11:46:11 1.5 ＠＠ -31,4 +31,18 ＠＠ struct gc_cache *make_gc_cache (Display void free_gc_cache (struct gc_cache *cache); GC gc_cache_lookup (struct gc_cache *, XGCValues *, unsigned long mask); +#define XE_GCONTEXT(cell) (XGContextFromGC(cell->gc)) + +#ifdef DEBUG_XEMACS + +void describe_gc_cache (struct gc_cache *cache, int flags); + +#define DGCCFLAG_DISABLE 0 +#define DGCCFLAG_SUMMARY 1 << 0 +#define DGCCFLAG_LIST_CELLS 1 << 1 +#define DGCCFLAG_CELL_DETAILS 1 << 2 +/* A combination of the flags above. */ +#define DGCCFLAG_DEFAULT DGCCFLAG_SUMMARY | DGCCFLAG_LIST_CELLS +#endif + #endif /* INCLUDED_xgccache_h_ */ 1.2 +843 -0 XEmacs/xemacs/src/xft-fonts.c Index: xft-fonts.c =================================================================== RCS file: xft-fonts.c diff -N xft-fonts.c --- /dev/null Sat Nov 26 12:46:04 2005 +++ /tmp/cvsAAAPhai_X Sat Nov 26 12:46:18 2005 ＠＠ -0,0 +1,843 ＠＠ +/* Lisp font handling implementation for X with Xft. + +Copyright (C) 2003 Eric Knauel and Matthias Neubauer +Copyright (C) 2005 Eric Knauel +Copyright (C) 2004, 2005 Free Software Foundation, Inc. + +Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de&gt; + Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de&gt; + Stephen J. Turnbull <stephen(a)xemacs.org&gt; +Created: 27 Oct 2003 +Updated: 05 Mar 2005 by Stephen J. Turnbull + +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 GNU Emacs. */ + +/* This module provides the Lisp interface to fonts in X11, including Xft, + but (at least at first) not GTK+ or Qt. + + It should be renamed to fonts-x.h. + + Sealevel code should be in ../lwlib/lwlib-fonts.c or + ../lwlib/lwlib-colors.c. +*/ + +#include <config.h> +#include "lisp.h" +#include "device.h" +#include "device-impl.h" +#include "console-x-impl.h" +#include "objects-x.h" +#include "objects-x-impl.h" +#include "hash.h" +#include "xft-fonts.h" + +/* #### 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. + . We should support the most recent Xft first, old Xft libraries later. + . We may (think about it) wish to use fontconfig generally, even if we're + not using Xft. Either way, names that are really from fontconfig should + use the Fc* namespace. + . Mule-ize this file. + . Separate X Font Struct ops from Xft Font ops; give precedence to Xft but + allow fallback to X. + . Push decisions about font choice, defaults, fallbacks to Lisp; if we + really need efficiency, can reimplement in C later. + . Implement symbols interned in this file in the Q* namespace. + . Implement FcMatrix (Lisp vector). + . Implement FcCharSets (Lisp chartable? For implementation hints, see + FcCharSetFirstPage and FcCharSetNextPage). + . Implement FcConfigs. + DONE + . Fontconfig fontnames are encoded in UTF-8. +*/ + +Lisp_Object Qxft_font; +Lisp_Object Qfc_patternp; +Lisp_Object Qfc_fontsetp; +/* Lisp_Object Qfc_result_match; */ /* FcResultMatch */ +Lisp_Object Qfc_result_type_mismatch; /* FcResultTypeMismatch */ +Lisp_Object Qfc_result_no_match; /* FcResultNoMatch */ +Lisp_Object Qfc_result_no_id; /* FcResultNoId */ +Lisp_Object Qfc_internal_error; +Lisp_Object Vxlfd_font_name_regexp; /* #### Really needed? */ +Lisp_Object Vxft_version; +/* Lisp_Object Vfc_version; */ /* #### Should have this, too! */ +Fixnum debug_xft; /* Set to 1 enables lots of obnoxious messages. + Setting it to 2 or 3 enables even more. */ + +/**************************************************************** +* FcPattern objects * +****************************************************************/ + +static void +finalize_fc_pattern (void *header, int UNUSED (for_disksave)) +{ + struct fc_pattern *p = (struct fc_pattern *) header; + if (p->fcpatPtr) + { + FcPatternDestroy (p->fcpatPtr); + p->fcpatPtr = 0; + } +} + +static const struct memory_description fcpattern_description [] = { + /* #### nothing here, is this right?? */ + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION("fc-pattern", fc_pattern, + 0, 0, 0, finalize_fc_pattern, 0, 0, + fcpattern_description, + struct fc_pattern); + +/* + * Helper Functions + */ +static Lisp_Object make_xlfd_font_regexp (void); +static void string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os); + +/* + extract the C representation of the Lisp string STR and convert it + to the encoding used by the Fontconfig API for property and font + names. I suppose that Qnative is the right encoding, the manual + doesn't say much about this topic. This functions assumes that STR + is a Lisp string. +*/ +#define extract_fcapi_string(str) \ + ((FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((str), Qnative)) + +/* fontconfig assumes that objects (property names) are statically allocated, + and you will get bizarre results if you pass Lisp string data or strings + allocated on the stack as objects. fontconfig _does_ copy values, so we + (I hope) don't have to worry about that member. + + Probably these functions don't get called so often that the memory leak + due to strdup'ing every time we add a property would matter, but XEmacs + _is_ a long-running process. So we hash them. + + I suspect that using symbol names or even keywords does not provide + assurance that the string won't move in memory. So we hash them + ourselves; hash.c hashtables do not interpret the value pointers. */ +static FcChar8 *fc_standard_properties[] = { + "antialias", "aspect", "autohint", "charset", "dpi", "family", "file", + "foundry", "ftface", "globaladvance", "hinting", "index", "lang", + "minspace", "outline", "pixelsize", "rasterizer", "rgba", "scalable", + "scale", "size", "slant", "spacing", "style", "verticallayout", "weight", + /* obsolete after Xft v. 1 */ + "charwidth", "charheight", "core", "encoding", "render" +}; + +static struct hash_table *fc_property_name_hash_table; + +/* #### Maybe fc_intern should be exposed to LISP? The idea is that + fc-pattern-add could warn or error if the property isn't interned. */ + +static FcChar8 * +fc_intern (Lisp_Object property) +{ + const void *dummy; + FcChar8 *prop = extract_fcapi_string (property); + const void *val = gethash (prop, fc_property_name_hash_table, &dummy); + + /* extract_fcapi_string returns something alloca'd + so we can just drop the old value of prop on the floor */ + if (val) + prop = (FcChar8 *) val; + else + { + prop = FcStrCopy (prop); + puthash (prop, NULL, fc_property_name_hash_table); + } + return prop; +} + +DEFUN("fc-pattern-p", Ffc_pattern_p, 1, 1, 0, /* +Returns t if OBJECT is of type fc-pattern, nil otherwise. +*/ + (object)) +{ + return FCPATTERNP(object) ? Qt : Qnil; +} + +DEFUN("fc-pattern-create", Ffc_pattern_create, 0, 0, 0, /* +Return a new, empty fc-pattern object. +*/ + ()) +{ + fc_pattern *fcpat = + ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + + fcpat->fcpatPtr = FcPatternCreate(); + return wrap_fcpattern(fcpat); +} + +DEFUN("fc-name-parse", Ffc_name_parse, 1, 1, 0, /* +Parse an Fc font name and return its representation as a fc pattern object. +*/ + (name)) +{ + struct fc_pattern *fcpat = + ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + + CHECK_STRING(name); /* #### MEMORY LEAK!! maybe not ... */ + + fcpat->fcpatPtr = FcNameParse (extract_fcapi_string (name)); + return wrap_fcpattern(fcpat); +} + +/* #### Ga-a-ack! Xft's similar function is actually a different API. + We provide both. */ +DEFUN("fc-name-unparse", Ffc_name_unparse, 1, 1, 0, /* +Unparse an fc pattern object to a string. +*/ + (pattern)) +{ + CHECK_FCPATTERN(pattern); + { + FcChar8 *temp = FcNameUnparse(XFCPATTERN_PTR(pattern)); + Lisp_Object res = build_ext_string (temp, Qxft_font_name_encoding); + free (temp); + return res; + } +} + +#if 0 +/* #### This seems to not work? */ +DEFUN("xft-name-unparse", Fxft_name_unparse, 1, 1, 0, /* +Unparse an fc pattern object to a string (using the Xft API). +*/ + (pattern)) +{ + char temp[FCSTRLEN]; + Bool res; + + CHECK_FCPATTERN(pattern); + res = XftNameUnparse(XFCPATTERN_PTR(pattern), temp, FCSTRLEN-1); + return res ? build_ext_string (temp, Qxft_font_name_encoding) : Qnil; +} +#endif + +DEFUN("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /* +Make a copy of the fc pattern object PATTERN and return it. +*/ + (pattern)) +{ + struct fc_pattern *copy = NULL; + CHECK_FCPATTERN(pattern); + + copy = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + copy->fcpatPtr = FcPatternDuplicate(XFCPATTERN_PTR(pattern)); + return wrap_fcpattern(copy); +} + +DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /* +Add attributes to the pattern object PATTERN. PROPERTY is a string naming +the attribute to add, VALUE the value for this attribute. + +VALUE may be a string, integer, float, or symbol, in which case the value +will be added as an FcChar8[], int, double, or FcBool respectively. +*/ + (pattern, property, value)) +{ + Bool res = 0; + Extbyte *obj; + FcPattern *fcpat; + + CHECK_FCPATTERN(pattern); + CHECK_STRING(property); + + obj = fc_intern (property); + fcpat = XFCPATTERN_PTR (pattern); + + if (STRINGP(value)) + { + FcChar8 *str = (FcChar8 *) extract_fcapi_string (value); + res = FcPatternAddString (fcpat, obj, str); + } + else if (INTP(value)) + { + res = FcPatternAddInteger (fcpat, obj, XINT(value)); + } + else if (FLOATP(value)) + { + res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA(value)); + } + else if (SYMBOLP(value)) + { + res = FcPatternAddBool (fcpat, obj, !NILP(value)); + } + /* else ... maybe we should wta here? */ + + return res ? Qt : Qnil; +} + +DEFUN("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /* +Remove attribute PROPERTY from fc pattern object OBJECT. +*/ + (pattern, property)) +{ + Bool res; + + CHECK_FCPATTERN(pattern); + CHECK_STRING(property); + + res = FcPatternDel(XFCPATTERN_PTR(pattern), + extract_fcapi_string (property)); + return res ? Qt : Qnil; +} + +/* Generic interface to FcPatternGet() + * Don't support the losing symbol-for-property interface. + */ +DEFUN("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /* +From PATTERN, extract PROPERTY for the ID'th member, of type TYPE. + +PATTERN is an Xft (fontconfig) pattern object. +PROPERTY is a string naming an fontconfig font property. +Optional ID is a nonnegative integer indexing the list of values for PROPERTY + stored in PATTERN, defaulting to 0 (the first value). +Optional TYPE is a symbol, one of 'string, 'boolean, 'integer, 'float, + 'double, 'matrix, 'charset, or 'void, corresponding to the FcValue types. + ('float is an alias for 'double). + +The Lisp types returned will conform to TYPE: + string string + boolean `t' or `nil' + integer integer + double (float) float + matrix not implemented + charset not implemented + void not implemented + +Symbols with names of the form "fc-result-DESCRIPTION" are returned when +the desired value is not available. These are + + fc-result-type-mismatch the value found has an unexpected type + fc-result-no-match there is no such attribute + fc-result-no-id there is no value for the requested ID + +The types of the following standard properties are predefined by fontconfig. +The symbol 'fc-result-type-mismatch will be returned if the object exists but +TYPE does not match the predefined type. It is best not to specify a type +for predefined properties, as a mistake here ensures error returns on the +correct type. + +Each standard property has a convenience accessor defined in fontconfig.el, +named in the form "fc-pattern-get-PROPERTY". The convenience functions are +preferred to `fc-pattern-get' since a typo in the string naming a property +will result in a silent null return, while a typo in a function name will +usually result in a compiler or runtime \"not fboundp\" error. You may use +`defsubst' to define convenience functions for non-standard properties. + +family String Font family name +style String Font style. Overrides weight and slant +slant Int Italic, oblique or roman +weight Int Light, medium, demibold, bold or black +size Double Point size +aspect Double Stretches glyphs horizontally before hinting +pixelsize Double Pixel size +spacing Int Proportional, monospace or charcell +foundry String Font foundry name +antialias Bool Whether glyphs can be antialiased +hinting Bool Whether the rasterizer should use hinting +verticallayout Bool Use vertical layout +autohint Bool Use autohinter instead of normal hinter +globaladvance Bool Use font global advance data +file String The filename holding the font +index Int The index of the font within the file +ftface FT_Face Use the specified FreeType face object +rasterizer String Which rasterizer is in use +outline Bool Whether the glyphs are outlines +scalable Bool Whether glyphs can be scaled +scale Double Scale factor for point->pixel conversions +dpi Double Target dots per inch +rgba Int unknown, rgb, bgr, vrgb, vbgr, none - subpixel geometry +minspace Bool Eliminate leading from line spacing +charset CharSet Unicode chars encoded by the font +lang String List of RFC-3066-style languages this font supports + +The FT_Face, Matrix, CharSet types are unimplemented, so the corresponding +properties are not accessible from Lisp at this time. If the value of a +property returned has type FT_Face, FcCharSet, or FcMatrix, +`fc-result-type-mismatch' is returned. + +The following properties which were standard in Xft v.1 are obsolete in +Xft v.2: encoding, charwidth, charheight, core, and render. */ + (pattern, property, id, type)) +{ + FcChar8 *fc_property; /* UExtbyte * */ + FcResult fc_result; + FcValue fc_value; + + /* + process arguments + */ + CHECK_FCPATTERN (pattern); + +#if 0 + /* Don't support the losing symbol-for-property interface. */ + property = SYMBOLP (property) ? symbol_name (XSYMBOL (property)) : property; +#endif + if (STRINGP (property)) + { + fc_property = (FcChar8 *) extract_fcapi_string (property); + } + else + { + /* if we allow symbols, this would need to be + list3 (Qlambda, list1 (Qobject), + list3 (Qor, list2 (Qstringp, Qobject), + list2 (Qsymbolp, Qobject))) + or something like that? */ + dead_wrong_type_argument (Qstringp, property); + } + + if (!NILP (id)) CHECK_NATNUM (id); + if (!NILP (type)) CHECK_SYMBOL (type); + + /* get property */ + fc_result = FcPatternGet (XFCPATTERN_PTR (pattern), + fc_property, + NILP (id) ? 0 : XINT(id), + &fc_value); + + switch (fc_result) + { + case FcResultMatch: + /* wrap it and return */ + switch (fc_value.type) + { + case FcTypeInteger: + return ((!NILP (type) && !EQ (type, Qinteger)) + ? Qfc_result_type_mismatch : make_int (fc_value.u.i)); + case FcTypeDouble: + return ((!NILP (type) && !EQ (type, intern ("double")) + && !EQ (type, Qfloat)) + ? Qfc_result_type_mismatch : make_float (fc_value.u.d)); + case FcTypeString: + return ((!NILP (type) && !EQ (type, Qstring)) + ? Qfc_result_type_mismatch + : build_ext_string (fc_value.u.s, Qxft_font_name_encoding)); + case FcTypeBool: + return ((!NILP (type) && !EQ (type, Qboolean)) + ? Qfc_result_type_mismatch : fc_value.u.b ? Qt : Qnil); + case FcTypeMatrix: + return Qfc_result_type_mismatch; + /* #### unimplemented + return ((!NILP (type) && !EQ (type, intern ("matrix"))) + ? Qfc_result_type_mismatch : make_int (fc_value.u.m)); + */ + case FcTypeCharSet: + return Qfc_result_type_mismatch; + /* #### unimplemented + return ((!NILP (type) && !EQ (type, intern ("charset"))) + ? Qfc_result_type_mismatch : make_int (fc_value.u.c)); + */ + } + case FcResultTypeMismatch: + return Qfc_result_type_mismatch; + case FcResultNoMatch: + return Qfc_result_no_match; + case FcResultNoId: + return Qfc_result_no_id; + default: + return Qfc_internal_error; + } +} + +#if 0 +/* #### delete this after some testing!! don't forget the DEFSUBR */ +/* #### This is a big mistake, no? --- crap, there's no implicit finalizer */ +DEFUN("fc-pattern-destroy", Ffc_pattern_destroy, 1, 1, 0, /* +Explicitly deallocate a fc pattern object PATTERN. */ + (pattern)) +{ + CHECK_FCPATTERN(pattern); + + /* paranoia strikes deep */ + if (XFCPATTERN_PTR(pattern)) + { + FcPatternDestroy(XFCPATTERN_PTR(pattern)); + XFCPATTERN_PTR(pattern) = 0; + } + return Qnil; +} +#endif + +DEFUN("fc-font-match", Ffc_font_match, 2, 2, 0, /* +Return the font on DEVICE that most closely matches PATTERN. + +DEVICE is an X11 device. +PATTERN is a fontconfig pattern object. +Returns a fontconfig pattern object representing the closest match to the +given pattern, or an error code. Possible error codes are +`fc-result-no-match' and `fc-result-no-id'. */ + (device, pattern)) +{ + Display *dpy; + FcResult res; + + struct fc_pattern *res_fcpat = + ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + CHECK_FCPATTERN(pattern); /* #### MEMORY LEAKS!!! */ + if (NILP(device)) + return Qnil; + CHECK_X_DEVICE(device); + if (!DEVICE_LIVE_P(XDEVICE(device))) + return Qnil; + + dpy = DEVICE_X_DISPLAY(XDEVICE(device)); + /* More Xft vs fontconfig brain damage? */ + res_fcpat->fcpatPtr = XftFontMatch(dpy, DefaultScreen (dpy), + XFCPATTERN_PTR(pattern), &res); + + if (res_fcpat->fcpatPtr == NULL) + switch (res) { + case FcResultNoMatch: + return Qfc_result_no_match; + case FcResultNoId: + return Qfc_result_no_id; + default: + return Qfc_internal_error; + } + else + return wrap_fcpattern(res_fcpat); +} + +/* NOTE NOTE NOTE This function destroys the FcFontSet passed to it. */ +static Lisp_Object +fontset_to_list (FcFontSet *fontset) +{ + int idx; + Lisp_Object fontlist = Qnil; + fc_pattern *fcpat; + + /* #### improve this error message */ + if (!fontset) + Fsignal (Qinvalid_state, + list1 (build_string ("failed to create FcFontSet"))); + for (idx = 0; idx < fontset->nfont; ++idx) + { + fcpat = + ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]); + fontlist = Fcons (wrap_fcpattern(fcpat), fontlist); + } + FcFontSetDestroy (fontset); + return fontlist; +} + +/* #### fix this name to correspond to Ben's new nomenclature */ +DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects, + 3, 3, 0, /* +Return a list of fonts on DEVICE that match PATTERN for PROPERTIES. +Each font is represented by a fontconfig pattern object. + +DEVICE is an X11 device. +PATTERN is a fontconfig pattern to be matched. +PROPERTIES is a list of property names (strings) that should match. + +#### DEVICE is unused, ignored, and may be removed if it's not needed to +match other font-listing APIs. */ + (UNUSED (device), pattern, properties)) +{ + FcObjectSet *os; + FcFontSet *fontset; + + CHECK_FCPATTERN (pattern); + CHECK_LIST (properties); + + os = FcObjectSetCreate (); + string_list_to_fcobjectset (properties, os); + /* #### why don't we need to do the "usual substitutions"? */ + fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os); + FcObjectSetDestroy (os); + + return fontset_to_list (fontset); + +} + +/* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */ +DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /* +Return a list of all fonts sorted by proximity to PATTERN. +Each font is represented by a fontconfig pattern object. + +DEVICE is an X11 device. +PATTERN is a fontconfig pattern to be matched. +Optional argument TRIM, if non-nil, means to trim trailing fonts that do not +contribute new characters to the union repertoire. + +#### Optional argument NOSUB, if non-nil, suppresses some of the usual +property substitutions. DON'T USE THIS in production code, it is intended +for exploring behavior of fontconfig and will be removed when this code is +stable. + +#### DEVICE is unused, ignored, and may be removed if it's not needed to +match other font-listing APIs. */ + (UNUSED (device), pattern, trim, nosub)) +{ + CHECK_FCPATTERN (pattern); + + { + FcConfig *fcc = FcConfigGetCurrent(); + FcFontSet *fontset; + FcPattern *p = XFCPATTERN_PTR (pattern); + FcResult fcresult; + + if (NILP(nosub)) /* #### temporary debug hack */ + FcDefaultSubstitute (p); + FcConfigSubstitute (fcc, p, FcMatchPattern); + fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult); + + return fontset_to_list (fontset); + } +} + +/* #### this actually is an Xft function, should split those out + or get rid of them entirely? */ +/* #### be consistent about argument order. */ +DEFUN("fc-font-real-pattern", Ffc_font_real_pattern, 2, 2, 0, /* +Temporarily open FONTNAME (a string) and return the actual +fc pattern matched by the Fc library. */ + (fontname, xdevice)) +{ + FcPattern *copy; + Display *dpy; + XftFont *font; + struct fc_pattern *fcpat = + ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + + CHECK_STRING (fontname); /* #### MEMORY LEAK?! maybe not ... */ + if (NILP(xdevice)) + return Qnil; + CHECK_X_DEVICE (xdevice); + if (!DEVICE_LIVE_P(XDEVICE(xdevice))) + return Qnil; + + /* #### these gymnastics should be unnecessary, just use FcFontMatch */ + dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice)); + font = XftFontOpenName (dpy, DefaultScreen(dpy), + extract_fcapi_string (fontname)); + if (font == NULL) + return Qnil; + copy = FcPatternDuplicate(font->pattern); + XftFontClose(dpy, font); + if (copy == NULL) + return Qnil; + fcpat->fcpatPtr = copy; + return wrap_fcpattern(fcpat); +} + +DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /* +Check whether the string FONTNAME is a XLFD font name. */ + (fontname)) +{ + CHECK_STRING(fontname); + /* #### should bind `case-fold-search' here? */ + return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil); +} + +/* FcPatternPrint: there is no point in having wrappers fc-pattern-print, + Ffc_pattern_print since this function prints to stdout. */ + +/* Initialization of xft-fonts */ + +#define XE_XLFD_SEPARATOR "-" + /* XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII + in Mule when this function is called. So use HPC. */ +#if 0 +#define XE_XLFD_PREFIX "\\(\\+[\040-\176\240-\377]*\\)?-" +#define XE_XLFD_OPT_TEXT "\\([\040-\044\046-\176\240-\377]*\\)" +#define XE_XLFD_TEXT "\\([\040-\044\046-\176\240-\377]+\\)" +#else +#define XE_XLFD_PREFIX "\\(\\+[\040-\176]*\\)?-" +#define XE_XLFD_OPT_TEXT "\\([^-]*\\)" +#define XE_XLFD_TEXT "\\([^-]+\\)" +#endif + +#define XE_XLFD_SLANT "\\([0-9ior?*][iot]?\\)" +#define XE_XLFD_SPACING "\\([cmp?*]\\)" + /* Hyphen as minus conflicts with use as separator. */ +#define XE_XLFD_OPT_NEGATE "~?" +#define XE_XLFD_NUMBER "\\([0-9?*]+\\)" +#define XE_XLFD_PSIZE "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)" + +/* Call this only from the init code + #### This is really horrible, let's get rid of it, please. */ +static Lisp_Object +make_xlfd_font_regexp (void) +{ + struct gcpro gcpro1; + unsigned i; + Lisp_Object reg = Qnil; + const Extbyte *re[] = /* #### This could just be catenated by + cpp and passed to build_ext_string. */ + { + /* Regular expression matching XLFDs as defined by XLFD v. 1.5. + Matches must be case-insensitive. + PSIZE is a pixel or point size, which may be a "matrix". The + syntax of a matrix is not checked, just some lexical properties. + AFAICT none of the TEXT fields except adstyle is optional. + + NB. It should not be a problem if this matches "too much", since + an "old" server will simply not be able to find a matching font. */ + "\\`", + XE_XLFD_PREFIX, /* prefix */ + XE_XLFD_TEXT, /* foundry */ + XE_XLFD_SEPARATOR, + XE_XLFD_TEXT, /* family */ + XE_XLFD_SEPARATOR, + XE_XLFD_TEXT, /* weight */ + XE_XLFD_SEPARATOR, + XE_XLFD_SLANT, /* slant */ + XE_XLFD_SEPARATOR, + XE_XLFD_TEXT, /* swidth */ + XE_XLFD_SEPARATOR, + XE_XLFD_OPT_TEXT, /* adstyle */ + XE_XLFD_SEPARATOR, + XE_XLFD_PSIZE, /* pixelsize */ + XE_XLFD_SEPARATOR, + XE_XLFD_PSIZE, /* pointsize */ + XE_XLFD_SEPARATOR, + XE_XLFD_NUMBER, /* resx */ + XE_XLFD_SEPARATOR, + XE_XLFD_NUMBER, /* resy */ + XE_XLFD_SEPARATOR, + XE_XLFD_SPACING, /* spacing */ + XE_XLFD_SEPARATOR, + XE_XLFD_OPT_NEGATE, /* avgwidth */ + XE_XLFD_NUMBER, + XE_XLFD_SEPARATOR, + XE_XLFD_TEXT, /* registry */ + XE_XLFD_SEPARATOR, + XE_XLFD_TEXT, /* encoding */ + "\\'" + }; + + GCPRO1 (reg); + for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++) + { + /* #### Currently this is Host Portable Coding, not ISO 8859-1. */ + reg = concat2(reg, build_ext_string (re[i], Qx_font_name_encoding)); + } + + RETURN_UNGCPRO (reg); +} +#undef XE_XLFD_SEPARATOR +#undef XE_XLFD_PREFIX +#undef XE_XLFD_OPT_TEXT +#undef XE_XLFD_TEXT +#undef XE_XLFD_OPT_SLANT +#undef XE_XLFD_OPT_SPACING +#undef XE_XLFD_OPT_NEGATE +#undef XE_XLFD_NUMBER +#undef XE_XLFD_PSIZE + +#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ + ? ((unsigned long) (x)) : ((unsigned long) (y))) + +static void +string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os) +{ + EXTERNAL_LIST_LOOP_2 (elt, list) + { + FcChar8 *s; + + CHECK_STRING (elt); + s = fc_intern (elt); + fprintf (stderr, "%s\n", s); + FcObjectSetAdd (os, s); + } +} + +void +syms_of_xft_fonts (void) +{ + INIT_LRECORD_IMPLEMENTATION(fc_pattern); + + DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp); + + DEFSYMBOL(Qfc_result_type_mismatch); + DEFSYMBOL(Qfc_result_no_match); + DEFSYMBOL(Qfc_result_no_id); + DEFSYMBOL(Qfc_internal_error); + DEFSYMBOL(Qxft_font); + + DEFSUBR(Ffc_pattern_p); + DEFSUBR(Ffc_pattern_create); + DEFSUBR(Ffc_name_parse); + DEFSUBR(Ffc_name_unparse); + DEFSUBR(Fxft_name_unparse); /* URK! */ + DEFSUBR(Ffc_pattern_duplicate); + DEFSUBR(Ffc_pattern_add); + DEFSUBR(Ffc_pattern_del); + DEFSUBR(Ffc_pattern_get); +#if 0 + DEFSUBR(Ffc_pattern_destroy); +#endif + DEFSUBR(Ffc_list_fonts_pattern_objects); + DEFSUBR(Ffc_font_sort); + DEFSUBR(Ffc_font_match); + DEFSUBR(Ffc_font_real_pattern); + DEFSUBR(Fxlfd_font_name_p); +} + +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. +*/ ); + Vxft_version = make_int(XFT_VERSION); + + Fprovide (intern ("xft")); +} + +void +complex_vars_of_xft_fonts (void) +{ + DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /* +The regular expression used to match XLFD font names. */ + ); + Vxlfd_font_name_regexp = make_xlfd_font_regexp(); +} + +void +reinit_vars_of_xft_fonts (void) +{ + int i, size = (int) countof (fc_standard_properties); + + FcInit (); + + fc_property_name_hash_table = make_string_hash_table (size); + for (i = 0; i < size; ++i) + puthash (fc_standard_properties[i], NULL, fc_property_name_hash_table); +} + 1.2 +71 -0 XEmacs/xemacs/src/xft-fonts.h Index: xft-fonts.h =================================================================== RCS file: xft-fonts.h diff -N xft-fonts.h --- /dev/null Sat Nov 26 12:46:04 2005 +++ /tmp/cvsAAAWjaG_X Sat Nov 26 12:46:18 2005 ＠＠ -0,0 +1,71 ＠＠ +/* Lisp font data structures for X and Xft. + +Copyright (C) 2003 Eric Knauel and Matthias Neubauer +Copyright (C) 2005 Eric Knauel +Copyright (C) 2004, 2005 Free Software Foundation, Inc. + +Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de&gt; + Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de&gt; + Stephen J. Turnbull <stephen(a)xemacs.org&gt; +Created: 27 Oct 2003 +Updated: 05 Mar 2005 by Stephen J. Turnbull + +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 GNU Emacs. */ + +/* This module provides the Lisp interface to fonts in X11, including Xft, + but (at least at first) not GTK+ or Qt. + + It should be renamed to fonts-x.h. + + Sealevel code should be in ../lwlib/lwlib-fonts.h or + ../lwlib/lwlib-colors.h. +*/ + + +#ifndef INCLUDED_xft_fonts_h_ +#define INCLUDED_xft_fonts_h_ + +#include "../lwlib/lwlib-fonts.h" +#include "../lwlib/lwlib-colors.h" + +extern Fixnum debug_xft; + +/* Standard for fontconfig. Use a macro to show we're not guessing. */ +#define Qxft_font_name_encoding Qutf_8 + +#define XE_XLFD_MAKE_LISP_STRING(s) (make_string(s, strlen(s))) + +struct fc_pattern +{ + struct LCRECORD_HEADER header; + FcPattern *fcpatPtr; +}; + +typedef struct fc_pattern fc_pattern; + +DECLARE_LRECORD(fc_pattern, struct fc_pattern); +#define XFCPATTERN(x) XRECORD (x, fc_pattern, struct fc_pattern) +#define wrap_fcpattern(p) wrap_record (p, fc_pattern) +#define FCPATTERNP(x) RECORDP (x, fc_pattern) +#define CHECK_FCPATTERN(x) CHECK_RECORD (x, fc_pattern) +#define CONCHECK_FCPATTERN(x) CONCHECK_RECORD (x, fc_pattern) +#define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr) + +#endif /* INCLUDED_xft_fonts_h_ */ 1.72 +8 -3 XEmacs/xemacs/man/internals/internals.texi Index: internals.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/man/internals/internals.texi,v retrieving revision 1.71 retrieving revision 1.72 diff -u -p -r1.71 -r1.72 --- internals.texi 2005/11/16 11:54:10 1.71 +++ internals.texi 2005/11/26 11:46:22 1.72 ＠＠ -5114,10 +5114,15 ＠＠ are constants whose value is a symbol. be derived from the name of the symbol using the same rules as for Lisp primitives. Such variables allow the C code to check whether a particular ＠code{Lisp_Object} is equal to a given symbol. Symbols are -Lisp objects, so these variables may be passed to Lisp primitives. (An -alternative to the use of ＠samp{Q...} variables is to call the +Lisp objects, so these variables may be passed to Lisp primitives. (A +tempting alternative to the use of ＠samp{Q...} variables is to call the ＠code{intern} function at initialization in the -＠code{vars_of_＠var{module}} function, which is hardly less efficient.) +＠code{vars_of_＠var{module}} function. But this does not +＠code{staticpro} the symbol, which in theory could get uninterned, and +then garbage collected while you're not looking. You could +＠code{staticpro} yourself, but in a production XEmacs ＠code{intern} and +＠code{staticpro} is all that ＠code{DEFSYMBOL} does, while in a debugging +XEmacs it also does some error-checking, which you normally want.) ＠strong{Convention}: Global variables whose names begin with ＠samp{V} are variables that contain Lisp objects. The convention here is that 1.3 +1 -0 XEmacs/xemacs/tests/autoconf/regressiontest.pl Index: regressiontest.pl =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/tests/autoconf/regressiontest.pl,v retrieving revision 1.2 retrieving revision 1.3 diff -u -p -r1.2 -r1.3 --- regressiontest.pl 2005/03/11 11:20:34 1.2 +++ regressiontest.pl 2005/11/26 11:46:25 1.3 ＠＠ -83,6 +83,7 ＠＠ my %config_args = "--libdir=/tmp/foo" => undef, "--exec-prefix=/tmp/foo" => undef, "--with-athena=3d" => undef, + "--with-mule --with-xft=emacs --debug --error-checking=all --with-xim=xlib --with-widgets=athena --with-athena=3d --with-dialogs=athena --memory-usage-stats --use-number-lib=gmp --site-prefixes=/opt/local:/sw --with-ldap=no --use-union-type" => "--enable-mule --with-xft=emacs --enable-debug --enable-error-checking=all --with-xim=xlib --enable-widgets=athena --with-athena=3d --enable-dialogs=athena --enable-memory-usage-stats --enable-bignum=gmp --with-site-prefixes=/opt/local:/sw --with-ldap=no --enable-union-type" ); die "Usage: $0 /path/to/configure-2.13 /path/to/configure-2.59\n" if scalar(＠ARGV) != 2;