diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/configure.in xemacs.cvs.xft/configure.in --- xemacs.cvs.orig/configure.in Tue Jul 29 14:50:11 2003 +++ xemacs.cvs.xft/configure.in Fri Aug 8 22:35:51 2003 @@ -371,6 +371,7 @@ with_site_modules='yes' need_modules_common='' with_menubars='' +with_xft_menubars='no' with_scrollbars='' with_widgets='' with_dialogs='' @@ -528,6 +529,7 @@ with_hesiod | \ with_dnet | \ with_infodock | \ + with_xft | \ with_netinstall | \ with_ipv6_cname | \ external_widget | \ @@ -825,6 +827,7 @@ l | lu | luc | luci | lucid ) val=lucid ;; mo | mot | moti | motif ) val=motif ;; a | at | ath | athe | athen | athena ) val=athena ;; + x | xf | xft ) val=xft ;; n | no | non | none ) val=no ;; y | ye | yes ) val=yes ;; dnl Explicit --with-widgets on command line means yes. @@ -3037,6 +3040,16 @@ fi fi + dnl include xft/AA support? + + if test "$with_xft" = "yes"; then + AC_CHECK_LIB(Xrender, XRenderQueryExtension, XE_PREPEND(-lXrender, libs_x), + [USAGE_ERROR(["Unable to find libXrender for --with-xft"])]) + AC_CHECK_LIB(Xft, XftFontOpen, XE_PREPEND(-lXft, libs_x), + [USAGE_ERROR(["Unable to find libXft for --with-xft"])]) + AC_DEFINE(USE_XFT) + fi + fi dnl $with_x11 = yes if test "$with_msw" != "no"; then @@ -3775,6 +3788,15 @@ case "$with_menubars" in "" | "yes" | "athena" ) with_menubars="lucid" ;; esac + +dnl "$with_menubars" = "xft" +if test "$with_menubars" = "xft" ; then + if test "$with_xft" = "yes" ; then + with_xft_menubars="yes" + fi + with_menubars="lucid" +fi + case "$with_dialogs" in "" | "yes" | "lucid" ) if test "$have_motif" = "yes"; then with_dialogs="motif" elif test "$have_xaw" = "yes"; then with_dialogs="athena" @@ -3880,6 +3902,8 @@ test "$with_dialogs" = "motif" && AC_DEFINE(LWLIB_DIALOGS_MOTIF) test "$with_widgets" = "motif" && AC_DEFINE(LWLIB_WIDGETS_MOTIF) +test "$with_xft_menubars" = "yes" && AC_DEFINE(USE_XFT_MENUBARS) + dnl ---------------------- dnl Mule-dependent options dnl ---------------------- @@ -4006,7 +4030,6 @@ done fi dnl with_mule - dnl At this point, we know whether we need the motif lib or not. if test "$need_motif" = "yes" ; then XE_PREPEND(-lXm, libs_x) @@ -5156,6 +5179,9 @@ if test "$with_xauth" != yes; then echo " - Xau (X authority) not available." fi + if test "$with_xft" = "yes"; then + echo " Compiling in support for Xft antialiased fonts." + fi if test "$with_xmu" != yes; then echo " - Xmu library not available; substituting equivalent routines." fi @@ -5168,6 +5194,7 @@ echo " - Athena headers location: $athena_h_path" echo " - Athena library to link: $athena_lib" fi + case "$with_menubars" in gtk ) echo " Using GTK menubars." ;; lucid ) echo " Using Lucid menubars." ;; diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/configure.usage xemacs.cvs.xft/configure.usage --- xemacs.cvs.orig/configure.usage Tue Jul 29 14:50:11 2003 +++ xemacs.cvs.xft/configure.usage Fri Aug 8 22:35:51 2003 @@ -134,6 +134,7 @@ --with-menubars=TYPE Use TYPE menubars (lucid, motif, or no). The Lucid widgets emulate Motif (mostly) but are faster. *WARNING* The Motif menubar is currently broken. + *Experimental* (xft). Xft menubar, requires --with-xft --with-scrollbars=TYPE Use TYPE scrollbars (lucid, motif, athena, or no). --with-dialogs=TYPE Use TYPE dialog boxes (lucid, motif, athena, or no). @@ -347,6 +348,7 @@ --use-kkcc Enable the use of new GC algorithms. (EXPERIMENTAL) --with-modules (*) Compile in experimental support for dynamically loaded libraries (Dynamic Shared Objects). +--with-xft Antialiased Fonts via Xft If successful, configure leaves its status in config.status. If diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lisp/dumped-lisp.el xemacs.cvs.xft/lisp/dumped-lisp.el --- xemacs.cvs.orig/lisp/dumped-lisp.el Tue Jul 29 14:50:10 2003 +++ xemacs.cvs.xft/lisp/dumped-lisp.el Fri Aug 8 22:35:52 2003 @@ -42,6 +42,7 @@ "obsolete" "specifier" "frame" ; needed by faces + (when (featurep 'x) "xft") ; 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") diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lisp/font-menu.el xemacs.cvs.xft/lisp/font-menu.el --- xemacs.cvs.orig/lisp/font-menu.el Tue Jul 29 14:50:08 2003 +++ xemacs.cvs.xft/lisp/font-menu.el Fri Aug 8 22:35:52 2003 @@ -355,8 +355,8 @@ (face-weight (aref font-data 3)) (face-slant (aref font-data 4))) - (or face-family - (signal 'error (list "couldn't parse font name for face" face))) + (or face-family + (signal 'error (list "couldn't parse font name for face" face))) ;; If this face matches the old default face in the attribute we ;; are changing, then change it to the new attribute along that diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lisp/font.el xemacs.cvs.xft/lisp/font.el --- xemacs.cvs.orig/lisp/font.el Tue Jul 29 14:50:08 2003 +++ xemacs.cvs.xft/lisp/font.el Fri Aug 8 22:35:52 2003 @@ -46,6 +46,7 @@ mswindows-font-regexp)) (require 'cl) +(require 'xft) (eval-and-compile (defvar device-fonts-cache) @@ -547,6 +548,37 @@ (defun x-font-create-object (fontname &optional device) "Return a font descriptor object for FONTNAME, appropriate for X devices." + (if (featurep 'xft-fonts) + (if (xft-xlfd-font-name-p fontname) + (x-font-create-object-core fontname device) + (x-font-create-object-xft fontname device)) + (x-font-create-object-core fontname device))) + +(defun x-font-create-object-xft (fontname &optional device) + (let* ((name fontname) + (device (or device (default-x-device))) + (pattern (xft-font-real-pattern name device)) + (font-obj (make-font)) + (family (xft-pattern-get-family pattern 0)) + (size (xft-pattern-get-size pattern 0)) + (weight (xft-pattern-get-weight pattern 0)) + (enconding (xft-pattern-get-encoding pattern 0))) + (set-font-family font-obj + (and (not (equal family 'x-xft-result-no-match)) + family)) + (set-font-size font-obj + (and (not (equal size 'x-xft-result-no-match)) + size)) + (set-font-weight font-obj + (and (not (equal weight 'x-xft-result-no-match)) + (xft-font-weight-translate-from-constant weight))) +; does not fit into Xft2 +; (set-font-encoding font-obj +; (and (not (equal enconding 'x-xft-result-no-match)) +; enconding)) + font-obj)) + +(defun x-font-create-object-core (fontname &optional device) (let ((case-fold-search t)) (if (or (not (stringp fontname)) (not (string-match font-x-font-regexp fontname))) @@ -649,6 +681,21 @@ (font-size (font-default-object-for-device (or device (selected-device))))) (defun x-font-create-name (fontobj &optional device) + (if (featurep 'xft-fonts) + (x-font-create-name-xft fontobj device) + (x-font-create-name-core fontobj device))) + +(defun x-font-create-name-xft (fontobj &optional device) + (let* ((pattern (make-xft-pattern))) + (if (font-family fontobj) + (xft-pattern-add pattern xft-font-name-property-family + (font-family fontobj))) + (if (font-size fontobj) + (xft-pattern-add pattern xft-font-name-property-size + (font-size fontobj))) + (xft-name-unparse pattern))) + +(defun x-font-create-name-core (fontobj &optional device) "Return a font name constructed from FONTOBJ, appropriate for X devices." (if (and (not (or (font-family fontobj) (font-weight fontobj) diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lisp/x-faces.el xemacs.cvs.xft/lisp/x-faces.el --- xemacs.cvs.orig/lisp/x-faces.el Tue Jul 29 14:50:10 2003 +++ xemacs.cvs.xft/lisp/x-faces.el Fri Aug 8 22:35:52 2003 @@ -66,6 +66,8 @@ '(x-get-resource-and-maybe-bogosity-check x-get-resource x-init-pointer-shape)) +(require 'xft) + (defconst x-font-regexp nil) (defconst x-font-regexp-head nil) (defconst x-font-regexp-head-2 nil) @@ -134,6 +136,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 +174,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 (xft-font-real-pattern + font (or device (default-x-device))))) + (if pattern + (let ((size (xft-pattern-get-size pattern 0)) + (copy (xft-copy-pattern-partial + pattern (list xft-font-name-property-family)))) + (xft-pattern-del copy xft-font-name-property-weight) + (xft-pattern-del copy xft-font-name-property-style) + (when copy + (or + ;; try bold font + (let ((copy-2 (xft-pattern-duplicate copy))) + (xft-pattern-add copy-2 xft-font-name-property-weight + xft-font-name-weight-bold) + (when (xft-try-font copy-2 device) + (xft-pattern-add copy-2 xft-font-name-property-size size) + (xft-name-unparse copy-2))) + ;; try black font + (let ((copy-2 (xft-pattern-duplicate copy))) + (xft-pattern-add copy-2 xft-font-name-property-weight + xft-font-name-weight-black) + (when (xft-try-font copy-2 device) + (xft-pattern-add copy-2 xft-font-name-property-size size) + (xft-name-unparse copy-2))) + ;; try demibold font + (let ((copy-2 (xft-pattern-duplicate copy))) + (xft-pattern-add copy-2 xft-font-name-property-weight + xft-font-name-weight-demibold) + (when (xft-try-font copy-2 device) + (xft-pattern-add copy-2 xft-font-name-property-size size) + (xft-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 +222,23 @@ (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 (xft-font-real-pattern + font (or device (default-x-device))))) + (when pattern + (xft-pattern-del pattern xft-font-name-property-weight) + (xft-pattern-add pattern xft-font-name-property-weight + xft-font-name-weight-medium) + (if (xft-try-font pattern device) + (xft-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 +253,53 @@ (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 (xft-font-real-pattern + font (or device (default-x-device))))) + (if pattern + (let ((size (xft-pattern-get-size pattern 0)) + (copy (xft-copy-pattern-partial + pattern (list xft-font-name-property-family)))) + (when copy + (xft-pattern-del copy xft-font-name-property-slant) + (xft-pattern-del copy xft-font-name-property-style) + (let ((pattern-oblique (xft-pattern-duplicate copy)) + (pattern-italic (xft-pattern-duplicate copy))) + (xft-pattern-add pattern-oblique xft-font-name-property-slant + xft-font-name-slant-oblique) + (xft-pattern-add pattern-italic xft-font-name-property-slant + xft-font-name-slant-italic) + (let ((have-oblique (xft-try-font pattern-oblique device)) + (have-italic (xft-try-font pattern-italic device))) + (if try-oblique-before-italic-fonts + (if have-oblique + (progn + (if size + (xft-pattern-add pattern-oblique xft-font-name-property-size size)) + (xft-name-unparse pattern-oblique)) + (if have-italic + (progn + (if size + (xft-pattern-add pattern-italic xft-font-name-property-size size)) + (xft-name-unparse pattern-italic)))) + (if have-italic + (progn + (if size + (xft-pattern-add pattern-italic xft-font-name-property-size size)) + (xft-name-unparse pattern-italic)) + (if have-oblique + (progn + (if size + (xft-pattern-add pattern-oblique xft-font-name-property-size size)) + (xft-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 +309,40 @@ (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 (xft-font-real-pattern + font (or device (default-x-device))))) + (when pattern + (xft-pattern-del pattern xft-font-name-property-slant) + (xft-pattern-add pattern xft-font-name-property-slant + xft-font-name-slant-roman) + (if (xft-try-font pattern device) + (xft-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 +376,21 @@ 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 (xft-font-real-pattern + font (default-x-device)))) + (when pattern + (let ((pixelsize (xft-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 +509,29 @@ 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 (xft-font-real-pattern + font (or device (default-x-device))))) + (when pattern + (let ((size (xft-pattern-get-size pattern 0))) + (if (floatp size) + (let ((copy (xft-pattern-duplicate pattern))) + (xft-pattern-del copy xft-font-name-property-size) + (xft-pattern-add copy xft-font-name-property-size + (funcall new-size-proc size)) + (if (xft-try-font font device) + (xft-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 +539,16 @@ 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) diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lisp/x-font-menu.el xemacs.cvs.xft/lisp/x-font-menu.el --- xemacs.cvs.orig/lisp/x-font-menu.el Tue Jul 29 14:50:10 2003 +++ xemacs.cvs.xft/lisp/x-font-menu.el Fri Aug 8 22:35:52 2003 @@ -34,6 +34,9 @@ (require 'font-menu) +(if (featurep 'xft-fonts) + (require 'xft)) + (globally-declare-boundp '(x-font-regexp x-font-regexp-foundry-and-family x-font-regexp-spacing)) @@ -77,6 +80,68 @@ ;;;###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 xft-make-font-menu-entry (family) + (let ((weights (xft-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 (if (featurep 'mule) + (xft-find-available-font-families device) + ;; Xft2: does not work anymore + ;; (xft-find-available-font-families-non-mule device) + (xft-find-available-font-families device))) + (families (sort families-1 'string-lessp)) + (data + (vector + ;; + (mapcar 'xft-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)) + '(5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24)) + ;; + (mapcar + '(lambda (weight) + (vector + weight + `(font-menu-set-font nil ,weight nil) + ':style 'radio ':active nil ':selected nil)) + '("Light" "Medium" "Demibold" "Bold" "Black"))))) + + (setq dev-cache (assq device device-fonts-cache)) + (or dev-cache + (setq dev-cache (car (push (list device) device-fonts-cache)))) + (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 @@ -189,6 +254,45 @@ ;; get the truename and use the possibly suboptimal data from that. ;;;###autoload (defun x-font-menu-font-data (face dcache) + (if (featurep 'xft-fonts) + (x-font-menu-font-data-xft face dcache) + (x-font-menu-font-data-core face dcache))) + +(defun x-font-menu-font-data-xft (face dcache) + (let* ((domain (if font-menu-this-frame-only-p + (selected-frame) + (selected-device))) + (name (font-instance-name (face-font-instance face domain))) + (truename (font-instance-truename + (face-font-instance face domain + (if (featurep 'mule) 'ascii)))) + size weight entry slant) + (if (xft-xlfd-font-name-p truename) + (progn + nil) + (progn + (let* ((pattern (xft-font-real-pattern name domain)) + (family (and pattern + (xft-pattern-get-family pattern 0)))) + (if (xft-pattern-get-successp family) + (setq entry (vassoc family (aref dcache 0)))) + (if (null entry) + (make-vector 5 nil) + (let ((weight (xft-pattern-get-weight pattern 0)) + (size (xft-pattern-get-size pattern 0)) + (slant (xft-pattern-get-slant pattern 0))) + (vector + entry + (if (xft-pattern-get-successp family) + family) + (if (xft-pattern-get-successp size) + size) + (if (xft-pattern-get-successp weight) + (xft-font-weight-translate-to-string weight)) + (if (xft-pattern-get-successp slant) + (xft-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) @@ -223,6 +327,24 @@ (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-xft-pattern))) + (xft-pattern-add pattern xft-font-name-property-family family) + (if weight + (xft-pattern-add pattern xft-font-name-property-weight + (xft-font-weight-translate-from-string weight))) + (if size + (xft-pattern-add pattern xft-font-name-property-size size)) + (if slant + (xft-pattern-add pattern xft-font-name-property-slant + (xft-font-slant-translate-from-string slant))) + (make-font-instance (xft-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))) diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lisp/xft.el xemacs.cvs.xft/lisp/xft.el --- xemacs.cvs.orig/lisp/xft.el Thu Jan 1 01:00:00 1970 +++ xemacs.cvs.xft/lisp/xft.el Fri Aug 8 22:35:52 2003 @@ -0,0 +1,311 @@ +(defconst xft-font-name-property-family "family") +(defconst xft-font-name-property-style "style") +(defconst xft-font-name-property-slant "slant") +(defconst xft-font-name-property-weight "weight") +(defconst xft-font-name-property-size "size") +(defconst xft-font-name-property-pixelsize "pixelsize") +(defconst xft-font-name-property-spacing "spacing") +(defconst xft-font-name-property-foundry "foundry") +(defconst xft-font-name-property-antialias "antialias") +(defconst xft-font-name-property-xlfd "xlfd") +(defconst xft-font-name-property-file "file") +(defconst xft-font-name-property-index "index") +(defconst xft-font-name-property-rasterizer "rasterizer") +(defconst xft-font-name-property-outline "outline") +(defconst xft-font-name-property-scalable "scalable") +(defconst xft-font-name-property-rgba "rgba") +(defconst xft-font-name-property-minspace "minspace") +(defconst xft-font-name-property-dpi "dpi") + +; Xft2: not available anymore +; (defconst xft-font-name-property-encoding "encoding") +; (defconst xft-font-name-property-charwidth "charwidth") +; (defconst xft-font-name-property-charheight "charheight") +; (defconst xft-font-name-property-core "core") +; (defconst xft-font-name-property-render "render") + +(defconst xft-pattern-selector-mapping + `((,xft-font-name-property-family . xft-pattern-get-family) + (,xft-font-name-property-style . xft-pattern-get-style) + (,xft-font-name-property-slant . xft-pattern-get-slant) + (,xft-font-name-property-weight . xft-pattern-get-weight) + (,xft-font-name-property-size . xft-pattern-get-size) + (,xft-font-name-property-pixelsize . xft-pattern-get-pixelsize) + (,xft-font-name-property-spacing . xft-pattern-get-spacing) + (,xft-font-name-property-foundry . xft-pattern-get-foundry) + (,xft-font-name-property-antialias . xft-pattern-get-antialias) + (,xft-font-name-property-xlfd . xft-pattern-get-xlfd) + (,xft-font-name-property-file . xft-pattern-get-file) + (,xft-font-name-property-index . xft-pattern-get-index) + (,xft-font-name-property-rasterizer . xft-pattern-get-rasterizer) + (,xft-font-name-property-outline . xft-pattern-get-outline) + (,xft-font-name-property-scalable . xft-pattern-get-scalable) + (,xft-font-name-property-rgba . xft-pattern-get-rgba) + (,xft-font-name-property-minspace . xft-pattern-get-minspace) + (,xft-font-name-property-dpi . xft-pattern-get-dpi) +; Xft2: not available anymore +; (,xft-font-name-property-encoding . xft-pattern-get-encoding) +; (,xft-font-name-property-charwidth . xft-pattern-get-char-width) +; (,xft-font-name-property-charheight . xft-pattern-get-char-height) +; (,xft-font-name-property-core . xft-pattern-get-core) +; (,xft-font-name-property-render . xft-pattern-get-render) + )) + +(defvar xft-find-available-font-families-xft-fonts-only t + "If `xft-find-available-font-families-xft-fonts-only' is set to `t', +`xft-find-available-font-families' will ignore core fonts.") + +(defconst xft-font-name-slant-roman 0) +(defconst xft-font-name-slant-italic 100) +(defconst xft-font-name-slant-oblique 110) + +(defconst xft-font-name-slant-mapping + `((,xft-font-name-slant-roman . :roman) + (,xft-font-name-slant-italic . :italic) + (,xft-font-name-slant-oblique . :oblique))) + +(defconst xft-font-name-slant-mapping-string + `((,xft-font-name-slant-roman . "R") + (,xft-font-name-slant-roman . "I") + (,xft-font-name-slant-roman . "O"))) + +(defconst xft-font-name-slant-mapping-string-reverse + `(("R" . ,xft-font-name-slant-roman) + ("I" . ,xft-font-name-slant-italic) + ("O" . ,xft-font-name-slant-oblique))) + +(defconst xft-font-name-slant-mapping-reverse + `((:roman . ,xft-font-name-slant-roman) + (:italic . ,xft-font-name-slant-italic) + (:oblique . ,xft-font-name-slant-oblique))) + +(defun xft-font-slant-translate-from-constant (number) + "Translate the Xft font slant constant NUMBER to symbol." + (let ((pair (assoc number xft-font-name-slant-mapping))) + (if pair (cdr pair)))) + +(defun xft-font-slant-translate-from-symbol (symbol) + "Translate SYMBOL (`:roman', `:italic' or `:oblique') to the +correspondig Xft font slant constant." + (let ((pair (assoc symbol xft-font-name-slant-mapping-reverse))) + (if pair (cdr pair)))) + +(defun xft-font-slant-translate-to-string (num-or-sym) + (let* ((constant (if (symbolp num-or-sym) + (cdr (assoc num-or-sym xft-font-name-slant-mapping-reverse)) + num-or-sym)) + (pair (assoc constant xft-font-name-slant-mapping-string))) + (if pair (cdr pair)))) + +(defun xft-font-slant-translate-from-string (str) + (let ((pair (assoc str xft-font-name-slant-mapping-string-reverse))) + (if pair (cdr pair)))) + +(defconst xft-font-name-weight-light 0) +(defconst xft-font-name-weight-medium 100) +(defconst xft-font-name-weight-demibold 180) +(defconst xft-font-name-weight-bold 200) +(defconst xft-font-name-weight-black 210) + +(defconst xft-font-name-weight-mapping + `((,xft-font-name-weight-light . :light) + (,xft-font-name-weight-medium . :medium) + (,xft-font-name-weight-demibold . :demibold) + (,xft-font-name-weight-bold . :bold) + (,xft-font-name-weight-black . :black))) + +(defconst xft-font-name-weight-mapping-string + `((,xft-font-name-weight-light . "Light") + (,xft-font-name-weight-medium . "Medium") + (,xft-font-name-weight-demibold . "Demibold") + (,xft-font-name-weight-bold . "Bold") + (,xft-font-name-weight-black . "Black"))) + +(defconst xft-font-name-weight-mapping-string-reverse + `(("Light" . ,xft-font-name-weight-light) + ("Medium" . ,xft-font-name-weight-medium) + ("Demibold" . ,xft-font-name-weight-demibold) + ("Bold" . ,xft-font-name-weight-bold) + ("Black" . ,xft-font-name-weight-black))) + +(defconst xft-font-name-weight-mapping-reverse + `((:light . ,xft-font-name-weight-light) + (:medium . ,xft-font-name-weight-medium) + (:demibold . ,xft-font-name-weight-demibold) + (:bold . ,xft-font-name-weight-bold) + (:black . ,xft-font-name-weight-black))) + +(defun xft-font-weight-translate-from-constant (number) + "Translate a Xft font weight constant NUMBER to symbol." + (let ((pair (assoc number xft-font-name-weight-mapping))) + (if pair (cdr pair)))) + +(defun xft-font-weight-translate-from-symbol (symbol) + "Translate SYMBOL (`:light', `:medium', `:demibold', `:bold' or +`:black') to the corresponding Xft font weight constant." + (let ((pair (assoc symbol xft-font-name-weight-mapping-reverse))) + (if pair (cdr pair)))) + +(defun xft-font-weight-translate-to-string (num-or-sym) + (let* ((constant (if (symbolp num-or-sym) + (cdr (assoc num-or-sym xft-font-name-weight-mapping-reverse)) + num-or-sym)) + (pair (assoc constant xft-font-name-weight-mapping-string))) + (if pair (cdr pair)))) + +(defun xft-font-weight-translate-from-string (str) + (let ((pair (assoc str xft-font-name-weight-mapping-string-reverse))) + (if pair (cdr pair)))) + +(defun make-xft-pattern () + "Make a Xft pattern record" + (let ((pattern (xft-pattern-create))) + (add-finalizer pattern 'xft-pattern-destroy) + pattern)) + +(defun make-xft-objectset () + "Make a Xft objectset record" + (let ((objectset (xft-objectset-create))) + (add-finalizer objectset 'xft-objectset-destroy) + objectset)) + +(defun xft-try-font (font &optional device) + "See if there is a matching Xft font." + (let ((objectset (make-xft-objectset)) + (device (or device (default-x-device))) + (pattern (if (xft-pattern-p font) + font + (xft-name-parse fontname)))) + (not (zerop + (xft-fontset-count + (xft-list-fonts-pattern-objects device pattern objectset)))))) + +(defun xft-copy-pattern-partial (pattern attribute-list) + "Copy the Xft pattern attribute in ATTRIBUTE-LIST of PATTERN + to a fresh pattern" + (let ((new (make-xft-pattern)) + (attrs attribute-list)) + ;;; We demand proper tail recursion! + (while (not (null attrs)) + (let ((get.set (xft-pattern-get/set-function (car attrs)))) + (if get.set + (let ((get (car get.set)) + (set (cdr get.set)) + ;; We demand lexical scoping!!! + (font-name-prop (car attrs))) + (funcall set new (funcall get pattern 0))))) + (setq attrs (cdr attrs))) + new)) + +(defun xft-pattern-get/set-function (font-name-prop) + "Return a cons cell containig the GET and SET function for +accessing/updating the Xft pattern attribute determined by +FONT-NAME-PROP." + ;; We demand lexical scoping!!! + (let ((pair (assoc font-name-prop xft-pattern-selector-mapping))) + (if pair + (cons (cdr pair) + (lambda (pattern val) + (xft-pattern-add pattern font-name-prop val)))))) + +(defun xft-fontset-list (fontset) + "Return the Xft pattern stored in a Xft fontset as a list." + (let ((count (- (xft-fontset-count fontset) 1)) + (patterns nil)) + (while (>= count 0) + (setq patterns (cons (xft-fontset-ref fontset count) patterns)) + (setq count (- count 1))) + patterns)) + +(defun xft-find-available-font-families (&optional device filter-fun) + "Find all available font families." + (let ((device (or device (default-x-device))) + (pattern (make-xft-pattern)) + (objectset (make-xft-objectset))) +; Xft2: does not work anymore +; (if (not xft-find-available-font-families-xft-fonts-only) +; (xft-pattern-add pattern xft-font-name-property-core t)) +; (xft-objectset-add objectset xft-font-name-property-encoding) + (xft-objectset-add objectset xft-font-name-property-family) + (xft-objectset-add objectset xft-font-name-property-style) + (let* ((all-fonts + (xft-fontset-list + (xft-list-fonts-pattern-objects device pattern objectset)))) + (xft-delete-duplicates + (mapcar + '(lambda (pattern) + (xft-pattern-get-family pattern 0)) + (if filter-fun + (xft-filter all-fonts filter-fun) + all-fonts)))))) + +; Xft2: does not work anymore +; (defun xft-find-available-font-families-non-mule (&optional device) +; (xft-find-available-font-families +; device +; '(lambda (pattern) +; (let ((encodings (xft-pattern-get-all-attributes +; pattern 'xft-pattern-get-encoding))) +; ;; Be sure that the font support ISO-8859-1 +; (member "iso8859-1" encodings))))) + +(defun xft-find-available-weights-for-family (family &optional style device) + "Find available weights for font FAMILY." + (let* ((device (or device (default-x-device))) + (pattern (make-xft-pattern)) + (objecset (make-xft-objectset))) + (xft-pattern-add pattern xft-font-name-property-family family) + (if style + (xft-pattern-add pattern xft-font-name-property-style style)) + (xft-objectset-add objecset xft-font-name-property-weight) + (mapcar + '(lambda (pattern) + (let ((xft-weight-constant (xft-pattern-get-weight pattern 0))) + (if xft-weight-constant + (xft-font-weight-translate-from-constant xft-weight-constant)))) + (xft-fontset-list + (xft-list-fonts-pattern-objects device pattern objecset))))) + +;;; DELETE-DUPLICATES and REMOVE-DUPLICATES from cl-seq.el do not +;;; seem to work on list of strings... +(defun xft-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)) + +(defun xft-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)) + +(defun xft-pattern-get-all-attributes (xft-pattern xft-pattern-get-function) + (let ((res nil) + (count 0) + (end nil)) + (while (not end) + (setq val (funcall xft-pattern-get-function xft-pattern count)) + (if (or (equal val 'x-xft-result-no-id) + (equal val 'x-xft-result-no-match)) + (setq end t) + (setq res (append res (list val)) + count (+ count 1)))) + res)) + +(defun xft-pattern-get-successp (result) + (and (not (equal result 'x-xft-result-no-match)) + (not (equal result 'x-xft-result-no-id)) + (not (equal result 'x-xft-internal-errror)))) + +; (let ((pattern (xft-font-real-pattern "Apple LiGothic" (default-x-device)))) +; (xft-pattern-print pattern) +; (xft-pattern-get-all-attributes pattern 'xft-pattern-get-encoding)) + +(provide 'xft) diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lwlib/xlwmenu.c xemacs.cvs.xft/lwlib/xlwmenu.c --- xemacs.cvs.orig/lwlib/xlwmenu.c Tue Jul 29 14:50:05 2003 +++ xemacs.cvs.xft/lwlib/xlwmenu.c Fri Aug 8 22:35:52 2003 @@ -51,6 +51,11 @@ #include #endif +#ifdef USE_XFT_MENUBARS +#include +#include "../src/xft-fonts.h" +#endif + /* simple, naive integer maximum */ #ifndef max #define max(a,b) ((a)>(b)?(a):(b)) @@ -85,8 +90,14 @@ *fontList resource set, or at least know how to deal with this. */ XtRString, (XtPointer) "-*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-1"}, #else +#ifdef USE_XFT_MENUBARS + {XtNfont, XtCFont, XtRString, sizeof (String), + offset(menu.renderFontSpec), + XtRString, (XtPointer) "-*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-1"}, +#else {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), offset(menu.font), XtRString, (XtPointer) "XtDefaultFont"}, +#endif # ifdef USE_XFONTSET /* #### Consider using the same method as for Motif; see the comment in XlwMenuInitialize(). */ @@ -372,10 +383,17 @@ 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 } @@ -416,8 +434,12 @@ # 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; @@ -453,8 +475,14 @@ 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 } @@ -769,12 +797,59 @@ #endif /* !Motif */ +#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ + ? ((unsigned long) (x)) : ((unsigned long) (y))) + +#ifdef USE_XFT_MENUBARS +static XftColor +x_xft_get_color (Display *dpy, Colormap cmap, int c, int dim) +{ + static XColor color; + 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); + allocate_nearest_color (dpy, cmap, &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; +} + +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, +#endif #ifdef NEED_MOTIF XmString string #else @@ -796,8 +871,25 @@ XmbDrawString (XtDisplay (mw), window, mw->menu.font_set, gc, x, y + mw->menu.font_ascent, string, strlen (string)); # else +#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 XDrawString (XtDisplay (mw), window, gc, x, y + mw->menu.font_ascent, string, strlen (string)); +#endif # endif /* USE_XFONTSET */ #endif @@ -808,7 +900,12 @@ 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 @@ -851,18 +948,47 @@ 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; + 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); + + 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,7 +997,11 @@ string_draw_u (XlwMenuWidget mw, Window window, int x, int y, +#ifdef USE_XFT_MENUBARS + XftColor *color, XftColor *colorBg, GC gc, +#else GC gc, +#endif #ifdef NEED_MOTIF XmString string #else @@ -893,8 +1023,13 @@ 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 +1040,37 @@ 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); +#endif #ifdef NEED_MOTIF 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 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. */ @@ -1560,23 +1710,51 @@ unsigned int binding_tab) { int y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; +#ifdef USE_XFT_MENUBARS + XftColor color, colorBg; + Display *display = XtDisplay (mw); + Colormap cmap = mw->core.colormap; +#endif GC gc; + 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 + color = x_xft_get_color (display, cmap, mw->menu.highlight_foreground, 0); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.highlight_gc; + } else if (in_menubar || val->contents) - gc = mw->menu.foreground_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.foreground, 0); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.foreground_gc; + } else - gc = mw->menu.title_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.title_foreground, 0); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.title_gc; + } /* 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)); } @@ -1626,6 +1804,11 @@ GC gc; 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; +#endif /* Draw the label string. */ if (!label_offset) @@ -1634,29 +1817,69 @@ if (highlighted) { if (val->enabled) - gc = mw->menu.highlight_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.highlight_foreground, 0); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.highlight_gc; + } else - gc = mw->menu.inactive_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.foreground, 1); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.inactive_gc; + } } else if (menu_pb) { if (val->enabled) - gc = mw->menu.button_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.button_foreground, 0); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.button_gc; + } else - gc = mw->menu.inactive_button_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.button_foreground, 1); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.inactive_button_gc; + } } else { if (val->enabled) - gc = mw->menu.foreground_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.foreground, 0); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.foreground_gc; + } else - gc = mw->menu.inactive_gc; + { +#ifdef USE_XFT_MENUBARS + color = x_xft_get_color (display, cmap, mw->menu.foreground, 1); + colorBg = x_xft_get_color (display, cmap, mw->core.background_pixel, 0); +#endif + gc = mw->menu.inactive_gc; + } } 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 +1893,13 @@ } 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 */ @@ -2615,13 +2844,19 @@ 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 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; @@ -2707,9 +2942,6 @@ 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) { @@ -2939,8 +3171,13 @@ 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 */ } @@ -3037,6 +3274,14 @@ 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_font_open_name (XtDisplay (mw), + mw->menu.renderFontSpec); +#endif + make_drawing_gcs (mw); make_shadow_gcs (mw); extract_font_extents (mw); @@ -3184,7 +3429,11 @@ || 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 ) { diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/lwlib/xlwmenuP.h xemacs.cvs.xft/lwlib/xlwmenuP.h --- xemacs.cvs.orig/lwlib/xlwmenuP.h Tue Jul 29 14:50:05 2003 +++ xemacs.cvs.xft/lwlib/xlwmenuP.h Fri Aug 8 22:35:52 2003 @@ -4,6 +4,11 @@ #include "xlwmenu.h" #include +#ifdef USE_XFT_MENUBARS +#include +#endif + + /* Elements in the stack arrays. */ typedef struct _window_state { @@ -27,7 +32,12 @@ XmFontList font_list_2; XmFontList fallback_font_list; #else +#ifdef USE_XFT_MENUBARS + String renderFontSpec; + XftFont *renderFont; +#else XFontStruct * font; +#endif # ifdef USE_XFONTSET XFontSet font_set; # endif @@ -47,6 +57,8 @@ 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; diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/Makefile.in.in xemacs.cvs.xft/src/Makefile.in.in --- xemacs.cvs.orig/src/Makefile.in.in Tue Jul 29 14:49:42 2003 +++ xemacs.cvs.xft/src/Makefile.in.in Fri Aug 8 22:35:53 2003 @@ -134,9 +134,14 @@ 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 x_gui_objs=$(gui_objs:.o=-x.o) +#ifdef USE_XFT +x_objs += xft-fonts.o +#endif #ifdef HAVE_TOOLBARS x_gui_objs += toolbar-common.o #endif + + #endif #ifdef HAVE_MS_WINDOWS diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/config.h.in xemacs.cvs.xft/src/config.h.in --- xemacs.cvs.orig/src/config.h.in Tue Jul 29 14:49:40 2003 +++ xemacs.cvs.xft/src/config.h.in Fri Aug 8 22:35:53 2003 @@ -169,6 +169,12 @@ /* Compile in support for the X window system? */ #undef HAVE_X_WINDOWS +/* Compile with support for Xft? */ +#undef USE_XFT + +/* Compile with support for Xft menubars? */ +#undef USE_XFT_MENUBARS + /* Defines for building X applications */ #ifdef HAVE_X_WINDOWS /* The following will be defined if xmkmf thinks they are necessary */ diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/console-x.h xemacs.cvs.xft/src/console-x.h --- xemacs.cvs.orig/src/console-x.h Tue Jul 29 14:49:40 2003 +++ xemacs.cvs.xft/src/console-x.h Fri Aug 8 22:35:53 2003 @@ -48,6 +48,13 @@ #include #endif +#ifdef USE_XFT +#include +#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) @@ -216,3 +223,5 @@ #endif /* HAVE_X_WINDOWS */ #endif /* INCLUDED_console_x_h_ */ + + diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/emacs.c xemacs.cvs.xft/src/emacs.c --- xemacs.cvs.orig/src/emacs.c Tue Jul 29 14:49:40 2003 +++ xemacs.cvs.xft/src/emacs.c Fri Aug 8 22:35:53 2003 @@ -1395,6 +1395,11 @@ 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 @@ -1915,6 +1920,11 @@ #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 */ diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/faces.c xemacs.cvs.xft/src/faces.c --- xemacs.cvs.orig/src/faces.c Tue Jul 29 14:49:41 2003 +++ xemacs.cvs.xft/src/faces.c Fri Aug 8 22:35:53 2003 @@ -1973,7 +1973,14 @@ Lisp_Object inst_list = Qnil; #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) - + +#ifdef USE_XFT + const Char_ASCII *fonts[] = + { + "Courier", + "*" + }; +#else const Char_ASCII *fonts[] = { /************** ISO-8859 fonts *************/ @@ -2104,6 +2111,7 @@ "-*-*-*-*-*-*-*-*-*-*-*-*-*-*", "*" }; +#endif /* USE_XFT */ const Char_ASCII **fontptr; #ifdef HAVE_X_WINDOWS diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/inline.c xemacs.cvs.xft/src/inline.c --- xemacs.cvs.orig/src/inline.c Tue Jul 29 14:49:41 2003 +++ xemacs.cvs.xft/src/inline.c Fri Aug 8 22:35:53 2003 @@ -89,6 +89,9 @@ #ifdef HAVE_X_WINDOWS #include "glyphs-x.h" +#ifdef USE_XFT +#include "xft-fonts.h" +#endif #endif #ifdef HAVE_MS_WINDOWS diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/lrecord.h xemacs.cvs.xft/src/lrecord.h --- xemacs.cvs.orig/src/lrecord.h Tue Jul 29 14:49:42 2003 +++ xemacs.cvs.xft/src/lrecord.h Fri Aug 8 22:35:53 2003 @@ -200,6 +200,9 @@ lrecord_type_glyph, lrecord_type_face, lrecord_type_database, + lrecord_type_x_xft_pattern, + lrecord_type_x_xft_objectset, + lrecord_type_x_xft_fontset, lrecord_type_tooltalk_message, lrecord_type_tooltalk_pattern, lrecord_type_ldap, diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/objects-x-impl.h xemacs.cvs.xft/src/objects-x-impl.h --- xemacs.cvs.orig/src/objects-x-impl.h Tue Jul 29 14:49:42 2003 +++ xemacs.cvs.xft/src/objects-x-impl.h Fri Aug 8 22:35:53 2003 @@ -39,11 +39,15 @@ struct x_color_instance_data { XColor color; +#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) +#define COLOR_INSTANCE_X_XFT_COLOR(c) (X_COLOR_INSTANCE_DATA (c)->xftColor) #define COLOR_INSTANCE_X_DEALLOC(c) (X_COLOR_INSTANCE_DATA (c)->dealloc_on_gc) /***************************************************************************** @@ -53,7 +57,12 @@ struct x_font_instance_data { /* X-specific information */ - XFontStruct *font; +#ifdef USE_XFT + XftFont * +#else + XFontStruct * +#endif + font; }; #define X_FONT_INSTANCE_DATA(f) ((struct x_font_instance_data *) (f)->data) diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/objects-x.c xemacs.cvs.xft/src/objects-x.c --- xemacs.cvs.orig/src/objects-x.c Tue Jul 29 14:49:42 2003 +++ xemacs.cvs.xft/src/objects-x.c Fri Aug 8 22:35:53 2003 @@ -38,6 +38,10 @@ #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; @@ -262,6 +266,9 @@ 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 +284,17 @@ 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_XFT_COLOR (c) = xftColor; +#endif + return 1; } @@ -365,10 +383,39 @@ Lisp_Object device, Error_Behavior errb) { Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - XFontStruct *xf; const Extbyte *extname; +#ifdef USE_XFT + XftFont *renderFont; +#else + XFontStruct *xf; +#endif LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding); + +#ifdef USE_XFT + renderFont = xft_font_open_name (dpy, extname); + + if (renderFont) + { + f->data = xnew (struct x_font_instance_data); + FONT_INSTANCE_TRUENAME (f) = build_string (extname); + + FONT_INSTANCE_X_FONT (f) = renderFont; + f->ascent = renderFont->ascent; + f->descent = renderFont->descent; + f->width = renderFont->max_advance_width; + f->height = renderFont->height; + f->proportional_p = 1; /* we can't recognize monospaced fonts! */ + + return 1; + } + else + { + maybe_signal_error (Qgui_error, "Couldn't load font", f->name, + Qfont, errb); + return 0; + } +#else xf = XLoadQueryFont (dpy, extname); if (!xf) @@ -451,8 +498,10 @@ !xf->all_chars_exist)); return 1; +#endif } +#ifndef USE_XFT static void x_print_font_instance (Lisp_Font_Instance *f, Lisp_Object printcharfun, @@ -461,6 +510,7 @@ write_fmt_string (printcharfun, " 0x%lx", (unsigned long) FONT_INSTANCE_X_FONT (f)->fid); } +#endif static void x_finalize_font_instance (Lisp_Font_Instance *f) @@ -472,7 +522,11 @@ { Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device)); +#ifdef USE_XFT + XftFontClose (dpy, FONT_INSTANCE_X_FONT (f)); +#else XFreeFont (dpy, FONT_INSTANCE_X_FONT (f)); +#endif } xfree (f->data); f->data = 0; @@ -767,32 +821,71 @@ x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb) { struct device *d = XDEVICE (f->device); + Display *dpy = DEVICE_X_DISPLAY (d); +#ifndef USE_XFT + Extbyte *nameext; +#endif + char* xlfd; if (NILP (FONT_INSTANCE_TRUENAME (f))) { - Display *dpy = DEVICE_X_DISPLAY (d); - { - Extbyte *nameext; +#ifdef USE_XFT - 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))) + int core; + XftPattern *pat = FONT_INSTANCE_X_FONT (f)->pattern; + XftResult res_xlfd = XftPatternGetString(pat, XFT_XLFD, 0, &xlfd); + XftResult res_core = XftPatternGetBool(pat, XFT_CORE, 0, &core); + + if (res_xlfd == XftResultTypeMismatch || res_core == XftResultTypeMismatch) { - 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; + /* we've got an Xft font! */ + char temp[XFTSTRLEN]; + int res = XftNameUnparse(XXFTPATTERN_PTR(pat), temp, XFTSTRLEN-1); + Lisp_Object name = (res ? make_string(temp, strlen(temp)) : Qnil); + Lisp_Object real_pat = Fxft_font_real_pattern (name, f->device); + + res = XftNameUnparse(XXFTPATTERN_PTR(real_pat), + temp, XFTSTRLEN-1); + if (res) + { + FONT_INSTANCE_TRUENAME (f) = make_string (temp, strlen(temp)); + return FONT_INSTANCE_TRUENAME (f); + } + else + { /* Now we're f.... */ + maybe_signal_error (Qgui_error, "Couldn't determine font truename", + Qnil, Qfont, errb); + return Qnil; + } + } + else + { + FONT_INSTANCE_TRUENAME (f) = + truename_via_XListFonts (dpy, &xlfd[0]); } +#else + nameext = &xlfd[0]; + 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)); +#endif + } + if (NILP (FONT_INSTANCE_TRUENAME (f))) + { + 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 FONT_INSTANCE_TRUENAME (f); } +#ifndef USE_XFT static Lisp_Object x_font_instance_properties (Lisp_Font_Instance *f) { @@ -800,8 +893,9 @@ int i; Lisp_Object result = Qnil; Display *dpy = DEVICE_X_DISPLAY (d); - XFontProp *props = FONT_INSTANCE_X_FONT (f)->properties; + XFontProp *props = NULL; + props = FONT_INSTANCE_X_FONT (f)->properties; for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--) { Lisp_Object name, value; @@ -851,6 +945,7 @@ } return result; } +#endif static Lisp_Object x_list_fonts (Lisp_Object pattern, Lisp_Object device) @@ -1001,10 +1096,14 @@ CONSOLE_HAS_METHOD (x, valid_color_name_p); CONSOLE_HAS_METHOD (x, initialize_font_instance); +#ifndef USE_XFT CONSOLE_HAS_METHOD (x, print_font_instance); +#endif CONSOLE_HAS_METHOD (x, finalize_font_instance); CONSOLE_HAS_METHOD (x, font_instance_truename); +#ifndef USE_XFT CONSOLE_HAS_METHOD (x, font_instance_properties); +#endif CONSOLE_HAS_METHOD (x, list_fonts); #ifdef MULE CONSOLE_HAS_METHOD (x, find_charset_font); @@ -1028,6 +1127,10 @@ 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 diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/objects-x.h xemacs.cvs.xft/src/objects-x.h --- xemacs.cvs.orig/src/objects-x.h Tue Jul 29 14:49:42 2003 +++ xemacs.cvs.xft/src/objects-x.h Fri Aug 8 22:35:53 2003 @@ -31,8 +31,15 @@ #ifdef HAVE_X_WINDOWS +#ifdef USE_XFT +EXFUN (Fxft_font_real_pattern, 2); +#endif + int allocate_nearest_color (Display *display, Colormap screen_colormap, Visual *visual, XColor *color_def); + +/* Lisp_Object Fx_font_xlfd_font_name_p; */ + #endif /* HAVE_X_WINDOWS */ #endif /* INCLUDED_objects_x_h_ */ diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/redisplay-x.c xemacs.cvs.xft/src/redisplay-x.c --- xemacs.cvs.orig/src/redisplay-x.c Tue Jul 29 14:49:42 2003 +++ xemacs.cvs.xft/src/redisplay-x.c Fri Aug 8 22:35:53 2003 @@ -72,6 +72,12 @@ int xpos, face_index findex); 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))) + +static XftColor x_xft_get_color (Display *dpy, Colormap cmap, Lisp_Object c); +#endif /* Note: We do not use the Xmb*() functions and XFontSets. @@ -215,8 +221,28 @@ /* */ /****************************************************************************/ +#ifdef USE_XFT +static int +x_xft_text_width_single_run (Display *dpy, XftFont *xft_font, struct textual_run *run) +{ + static XGlyphInfo glyphinfo; + + if (run->dimension == 2) { + XftTextExtents16 (dpy, + xft_font, + (XftChar16 *) run->ptr, run->len, &glyphinfo); + } else { + XftTextExtents8 (dpy, + xft_font, + run->ptr, run->len, &glyphinfo); + } + + return glyphinfo.xOff; +} +#endif + static int -x_text_width_single_run (struct face_cachel *cachel, struct textual_run *run) +x_text_width_single_run (struct frame *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); @@ -224,12 +250,18 @@ return fi->width * run->len; else { +#ifdef USE_XFT + struct device *d = XDEVICE (f->device); + Display *dpy = DEVICE_X_DISPLAY (d); + return x_xft_text_width_single_run(dpy, FONT_INSTANCE_X_FONT (fi), run); +#else if (run->dimension == 2) return XTextWidth16 (FONT_INSTANCE_X_FONT (fi), (XChar2b *) run->ptr, run->len); else return XTextWidth (FONT_INSTANCE_X_FONT (fi), (char *) run->ptr, run->len); +#endif } } @@ -253,7 +285,7 @@ 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; } @@ -661,11 +693,15 @@ mask = GCGraphicsExposures | GCClipMask | GCClipXOrigin | GCClipYOrigin; mask |= GCFillStyle; +#ifndef USE_XFT + /* Only set the font if it's a core font */ + /* the renderfont will be set elsewhere (not part of gc) */ if (!NILP (font)) { gcv.font = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font))->fid; mask |= GCFont; } +#endif /* evil kludge! */ if (!NILP (fg) && !COLOR_INSTANCEP (fg) && !INTP (fg)) @@ -773,8 +809,7 @@ /* General variables */ struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); - Lisp_Object 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 +825,8 @@ /* 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,12 +834,17 @@ int i; struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); - device = wrap_device (d); - window = wrap_window (w); +#ifdef USE_XFT + Colormap cmap = DEVICE_X_COLORMAP (d); + Visual *visual = DEVICE_X_VISUAL (d); + static XftColor fg, bg; + /* We probably want to cache that, but how and where? */ + /* Move it to frame-impl.h, Dude! XXX */ + XftDraw *xftDraw = XftDrawCreate (dpy, x_win, visual, cmap); +#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. */ @@ -817,11 +858,8 @@ 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)); - - nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), - Dynarr_length (buf)); + redisplay_unmap_subwindows_maybe (f, clip_start, ypos, + clip_end - clip_start, height); cursor_clip = (cursor_start >= clip_start && cursor_start < clip_end); @@ -864,9 +902,12 @@ if (bgc) XFillRectangle (dpy, x_win, bgc, clip_start, - DISPLAY_LINE_YPOS (dl), clip_end - 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); @@ -877,10 +918,11 @@ 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); + /* XDrawImageString only clears the area equal to the height of the given font. It is possible that a font is being displayed on a line taller than it is, so this would cause us to fail to @@ -896,8 +938,8 @@ 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. */ @@ -923,16 +965,25 @@ 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 = x_xft_get_color (dpy, cmap, cursor_cachel->foreground); + bg = x_xft_get_color (dpy, cmap, cursor_cachel->background); +#endif + gc = x_get_gc (d, font, cursor_cachel->foreground, + cursor_cachel->background, Qnil, Qnil); + } else if (cachel->dim) { +#ifdef USE_XFT + XColor fg2; +#endif /* Ensure the gray bitmap exists */ if (DEVICE_X_GRAY_PIXMAP (d) == None) DEVICE_X_GRAY_PIXMAP (d) = @@ -940,44 +991,103 @@ gray_width, gray_height); /* Request a GC with the gray stipple pixmap to draw dimmed text */ +#ifdef USE_XFT + fg = x_xft_get_color (dpy, cmap, cachel->foreground); + fg2.pixel = fg.pixel; + XQueryColor(dpy, cmap, &fg2); + fg2.red = MINL (65535, fg2.red * 1.5); + fg2.green = MINL (65535, fg2.green * 1.5); + fg2.blue = MINL (65535, fg2.blue * 1.5); + allocate_nearest_color (dpy, cmap, visual, &fg2); + fg.pixel = fg2.pixel; + fg.color.red = fg2.red; + fg.color.green = fg2.green; + fg.color.blue = fg2.blue; + fg.color.alpha = 0xffff; + + bg = x_xft_get_color (dpy, cmap, cachel->background); +#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]; +#ifdef USE_XFT + fg = x_xft_get_color (dpy, cmap, cachel->foreground); + bg = x_xft_get_color (dpy, cmap, cachel->background); +#endif + gc = x_get_gc (d, font, cachel->foreground, cachel->background, + Qnil, Qnil); + } +#ifdef USE_XFT + { + XftFont *renderFont = FONT_INSTANCE_X_FONT (fi); - clip_box[0].x = 0; - clip_box[0].y = 0; - clip_box[0].width = clip_end - clip_start; - clip_box[0].height = height; + if (need_clipping) + { + Region clip_reg = XCreateRegion(); + XRectangle clip_box = { clip_start, ypos, clip_end - clip_start, height }; - XSetClipRectangles (dpy, gc, clip_start, DISPLAY_LINE_YPOS (dl), - clip_box, 1, Unsorted); - } + XUnionRectWithRegion (&clip_box, clip_reg, clip_reg); + XftDrawSetClip(xftDraw, clip_reg); + XDestroyRegion(clip_reg); + } - 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 (!bgc) + { + int rect_height = FONT_INSTANCE_ASCENT(fi) + FONT_INSTANCE_DESCENT(fi); + int rect_width = x_xft_text_width_single_run (dpy, renderFont, &runs[i]); + + XftDrawRect (xftDraw, &bg, xpos, ypos, rect_width, rect_height); + } + + if (runs[i].dimension == 1) + XftDrawString8 (xftDraw, + &fg, + renderFont, + xpos, dl->ypos, + runs[i].ptr, runs[i].len); + else + XftDrawString16 (xftDraw, + &fg, + renderFont, + xpos, dl->ypos, + (XftChar16 *) runs[i].ptr, runs[i].len); + } +#else + { + 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); + } +#endif /* We draw underlines in the same color as the text. */ if (cachel->underline) { int upos, uthick; +#ifndef USE_XFT unsigned long upos_ext, uthick_ext; - XFontStruct *xfont; - - xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); + XFontStruct *xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); if (!XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &upos_ext)) upos = dl->descent / 2; else @@ -986,7 +1096,10 @@ uthick = 1; else uthick = (int) uthick_ext; - +#else + upos = dl->descent / 2; + uthick = 1; +#endif if (dl->ypos + upos < dl->ypos + dl->descent - dl->clip) { if (dl->ypos + upos + uthick > dl->ypos + dl->descent - dl->clip) @@ -1008,10 +1121,9 @@ if (cachel->strikethru) { int ascent, descent, upos, uthick; +#ifndef USE_XFT unsigned long ascent_ext, descent_ext, uthick_ext; - XFontStruct *xfont; - - xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); + XFontStruct *xfont = FONT_INSTANCE_X_FONT (fi); if (!XGetFontProperty (xfont, XA_STRIKEOUT_ASCENT, &ascent_ext)) ascent = xfont->ascent; @@ -1025,6 +1137,11 @@ uthick = 1; else uthick = (int) uthick_ext; +#else + ascent = FONT_INSTANCE_ASCENT (fi); + descent = FONT_INSTANCE_DESCENT (fi); + uthick = 1; +#endif upos = ascent - ((ascent + descent) / 2) + 1; @@ -1046,39 +1163,82 @@ /* Restore the GC */ if (need_clipping) - { - XSetClipMask (dpy, gc, None); - XSetClipOrigin (dpy, gc, 0, 0); - } +#ifdef USE_XFT + XftDrawSetClip(xftDraw, 0); +#else + { + XSetClipMask (dpy, gc, None); + XSetClipOrigin (dpy, gc, 0, 0); + } +#endif /* If we are actually superimposing the cursor then redraw with just the appropriate section highlighted. */ if (cursor_clip && !cursor && focus && cursor_cachel) +#ifdef USE_XFT { - 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); + XftFont *renderFont = FONT_INSTANCE_X_FONT (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_xft_text_width_single_run(dpy, renderFont, &runs[i]); + XftColor xft_color; + + xft_color = x_xft_get_color (dpy, cmap, cursor_cachel->background); + XftDrawRect (xftDraw, &xft_color, xpos, ypos, rect_width, rect_height); + + xft_color = x_xft_get_color (dpy, cmap, cursor_cachel->foreground); + if (runs[i].dimension == 1) + XftDrawString8 (xftDraw, + &xft_color, + renderFont, + xpos, dl->ypos, + runs[i].ptr, runs[i].len); + else + XftDrawString16 (xftDraw, + &xft_color, + renderFont, + xpos, dl->ypos, + (XftChar16 *) runs[i].ptr, runs[i].len); + } + + XftDrawSetClip(xftDraw, 0); - XSetClipMask (dpy, cgc, None); - XSetClipOrigin (dpy, cgc, 0, 0); } +#else + { + 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); + } +#endif xpos += this_width; } @@ -1126,12 +1286,12 @@ 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) @@ -1142,7 +1302,7 @@ 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); + clip_box, 1, YXBanded); } if (!focus && NILP (bar_cursor_value)) @@ -1163,6 +1323,11 @@ XSetClipOrigin (dpy, gc, 0, 0); } } + +#ifdef USE_XFT + XftDrawDestroy (xftDraw); +#endif + } void @@ -1963,6 +2128,31 @@ XSync (display, 0); } } + +#ifdef USE_XFT +static XftColor +x_xft_get_color (Display *dpy, Colormap cmap, Lisp_Object c) +{ + if (COLOR_INSTANCEP (c)) + return COLOR_INSTANCE_X_XFT_COLOR (XCOLOR_INSTANCE (c)); + else + { + static XColor color; + XftColor result; + + color.pixel = XINT (c); + XQueryColor(dpy, cmap, &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 /************************************************************************/ diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/redisplay.c xemacs.cvs.xft/src/redisplay.c --- xemacs.cvs.orig/src/redisplay.c Tue Jul 29 14:49:42 2003 +++ xemacs.cvs.xft/src/redisplay.c Fri Aug 8 22:35:53 2003 @@ -1074,7 +1074,7 @@ static prop_block_dynarr * add_ichar_rune_1 (pos_data *data, int no_contribute_to_line_height) { - struct rune rb, *crb; + struct rune *crb, rb; int width, local; if (data->start_col) @@ -4208,9 +4208,13 @@ 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--) diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/symsinit.h xemacs.cvs.xft/src/symsinit.h --- xemacs.cvs.orig/src/symsinit.h Tue Jul 29 14:49:43 2003 +++ xemacs.cvs.xft/src/symsinit.h Fri Aug 8 22:35:53 2003 @@ -155,6 +155,7 @@ void syms_of_objects_mswindows (void); void syms_of_objects_tty (void); void syms_of_objects_x (void); +void syms_of_xft_fonts (void); void syms_of_postgresql (void); void syms_of_print (void); void syms_of_process (void); @@ -392,6 +393,7 @@ void reinit_vars_of_mule_wnn (void); void vars_of_nt (void); void vars_of_objects (void); +void vars_of_xft_fonts (void); void reinit_vars_of_objects (void); void vars_of_objects_tty (void); void vars_of_objects_mswindows (void); diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/xft-fonts.c xemacs.cvs.xft/src/xft-fonts.c --- xemacs.cvs.orig/src/xft-fonts.c Thu Jan 1 01:00:00 1970 +++ xemacs.cvs.xft/src/xft-fonts.c Fri Aug 8 22:35:53 2003 @@ -0,0 +1,941 @@ +#include "xft-fonts.h" + +Lisp_Object Qx_xft_patternp; /* Do I really have to do this ??? */ +Lisp_Object Qx_xft_objectsetp; +Lisp_Object Qx_xft_fontsetp; +Lisp_Object Qx_xft_result_no_match; /* XftResultNoMatch */ +Lisp_Object Qx_xft_result_no_id; /* XftResultNoId */ +Lisp_Object Qx_xft_internal_error; +Lisp_Object Vxft_xlfd_font_regexp; +Lisp_Object Vxft_version; + +static const struct memory_description xftpattern_description [] = { + { XD_LISP_OBJECT, offsetof (struct x_xft_pattern, fontset) }, + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION("xft-pattern", x_xft_pattern, + 0, 0, 0, 0, 0, 0, + xftpattern_description, + struct x_xft_pattern); + +static const struct memory_description xftobjset_description [] = { + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION("xft-objectset", x_xft_objectset, + 0, 0, 0, 0, 0, 0, + xftobjset_description, + struct x_xft_objectset); + +static const struct memory_description xftfontset_description [] = { + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION("xft-fontset", x_xft_fontset, + 0, 0, 0, 0, 0, 0, + xftfontset_description, + struct x_xft_fontset); + +DEFUN("xft-pattern-p", Fxft_pattern_p, 1, 1, 0, /* +Returns t if OBJECT is of type xft-pattern, nil otherwise. +*/ + (object)) +{ + return XFTPATTERNP(object) ? Qt : Qnil; +} + +DEFUN("xft-objectset-p", Fxft_objectset_p, 1, 1, 0, /* +Returns t if OBJECT is of type xft-objectset, nil otherwise. +*/ + (object)) +{ + return XFTOBJECTSETP(object) ? Qt : Qnil; +} + +DEFUN("xft-fontset-p", Fxft_fontset_p, 1, 1, 0, /* +Returns t if OBJECT is of type xft-fontset, nil otherwise. +*/ + (object)) +{ + return XFTFONTSETP(object) ? Qt : Qnil; +} + +DEFUN("xft-pattern-create", Fxft_pattern_create, 0, 0, 0, /* +Create a fresh and empty xft-pattern object. +*/ + ()) +{ + x_xft_pattern *xftpat = + alloc_lcrecord_type (struct x_xft_pattern, &lrecord_x_xft_pattern); + + XXFTPATTERN_PTR(xftpat) = XftPatternCreate(); + XXFTPATTERN_FONTSET(xftpat) = Qnil; + return wrap_xftpattern(xftpat); +} + +DEFUN("xft-name-parse", Fxft_name_parse, 1, 1, 0, /* +Parse an Xft font name an return its representation as a xft pattern object. +*/ + (name)) +{ + struct x_xft_pattern *xftpat = + alloc_lcrecord_type (struct x_xft_pattern, &lrecord_x_xft_pattern); + + CHECK_STRING(name); + + XXFTPATTERN_PTR(xftpat) = XftNameParse(XSTRING_DATA(name)); + XXFTPATTERN_FONTSET(xftpat) = Qnil; + return wrap_xftpattern(xftpat); +} + +DEFUN("xft-name-unparse", Fxft_name_unparse, 1, 1, 0, /* +Unparse an xft pattern object to a string. +*/ + (xftpat)) +{ + char temp[XFTSTRLEN]; + Bool res; + + CHECK_XFTPATTERN(xftpat); + res = XftNameUnparse(XXFTPATTERN_PTR(xftpat), temp, XFTSTRLEN-1); + return res ? make_string(temp, strlen(temp)) : Qnil; +} + +DEFUN("xft-pattern-duplicate", Fxft_pattern_duplicate, 1, 1, 0, /* +Make a copy of the xft pattern object XFTPAT an return it. +*/ + (xftpat)) +{ + struct x_xft_pattern *copy = NULL; + CHECK_XFTPATTERN(xftpat); + + copy = alloc_lcrecord_type (struct x_xft_pattern, &lrecord_x_xft_pattern); + XXFTPATTERN_PTR(copy) = XftPatternDuplicate(XXFTPATTERN(xftpat)->xftpatPtr); + XXFTPATTERN_FONTSET(xftpat) = Qnil; + return wrap_xftpattern(copy); +} + +DEFUN("xft-pattern-add", Fxft_pattern_add, 3, 3, 0, /* +Add attributes to the xft pattern object XFTPAT. OBJECT is the name +of the attribute to add, VALUE the value for this attribute. +*/ + (xftpat, object, value)) +{ + Bool res; + + CHECK_XFTPATTERN(xftpat); + CHECK_STRING(object); + + if (STRINGP(value)) + { + res = XftPatternAddString(XXFTPATTERN_PTR(xftpat), + XSTRING_DATA(object), + XSTRING_DATA(value)); + return res ? Qt : Qnil; + } + + if (INTP(value)) + { + res = XftPatternAddInteger(XXFTPATTERN_PTR(xftpat), + XSTRING_DATA(object), + XINT(value)); + return res ? Qt : Qnil; + } + + if (FLOATP(value)) + { + res = XftPatternAddDouble(XXFTPATTERN_PTR(xftpat), + XSTRING_DATA(object), + (double) XFLOAT_DATA(value)); + return res ? Qt : Qnil; + } + + if (SYMBOLP(value)) + { + res = XftPatternAddBool(XXFTPATTERN_PTR(xftpat), + XSTRING_DATA(object), + !NILP(value)); + return res ? Qt : Qnil; + } + + return Qnil; +} + +DEFUN("xft-pattern-del", Fxft_pattern_del, 2, 2, 0, /* +Remove attribute OBJECT from xft pattern object OBJECT. +*/ + (xftpat, object)) +{ + Bool res; + + CHECK_XFTPATTERN(xftpat); + CHECK_STRING(object); + + res = XftPatternDel(XXFTPATTERN_PTR(xftpat), XSTRING_DATA(object)); + return res ? Qt : Qnil; +} + +/* primitives for XftPatternGet() -- returning strings */ +Lisp_Object +xft_get_pattern_string(Lisp_Object xftpat, Lisp_Object id, const char* objid) +{ + char *temp; + XftResult res; + + CHECK_XFTPATTERN(xftpat); + + res = XftPatternGetString(XXFTPATTERN_PTR(xftpat), + objid, XINT(id), &temp); + switch (res) { + case XE_XFT_RESULT_MATCH: + return make_string(temp, strlen(temp)); + case XE_XFT_RESULT_NOMATCH: + return Qx_xft_result_no_match; + case XE_XFT_RESULT_NOID: + return Qx_xft_result_no_id; + default: + return Qx_xft_internal_error; + } +} + +DEFUN("xft-pattern-get-family", Fxft_pattern_get_family, 2, 2, 0, /* +Return the family name stored in xft pattern object XFTPAT. Returns +either the family name as a string or an error code. Error codes are: +`x-xft-result-no-match' if there is no such attribute associated with +XFTPAT or `x-xft-result-no-id' if there is no value with number ID for +this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_string(xftpat, id, XFT_FAMILY); +} + +DEFUN("xft-pattern-get-style", Fxft_pattern_get_style, 2, 2, 0, /* +Return the font style stored in xft pattern object XFTPAT. Returns +either the font style name as a string or an error code. Error codes +are: `x-xft-result-no-match' if there is no such attribute associated +with XFTPAT or `x-xft-result-no-id' if there is no value with number +ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_string(xftpat, id, XFT_STYLE); +} + +#if XFT_VERSION < 2 +DEFUN("xft-pattern-get-encoding", Fxft_pattern_get_encoding, 2, 2, 0, /* +Return the font encoding stored in xft pattern object XFTPAT. Returns +either the font encoding as a string or an error code. Error codes +are: `x-xft-result-no-match' if there is no such attribute associated +with XFTPAT or `x-xft-result-no-id' if there is no value with number +ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_string(xftpat, id, XFT_ENCODING); +} +#endif + +DEFUN("xft-pattern-get-foundry", Fxft_pattern_get_foundry, 2, 2, 0, /* +Return the font foundry name stored in xft pattern object +XFTPAT. Returns either the font foundry name as a string or an error +code. Error codes are: `x-xft-result-no-match' if there is no such +attribute associated with XFTPAT or `x-xft-result-no-id' if there is +no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_string(xftpat, id, XFT_FOUNDRY); +} + +DEFUN("xft-pattern-get-xlfd", Fxft_pattern_get_xlfd, 2, 2, 0, /* +Return the font XLFD font name stored in xft pattern object +XFTPAT. Returns either the font XLFD font name as a string or an error +code. Error codes are: `x-xft-result-no-match' if there is no such +attribute associated with XFTPAT or `x-xft-result-no-id' if there is +no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_string(xftpat, id, XFT_XLFD); +} + +DEFUN("xft-pattern-get-file", Fxft_pattern_get_file, 2, 2, 0, /* +Return the font's file name stored in xft pattern object +XFTPAT. Returns either the font's file name as a string or an error +code. Error codes are: `x-xft-result-no-match' if there is no such +attribute associated with XFTPAT or `x-xft-result-no-id' if there is +no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_string(xftpat, id, XFT_FILE); +} + +DEFUN("xft-pattern-get-rasterizer", Fxft_pattern_get_rasterizer, 2, 2, 0, /* +Return the name of rasterizer used to draw the font represented by xft +pattern object XFTPAT. Returns either the rasterizer name as a string +or an error code. Error codes are: `x-xft-result-no-match' if there is +no such attribute associated with XFTPAT or `x-xft-result-no-id' if +there is no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_string(xftpat, id, XFT_RASTERIZER); +} + +/* primitives for XftPatternGet() -- returning doubles */ +Lisp_Object +xft_get_pattern_double(Lisp_Object xftpat, Lisp_Object id, const char* objid) +{ + double d; + XftResult res; + + CHECK_XFTPATTERN(xftpat); + CHECK_INT(id); + +#if XFT_VERSION > 1 + res = FcPatternGetDouble(XXFTPATTERN_PTR(xftpat), objid, XINT(id), &d); +#else + res = XftPatternGetDouble(XXFTPATTERN_PTR(xftpat), objid, XINT(id), &d); +#endif + + switch (res) { + case XE_XFT_RESULT_MATCH: + return make_float(d); + case XE_XFT_RESULT_NOMATCH: + return Qx_xft_result_no_match; + case XE_XFT_RESULT_NOID: + return Qx_xft_result_no_id; + default: + return Qx_xft_internal_error; + } +} + +DEFUN("xft-pattern-get-size", Fxft_pattern_get_size, 2, 2, 0, /* +Return the font size in points stored in xft pattern object +XFTPAT. Returns either the font size name as a float or an error +code. Error codes are: `x-xft-result-no-match' if there is no such +attribute associated with XFTPAT or `x-xft-result-no-id' if there is +no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_double(xftpat, id, XFT_SIZE); +} + +DEFUN("xft-pattern-get-pixelsize", Fxft_pattern_get_pixelsize, 2, 2, 0, /* +Return the font size in pixels stored in xft pattern object +XFTPAT. Returns either the font size name as a float or an error +code. Error codes are: `x-xft-result-no-match' if there is no such +attribute associated with XFTPAT or `x-xft-result-no-id' if there is +no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_double(xftpat, id, XFT_PIXEL_SIZE); +} + +DEFUN("xft-pattern-get-scale", Fxft_pattern_get_scale, 2, 2, 0, /* +Return the font scale stored in xft pattern object XFTPAT. Returns +either the font scale name as a float or an error code. Error codes +are: `x-xft-result-no-match' if there is no such attribute associated +with XFTPAT or `x-xft-result-no-id' if there is no value with number +ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_double(xftpat, id, XFT_SCALE); +} + +DEFUN("xft-pattern-get-dpi", Fxft_pattern_get_dpi, 2, 2, 0, /* +Return the font resolution in dpi stored in xft pattern object +XFTPAT. Returns either the font resolution as a float or an error +code. Error codes are: `x-xft-result-no-match' if there is no such +attribute associated with XFTPAT or `x-xft-result-no-id' if there is +no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_double(xftpat, id, XFT_DPI); +} + +/* primitives for XftPatternGet() -- returning integers */ +Lisp_Object +xft_get_pattern_integer(Lisp_Object xftpat, Lisp_Object id, const char* objid) +{ + int i; + XftResult res; + + CHECK_XFTPATTERN(xftpat); + CHECK_INT(id); + +#if XFT_VERSION > 1 + res = FcPatternGetInteger(XXFTPATTERN_PTR(xftpat), objid, XINT(id), &i); +#else + res = XftPatternGetInteger(XXFTPATTERN_PTR(xftpat), objid, XINT(id), &i); +#endif + + switch (res) { + case XE_XFT_RESULT_MATCH: + return make_int(i); + case XE_XFT_RESULT_NOMATCH: + return Qx_xft_result_no_match; + case XE_XFT_RESULT_NOID: + return Qx_xft_result_no_id; + default: + return Qx_xft_internal_error; + } +} + +DEFUN("xft-pattern-get-slant", Fxft_pattern_get_slant, 2, 2, 0, /* +Return the font slant value in xft pattern object XFTPAT. Returns +either the font slant value as an integer or an error code. Error +codes are: `x-xft-result-no-match' if there is no such attribute +associated with XFTPAT or `x-xft-result-no-id' if there is no value +with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_integer(xftpat, id, XFT_SLANT); +} + +DEFUN("xft-pattern-get-weight", Fxft_pattern_get_weight, 2, 2, 0, /* +Return the font weight value in xft pattern object XFTPAT. Returns +either the font weight value as an integer or an error code. Error +codes are: `x-xft-result-no-match' if there is no such attribute +associated with XFTPAT or `x-xft-result-no-id' if there is no value +with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_integer(xftpat, id, XFT_WEIGHT); +} + +DEFUN("xft-pattern-get-spacing", Fxft_pattern_get_spacing, 2, 2, 0, /* +Return the font spacing value in xft pattern object XFTPAT. Returns +either the font spacing value as an integer or an error code. Error +codes are: `x-xft-result-no-match' if there is no such attribute +associated with XFTPAT or `x-xft-result-no-id' if there is no value +with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_integer(xftpat, id, XFT_SPACING); +} + +DEFUN("xft-pattern-get-index", Fxft_pattern_get_index, 2, 2, 0, /* +Return the font index value in xft pattern object XFTPAT. Returns +either the font index value as an integer or an error code. Error +codes are: `x-xft-result-no-match' if there is no such attribute +associated with XFTPAT or `x-xft-result-no-id' if there is no value +with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_integer(xftpat, id, XFT_INDEX); +} + +DEFUN("xft-pattern-get-rgba", Fxft_pattern_get_rgba, 2, 2, 0, /* +Return the font rgba value in xft pattern object XFTPAT. Returns +either the font rgba value as an integer or an error code. Error +codes are: `x-xft-result-no-match' if there is no such attribute +associated with XFTPAT or `x-xft-result-no-id' if there is no value +with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_integer(xftpat, id, XFT_RGBA); +} + +#if XFT_VERSION < 2 +DEFUN("xft-pattern-get-char-width", Fxft_pattern_get_char_width, 2, 2, 0, /* +Return the font char width value in xft pattern object XFTPAT. Returns +either the font char width value as an integer or an error code. Error +codes are: `x-xft-result-no-match' if there is no such attribute +associated with XFTPAT or `x-xft-result-no-id' if there is no value +with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_integer(xftpat, id, XFT_CHAR_WIDTH); +} + + +DEFUN("xft-pattern-get-char-height", Fxft_pattern_get_char_height, 2, 2, 0, /* +Return the font char height value in xft pattern object +XFTPAT. Returns either the font char height value as an integer or an +error code. Error codes are: `x-xft-result-no-match' if there is no +such attribute associated with XFTPAT or `x-xft-result-no-id' if there +is no value with number ID for this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_integer(xftpat, id, XFT_CHAR_HEIGHT); +} +#endif + +/* primitives for XftPatternGet() -- returning bools */ +Lisp_Object +xft_get_pattern_bool(Lisp_Object xftpat, Lisp_Object id, const char* objid) +{ + Bool b; + XftResult res; + + CHECK_XFTPATTERN(xftpat); + CHECK_INT(id); + + res = XftPatternGetBool(XXFTPATTERN_PTR(xftpat), objid, XINT(id), &b); + switch (res) { + case XE_XFT_RESULT_MATCH: + return b ? Qt : Qnil; + case XE_XFT_RESULT_NOMATCH: + return Qx_xft_result_no_match; + case XE_XFT_RESULT_NOID: + return Qx_xft_result_no_id; + default: + /* FIXME */ + return Fsignal(Qwrong_type_argument, Qnil); + } +} + +#if XFT_VERSION < 2 +DEFUN("xft-pattern-get-core", Fxft_pattern_get_core, 2, 2, 0, /* +Returns t if xft pattern object XFTPAT represents a core font, nil or +an error code otherwise. Error codes are: `x-xft-result-no-match' if +there is no such attribute associated with XFTPAT or +`x-xft-result-no-id' if there is no value with number ID for this +attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_bool(xftpat, id, XFT_CORE); +} +#endif + +DEFUN("xft-pattern-get-antialias", Fxft_pattern_get_antialias, 2, 2, 0, /* +Returns t if xft pattern object XFTPAT represents a antialiased font, +nil or an error code otherwise. Error codes are: +`x-xft-result-no-match' if there is no such attribute associated with +XFTPAT or `x-xft-result-no-id' if there is no value with number ID for +this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_bool(xftpat, id, XFT_ANTIALIAS); +} + +DEFUN("xft-pattern-get-outline", Fxft_pattern_get_outline, 2, 2, 0, /* +Returns t if xft pattern object XFTPAT represents an outline font, nil or +an error code otherwise. Error codes are: `x-xft-result-no-match' if +there is no such attribute associated with XFTPAT or +`x-xft-result-no-id' if there is no value with number ID for this +attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_bool(xftpat, id, XFT_OUTLINE); +} + +DEFUN("xft-pattern-get-scalable", Fxft_pattern_get_scalable, 2, 2, 0, /* +Returns t if xft pattern object XFTPAT represents a scalable font, nil or +an error code otherwise. Error codes are: `x-xft-result-no-match' if +there is no such attribute associated with XFTPAT or +`x-xft-result-no-id' if there is no value with number ID for this +attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_bool(xftpat, id, XFT_SCALABLE); +} + +#if XFT_VERSION < 2 +DEFUN("xft-pattern-get-render", Fxft_pattern_get_render, 2, 2, 0, /* +Returns t if xft pattern object XFTPAT represents a render (Xft) font, +nil or an error code otherwise. Error codes are: +`x-xft-result-no-match' if there is no such attribute associated with +XFTPAT or `x-xft-result-no-id' if there is no value with number ID for +this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_bool(xftpat, id, XFT_RENDER); +} +#endif + +DEFUN("xft-pattern-get-minspace", Fxft_pattern_get_minspace, 2, 2, 0, /* +Returns t if xft pattern object XFTPAT represents a font with a +minspace, nil or an error code otherwise. Error codes are: +`x-xft-result-no-match' if there is no such attribute associated with +XFTPAT or `x-xft-result-no-id' if there is no value with number ID for +this attribute. */ + (xftpat, id)) +{ + return xft_get_pattern_bool(xftpat, id, XFT_MINSPACE); +} + +DEFUN("xft-pattern-destroy", Fxft_pattern_destroy, 1, 1, 0, /* +This function is used internally to deallocate a xft pattern +object. */ + (xftpat)) +{ + CHECK_XFTPATTERN(xftpat); + XXFTPATTERN_FONTSET(xftpat) = Qnil; + + XftPatternDestroy(XXFTPATTERN_PTR(xftpat)); + return Qnil; +} + +DEFUN("xft-font-match", Fxft_font_match, 2, 2, 0, /* +Check whether there are fonts available that match the xft pattern +XFTPAT. DEVICE is X Windows device. Returns a xft pattern object +representing the closest match to the given pattern or an error +code. Error codes are `x-xft-result-no-match' and +`x-xft-result-no-id'. */ + (device, xftpat)) +{ + Display *dpy; + XftResult res; + + struct x_xft_pattern *res_xftpat = + alloc_lcrecord_type (struct x_xft_pattern, &lrecord_x_xft_pattern); + + CHECK_XFTPATTERN(xftpat); + if (NILP(device)) + return Qnil; + CHECK_X_DEVICE(device); + if (!DEVICE_LIVE_P(XDEVICE(device))) + return Qnil; + + XXFTPATTERN_FONTSET(res_xftpat) = Qnil; + dpy = DEVICE_X_DISPLAY(XDEVICE(device)); + XXFTPATTERN_PTR(res_xftpat) = XftFontMatch(dpy, DefaultScreen (dpy), + XXFTPATTERN_PTR(xftpat), + &res); + + if (XXFTPATTERN_PTR(res_xftpat) == NULL) + switch (res) { + case XE_XFT_RESULT_NOMATCH: + return Qx_xft_result_no_match; + case XE_XFT_RESULT_NOID: + return Qx_xft_result_no_id; + default: + return Qx_xft_internal_error; + } + else + return wrap_xftpattern(res_xftpat); +} + +DEFUN("xft-objectset-create", Fxft_objectset_create, 0, 0, 0, /* +Create a fresh and empty xft object set object. */ + ()) +{ + struct x_xft_objectset *objset = + alloc_lcrecord_type(struct x_xft_objectset, &lrecord_x_xft_objectset); + + XXFTOBJECTSET_PTR(objset) = XftObjectSetCreate(); + return wrap_xftobjset(objset); +} + +DEFUN("xft-objectset-add", Fxft_objectset_add, 2, 2, 0, /* +Add OBJECT (a string) to the xft object set XFTOBJECTSET. Returns t on +success, nil on failure. */ + (xftobjset, object)) +{ + Bool r; + + CHECK_XFTOBJECTSET(xftobjset); + CHECK_STRING(object); + + r = XftObjectSetAdd(XXFTOBJECTSET_PTR(xftobjset), + XSTRING_DATA(object)); + return r ? Qt : Qnil; +} + +DEFUN("xft-objectset-destroy", Fxft_objectset_destroy, 1, 1, 0, /* +Used internally to deallocate xft objectset objects. */ + (xftobjset)) +{ + CHECK_XFTOBJECTSET(xftobjset); + XftObjectSetDestroy(XXFTOBJECTSET_PTR(xftobjset)); + return Qnil; +} + +DEFUN("xft-list-fonts-pattern-objects", Fxft_list_fonts_pattern_objects, + 3, 3, 0, /* +Given a xft pattern object XFTPAT, a xft object set object XFTOBJSET +and an X Windows device find all fonts that match XFTPAT. The result +is a xft fontset object. */ + (device, xftpat, xftobjset)) +{ + Display *dpy; + int screen; + struct x_xft_fontset *fontset = + alloc_lcrecord_type(struct x_xft_fontset, &lrecord_x_xft_fontset); + +#if XFT_VERSION > 1 + FcConfig *fcc; +#endif + + CHECK_XFTPATTERN(xftpat); + CHECK_XFTOBJECTSET(xftobjset); + if (NILP(device)) + return Qnil; + CHECK_X_DEVICE(device); + if (!DEVICE_LIVE_P(XDEVICE(device))) + return Qnil; + +#if XFT_VERSION > 1 + FcInit(); + fcc = FcConfigGetCurrent(); + + XXFTFONTSET_PTR(fontset) = + FcFontList(fcc, + XXFTPATTERN_PTR(xftpat), + XXFTOBJECTSET_PTR(xftobjset)); +#else + dpy = DEVICE_X_DISPLAY(XDEVICE(device)); + screen = DefaultScreen(dpy); + + XXFTFONTSET_PTR(fontset) = + XftListFontsPatternObjects(dpy, screen, + XXFTPATTERN_PTR(xftpat), + XXFTOBJECTSET_PTR(xftobjset)); +#endif + return wrap_xftfontset(fontset); +} + +DEFUN("xft-fontset-count", Fxft_fontset_count, 1, 1, 0, /* +Counts the number of xft pattern objects stored in the xft fontset +object XFTFONTSET. */ + (xftfontset)) +{ + CHECK_XFTFONTSET(xftfontset); + return make_int(XXFTFONTSET_PTR(xftfontset)->nfont); +} + +DEFUN("xft-fontset-ref", Fxft_fontset_ref, 2, 2, 0, /* +Return the xft pattern object at index I in xft fontset object +XFTFONTSET. Return nil if the index exceeds the bounds of +XFTFONTSET. */ + (xftfontset, i)) +{ + int idx; + x_xft_pattern *xftpat = + alloc_lcrecord_type (struct x_xft_pattern, &lrecord_x_xft_pattern); + + CHECK_XFTFONTSET(xftfontset); + CHECK_INT(i); + + idx = XINT(i); + if ((idx >= 0) && (idx < XXFTFONTSET_PTR(xftfontset)->nfont)) + { + XXFTPATTERN_PTR(xftpat) = XXFTFONTSET_PTR(xftfontset)->fonts[idx]; + XXFTPATTERN_FONTSET(xftpat) = xftfontset; + return wrap_xftpattern(xftpat); + } + else + return Qnil; +} + +DEFUN("xft-fontset-destroy", Fxft_fontset_destroy, 1, 1, 0, /* +Used internally to deallocate xft fontset objects. */ + (xftfontset)) +{ + CHECK_XFTFONTSET(xftfontset); + + XftFontSetDestroy(XXFTFONTSET_PTR(xftfontset)); + return Qnil; +} + +DEFUN("xft-font-real-pattern", Fxft_font_real_pattern, 2, 2, 0, /* +Open the fontname (a string) FONTNAME testwise an return the actual +xft pattern matched by the Xft library. */ + (fontname, xdevice)) +{ + XftPattern *copy; + Display *dpy; + XftFont *font; + struct x_xft_pattern *xftpat = + alloc_lcrecord_type (struct x_xft_pattern, &lrecord_x_xft_pattern); + + CHECK_STRING (fontname); + if (NILP(xdevice)) + return Qnil; + CHECK_X_DEVICE (xdevice); + if (!DEVICE_LIVE_P(XDEVICE(xdevice))) + return Qnil; + + dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice)); + font = XftFontOpenName (dpy, DefaultScreen(dpy), + XSTRING_DATA(fontname)); + if (font == NULL) + return Qnil; + copy = XftPatternDuplicate(font->pattern); + XftFontClose(dpy, font); + if (copy == NULL) + return Qnil; + XXFTPATTERN_PTR(xftpat) = copy; + XXFTPATTERN_FONTSET(xftpat) = Qnil; + return wrap_xftpattern(xftpat); +} + + +DEFUN("xft-xlfd-font-name-p", Fxft_xlfd_font_name_p, 1, 1, 0, /* +Check whether the string FONTNAME is a XLFD font name. */ + (fontname)) +{ + CHECK_STRING(fontname); + return Fstring_match(Vxft_xlfd_font_regexp, fontname, Qnil, Qnil); +} + +Lisp_Object make_xlfd_font_regexp (void) +{ + struct gcpro gcpro1; + int i; + Lisp_Object reg = Qnil; + const char re[XFT_XLFD_RE_COUNT][XFTSTRLEN] = + { XFT_XLFD_RE_PREFIX, + XFT_XLFD_RE_FOUNDRY, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_FAMILY, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_WEIGHT, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_SLANT, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_SWIDTH, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_ADSTYLE, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_PIXELSIZE, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_POINTSIZE, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_RESX, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_RESY, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_SPACING, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_AVGWIDTH, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_REGISTRY, + XFT_XLFD_RE_MINUS, + XFT_XLFD_RE_ENCODING + }; + + GCPRO1 (reg); + for (i = 0; i <= XFT_XLFD_RE_COUNT; i++) + reg = concat2(reg, make_string(re[i], strlen((char *) re[i]))); + + RETURN_UNGCPRO (reg); +} + +/* for debugging purposes only */ +DEFUN("xft-pattern-print", Fxft_pattern_print, 1, 1, 0, /* +Print a xft pattern object to stdout. For debugging only. */ + (xftpat)) +{ + CHECK_XFTPATTERN(xftpat); + +#if XFT_VERSION > 1 + FcPatternPrint(XXFTPATTERN_PTR(xftpat)); +#else + XftPatternPrint(XXFTPATTERN_PTR(xftpat)); +#endif + return Qnil; +} + +/* helper function to correctly open Xft/core fonts by name */ +XftFont* +xft_font_open_name (Display *dpy, char *name) +{ + XftFont *res; + + if (NILP (Fxft_xlfd_font_name_p (make_string (name, strlen (name))))) + res = XftFontOpenName (dpy, DefaultScreen (dpy), name); + else + { + XftPattern *pat = XftPatternCreate (); + /* This is the magic pattern to open core fonts ... */ + /* Dudes, I love Xft!!! */ + XftPatternAddString (pat, XFT_XLFD, name); + XftPatternAddBool (pat, XFT_CORE, True); + XftPatternAddBool (pat, XFT_SCALABLE, False); + res = XftFontOpenPattern (dpy, pat); + } + + if (res) + return res; + else + { + /* this is out last try ... */ + res = XftFontOpenName (dpy, DefaultScreen (dpy), ""); + + if (res) + return res; + else + { + /* sorry folks ... */ + abort (); + return 0; + } + } +} + +void +syms_of_xft_fonts (void) +{ + INIT_LRECORD_IMPLEMENTATION(x_xft_pattern); + INIT_LRECORD_IMPLEMENTATION(x_xft_objectset); + INIT_LRECORD_IMPLEMENTATION(x_xft_fontset); + + DEFSYMBOL_MULTIWORD_PREDICATE(Qx_xft_patternp); + DEFSYMBOL_MULTIWORD_PREDICATE(Qx_xft_objectsetp); + DEFSYMBOL_MULTIWORD_PREDICATE(Qx_xft_fontsetp); + + DEFSYMBOL(Qx_xft_result_no_match); + DEFSYMBOL(Qx_xft_result_no_id); + DEFSYMBOL(Qx_xft_internal_error); + + DEFSUBR(Fxft_pattern_p); + DEFSUBR(Fxft_objectset_p); + DEFSUBR(Fxft_fontset_p); + DEFSUBR(Fxft_pattern_create); + DEFSUBR(Fxft_name_parse); + DEFSUBR(Fxft_name_unparse); + DEFSUBR(Fxft_pattern_duplicate); + DEFSUBR(Fxft_pattern_add); + DEFSUBR(Fxft_pattern_del); + DEFSUBR(Fxft_pattern_get_family); + DEFSUBR(Fxft_pattern_get_style); + DEFSUBR(Fxft_pattern_get_foundry); + DEFSUBR(Fxft_pattern_get_xlfd); + DEFSUBR(Fxft_pattern_get_file); + DEFSUBR(Fxft_pattern_get_rasterizer); + DEFSUBR(Fxft_pattern_get_size); + DEFSUBR(Fxft_pattern_get_pixelsize); + DEFSUBR(Fxft_pattern_get_scale); + DEFSUBR(Fxft_pattern_get_dpi); + DEFSUBR(Fxft_pattern_get_slant); + DEFSUBR(Fxft_pattern_get_weight); + DEFSUBR(Fxft_pattern_get_spacing); + DEFSUBR(Fxft_pattern_get_index); + DEFSUBR(Fxft_pattern_get_rgba); + DEFSUBR(Fxft_pattern_get_antialias); + DEFSUBR(Fxft_pattern_get_outline); + DEFSUBR(Fxft_pattern_get_scalable); + DEFSUBR(Fxft_pattern_get_minspace); + DEFSUBR(Fxft_pattern_destroy); + DEFSUBR(Fxft_objectset_create); + DEFSUBR(Fxft_objectset_add); + DEFSUBR(Fxft_objectset_destroy); + DEFSUBR(Fxft_list_fonts_pattern_objects); + DEFSUBR(Fxft_fontset_count); + DEFSUBR(Fxft_fontset_ref); + DEFSUBR(Fxft_fontset_destroy); + DEFSUBR(Fxft_font_match); + DEFSUBR(Fxft_font_real_pattern); + DEFSUBR(Fxft_pattern_print); + DEFSUBR(Fxft_xlfd_font_name_p); +#if XFT_VERSION < 2 + DEFSUBR(Fxft_pattern_get_encoding); + DEFSUBR(Fxft_pattern_get_char_width); + DEFSUBR(Fxft_pattern_get_char_height); + DEFSUBR(Fxft_pattern_get_core); + DEFSUBR(Fxft_pattern_get_render); +#endif +} + +void +vars_of_xft_fonts (void) +{ + DEFVAR_LISP("xft-xlfd-font-regexp", &Vxft_xlfd_font_regexp /* +The regular expression used to match XLFD font names. */ + ); + Vxft_xlfd_font_regexp = make_xlfd_font_regexp(); + + DEFVAR_LISP("xft-version", &Vxft_version /* +The major version number of the Xft library being used */ + ); + Vxft_version = make_int(XFT_VERSION); +} diff --exclude-from=../xemacs-xft/diff-exclude -Nru xemacs.cvs.orig/src/xft-fonts.h xemacs.cvs.xft/src/xft-fonts.h --- xemacs.cvs.orig/src/xft-fonts.h Thu Jan 1 01:00:00 1970 +++ xemacs.cvs.xft/src/xft-fonts.h Fri Aug 8 22:35:54 2003 @@ -0,0 +1,124 @@ +#include +#include "lisp.h" +#include "device.h" +#include "device-impl.h" +#include "console-x-impl.h" + +#include + +#ifndef XFT_VERSION +#define XFT_VERSION 1 +#endif + +#define XFTSTRLEN 512 + +#define XFT_XLFD_RE_COUNT 28 +#define XFT_XLFD_RE_PREFIX "\\`\\*?[-?*]" +#define XFT_XLFD_RE_MINUS "[-?]" +#define XFT_XLFD_RE_FOUNDRY "[^-]*" +#define XFT_XLFD_RE_FAMILY "[^-]*" +#define XFT_XLFD_RE_WEIGHT "\\([^-]*\\)" +#define XFT_XLFD_RE_SLANT "\\([^-]?\\)" +#define XFT_XLFD_RE_SWIDTH "\\([^-]*\\)" +#define XFT_XLFD_RE_ADSTYLE "\\([^-]*\\)" +#define XFT_XLFD_RE_PIXELSIZE "\\(\\*\\|[0-9]+\\)" +#define XFT_XLFD_RE_POINTSIZE "\\(\\*\\|0\\|[0-9][0-9]+\\)" +#define XFT_XLFD_RE_RESX "\\([*0]\\|[0-9][0-9]+\\)" +#define XFT_XLFD_RE_RESY "\\([*0]\\|[0-9][0-9]+\\)" +#define XFT_XLFD_RE_SPACING "[cmp?*]" +#define XFT_XLFD_RE_AVGWIDTH "\\(\\*\\|[0-9]+\\)" +#define XFT_XLFD_RE_REGISTRY "[^-]*" +#define XFT_XLFD_RE_ENCODING "[^-]+" + +#define XFT_XLFD_MAKE_LISP_STRING(s) (make_string(s, strlen(s))) + +struct x_xft_pattern +{ + struct lcrecord_header header; + +#if XFT_VERSION > 1 + FcPattern *xftpatPtr; +#else + XftPattern *xftpatPtr; +#endif + Lisp_Object fontset; +}; + +typedef struct x_xft_pattern x_xft_pattern; + +DECLARE_LRECORD(x_xft_pattern, struct x_xft_pattern); +#define XXFTPATTERN(x) XRECORD (x, x_xft_pattern, struct x_xft_pattern) +#define wrap_xftpattern(p) wrap_record (p, x_xft_pattern) +#define XFTPATTERNP(x) RECORDP (x, x_xft_pattern) +#define CHECK_XFTPATTERN(x) CHECK_RECORD (x, x_xft_pattern) +#define CONCHECK_XFTPATTERN(x) CONCHECK_RECORD (x, x_xft_pattern) +#define XXFTPATTERN_PTR(x) (XXFTPATTERN(x)->xftpatPtr) +#define XXFTPATTERN_FONTSET(x) (XXFTPATTERN(x)->fontset) + +struct x_xft_objectset +{ + struct lcrecord_header header; + +#if XFT_VERSION > 1 + FcObjectSet *objsetPtr; +#else + XftObjectSet *objsetPtr; +#endif +}; + +typedef struct x_xft_objectset x_xft_objectset; + +DECLARE_LRECORD(x_xft_objectset, struct x_xft_objectset); +#define XXFTOBJECTSET(x) XRECORD(x, x_xft_objectset, struct x_xft_objectset) +#define wrap_xftobjset(p) wrap_record (p, x_xft_objectset) +#define XFTOBJECTSETP(x) RECORDP(x, x_xft_objectset) +#define CHECK_XFTOBJECTSET(x) CHECK_RECORD(x, x_xft_objectset) +#define CONCHECK_XFTOBJECTSET(x) CONCHECK_RECORD(x, x_xft_objectset) +#define XXFTOBJECTSET_PTR(x) (XXFTOBJECTSET(x)->objsetPtr) + +struct x_xft_fontset +{ + struct lcrecord_header header; + +#if XFT_VERSION > 1 + FcFontSet *fontsetPtr; +#else + XftFontSet *fontsetPtr; +#endif +}; + +typedef struct x_xft_fontset x_xft_fontset; + +DECLARE_LRECORD(x_xft_fontset, struct x_xft_fontset); +#define XXFTFONTSET(x) XRECORD(x, x_xft_fontset, struct x_xft_fontset) +#define wrap_xftfontset(p) wrap_record (p, x_xft_fontset) +#define XFTFONTSETP(x) RECORDP(x, x_xft_fontset) +#define CHECK_XFTFONTSET(x) CHECK_RECORD(x, x_xft_fontset) +#define CONCHECK_XFTFONTSET(x) CONCHECK_RECORD(x, x_xft_fontset) +#define XXFTFONTSET_PTR(x) (XXFTFONTSET(x)->fontsetPtr) + +#if XFT_VERSION > 1 +#define XE_XFT_RESULT_MATCH FcResultMatch +#else +#define XE_XFT_RESULT_MATCH XftResultMatch +#endif + +#if XFT_VERSION > 1 +#define XE_XFT_RESULT_NOMATCH FcResultNoMatch +#else +#define XE_XFT_RESULT_NOMATCH XftResultNoMatch +#endif + +#if XFT_VERSION > 1 +#define XE_XFT_RESULT_NOID FcResultNoId +#else +#define XE_XFT_RESULT_NOID XftResultNoId +#endif + +/* prototypes */ +XftFont* xft_font_open_name (Display *dpy, char *name); +Lisp_Object xft_get_pattern_double(Lisp_Object xftpat, Lisp_Object id, const char* objid); +Lisp_Object xft_get_pattern_integer(Lisp_Object xftpat, Lisp_Object id, const char* objid); +Lisp_Object xft_get_pattern_bool(Lisp_Object xftpat, Lisp_Object id, const char* objid); +Lisp_Object xft_get_pattern_string(Lisp_Object xftpat, Lisp_Object id, const char* objid); +Lisp_Object make_xlfd_font_regexp (void);