diff -Nru --exclude-from=diff-exclude xemacs-head-clean/ChangeLog xemacs-xft/ChangeLog --- xemacs-head-clean/ChangeLog Tue Nov 16 11:49:17 2004 +++ xemacs-xft/ChangeLog Tue Nov 16 11:49:21 2004 @@ -194,9 +194,10 @@ * configure.in: The icc compiler pretends to be gcc. It isn't. -2003-11-18 Jerry James +2003-11-22 Eric Knauel - * configure.in: Check for the typeof extension. + * configure.in (XE_COMPUTE_RUNPATH): query xft-config for libs, + include-paths if present 2003-10-15 Jerry James @@ -275,6 +276,21 @@ 2003-06-13 Stephen J. Turnbull * configure.usage (--cflags-warning): Change underscore to hyphen. + +2003-08-06 Matthias Neubauer + + * replace XRENDERFONT by XFT + +2003-08-02 Eric Knauel + + * configure.in (XE_COMPUTE_RUNPATH): check for -lXft1 first + +2003-07-30 Eric Knauel + Matthias Neubauer + + * configure.in (XE_COMPUTE_RUNPATH): added -lXrender -lXft + (XE_COMPUTE_RUNPATH): + * configure.in (AC_INIT_PARSE_ARGS): added --with-xrender 2003-06-01 Steve Youngs diff -Nru --exclude-from=diff-exclude xemacs-head-clean/configure.in xemacs-xft/configure.in --- xemacs-head-clean/configure.in Tue Nov 16 11:49:17 2004 +++ xemacs-xft/configure.in Tue Nov 16 11:49:21 2004 @@ -530,6 +530,7 @@ with_hesiod | \ with_dnet | \ with_infodock | \ + with_xft | \ with_netinstall | \ with_ipv6_cname | \ external_widget | \ @@ -3231,6 +3232,26 @@ fi fi + dnl include xft/AA support? + + if test "$with_xft" = "yes"; then + AC_CHECKING([xft-config program]) + AC_CHECK_PROG([XFT_CONFIG], [xft-config], "yes", "no", $PATH, []) + + if test "$XFT_CONFIG" = "yes"; then + AC_MSG_RESULT([found]) + XE_PREPEND(`xft-config --libs`, libs_x) + XE_PREPEND(`xft-config --cflags`, X_CFLAGS) + else + AC_MSG_RESULT([not found, checking for Xft 1.x]) + 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"])]) + fi + AC_DEFINE(USE_XFT) + fi + fi dnl $with_x11 = yes if test "$with_msw" != "no"; then @@ -5469,6 +5490,9 @@ echo " - X Windows libraries location: $x_libraries" 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." diff -Nru --exclude-from=diff-exclude xemacs-head-clean/configure.usage xemacs-xft/configure.usage --- xemacs-head-clean/configure.usage Sat Jul 31 13:25:20 2004 +++ xemacs-xft/configure.usage Sat Oct 30 09:25:17 2004 @@ -356,6 +356,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 -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/ChangeLog xemacs-xft/lisp/ChangeLog --- xemacs-head-clean/lisp/ChangeLog Tue Nov 16 11:49:18 2004 +++ xemacs-xft/lisp/ChangeLog Tue Nov 16 11:49:22 2004 @@ -518,6 +518,16 @@ function that allows searching for groups of packages. For example, find all packages that require the fsf-compat package. +2003-11-11 Eric Knauel + + * x-faces.el (x-make-font-bold): + (x-make-font-unbold): + (x-make-font-italic): + (x-make-font-bold-italic): + (x-font-size): + (x-find-smaller-font): + (x-find-larger-font): Handle arguments of type font-instance + 2003-11-05 Vin Shelton * help.el (Help-prin1-face): @@ -738,6 +748,77 @@ * font-lock.el (lisp-font-lock-keywords-1): Only NAME, not NAME( to appear in font-lock-function-name-face. + +2003-08-06 Eric Knauel + + * x-faces.el (x-make-font-bold-xft): + (x-make-font-italic-xft): Use xft-copy-pattern-partial + + * xft.el (xft-copy-pattern-partial): New functions + (xft-pattern-get/set-function): + +2003-08-01 Eric Knauel + + * xft.el (xft-find-available-font-families-non-mule): List only + fonts with iso8859-1 characters + (xft-pattern-get-all-attributes): Get all attributes for a pattern + value from a list + (xft-find-available-font-families): Added parameter `filter-fun' + + * x-font-menu.el (x-reset-device-font-menus-xft): renamed + +2003-07-31 Eric Knauel + + * font.el (x-font-create-object-xft): removed superfluos maybe-strip-xft-prefix + + * xft.el (xft-find-available-weights-for-family): Code for listing + and searching Xft fonts + (xft-fontset-list): + (xft-font-weight-translate-from-constant): + (xft-font-weight-translate-from-symbol): + (xft-find-available-font-families): + (xft-make-font-menu-entry): + (xft-make-font-menu-entries): + +2003-07-30 Eric Knauel , Matthias Neubauer + + * xft.el: New file + + * x-faces.el (xft): require xft.el + (x-make-font-bold): Handle XLFD and Xft font names seperatly + (x-make-font-bold-xft): + (x-make-font-bold-core): + (x-make-font-unbold): Handle XLFD and Xft font names seperatly + (x-make-font-unbold-xft): + (x-make-font-unbold-core): + (x-make-font-italic): Handle XLFD and Xft font names seperatly + (x-make-font-italic-xft): + (x-make-font-italic-core): + (x-make-font-unitalic): Handle XLFD and Xft font names seperatly + (x-make-font-unitalic-xft): + (x-make-font-unitalic-core): + (x-make-font-bold-italic): Handle XLFD and Xft font names seperatly + (x-make-font-bold-italic-xft): + (x-make-font-bold-italic-core): + (x-font-size): Handle XLFD and Xft font names seperatly + (x-font-size-xft): Handle XLFD and Xft font names seperatly + (x-font-size-core): + (x-find-smaller-font): Handle XLFD and Xft font names seperatly + (x-find-xft-font-of-size): Handle XLFD and Xft font names seperatly + (x-find-smaller-font-xft): + (x-find-smaller-font-core): + (x-find-larger-font): Handle XLFD and Xft font names seperatly + (x-find-larger-font-xft): + (x-find-larger-font-core): + + * font.el (x-font-create-object): Handle XLFD and Xft font names seperatly + (x-font-create-object-xft): + (x-font-create-object-core): + (x-font-create-name): Handle XLFD and Xft font names seperatly + (x-font-create-name-xft): + (x-font-create-name-core): + + * dumped-lisp.el (preloaded-file-list): preload xft.el 2003-06-01 Steve Youngs diff -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/auto-autoloads.el xemacs-xft/lisp/auto-autoloads.el diff -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/custom-load.el xemacs-xft/lisp/custom-load.el diff -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/dumped-lisp.el xemacs-xft/lisp/dumped-lisp.el --- xemacs-head-clean/lisp/dumped-lisp.el Sat Nov 6 10:37:14 2004 +++ xemacs-xft/lisp/dumped-lisp.el Sat Nov 6 10:37:56 2004 @@ -53,6 +53,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 -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/finder-inf.el xemacs-xft/lisp/finder-inf.el diff -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/font-menu.el xemacs-xft/lisp/font-menu.el --- xemacs-head-clean/lisp/font-menu.el Fri Oct 29 15:26:04 2004 +++ xemacs-xft/lisp/font-menu.el Sat Oct 30 09:25:27 2004 @@ -161,13 +161,11 @@ ((gtk) . 10) ((x) . 10))) t) "Generic specifier containing scale factor for font sizes. Don't touch. - This is really a device type constant. Some devices specify size in points \(MS Windows), others in decipoints (X11).") (defvar device-fonts-cache nil "Alist mapping devices to font lists and font menus. Don't use this. - Instead, use the function `device-fonts-cache' which lazily updates this variable, and returns the value for the selected device. @@ -264,9 +262,13 @@ (member 0 (aref entry 2)))) (enable-menu-item item) (disable-menu-item item)) - (if (eq size s) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) + (if (featurep 'xft-fonts) + (if (equal size (float s)) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + (if (eq size s) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item))) item) (submenu-generate-accelerator-spec (aref dcache 2)))))) @@ -345,6 +347,7 @@ (or weight from-weight) (or size from-size)) (error + (message "Error updating font of `%s'" face) (display-error c nil) (sit-for 1))))) ;; Set the default face's font after hacking the other faces, so that @@ -356,16 +359,17 @@ (set-face-font 'default new-default-face-font (and font-menu-this-frame-only-p (selected-frame))) ;; OK Let Customize do it. - (custom-set-face-update-spec 'default - (list (list 'type (device-type))) - (list :family (or family from-family) - :size (concat - (int-to-string - (/ (or size from-size) - (specifier-instance font-menu-size-scaling - (selected-device)))) - "pt"))) - (message "Font %s" (face-font-name 'default))))) + (let ((fsize (if (featurep 'xft-fonts) + (int-to-string (or size from-size)) + (concat (int-to-string + (/ (or size from-size) + (specifier-instance font-menu-size-scaling (selected-device)))) + "pt")))) + (custom-set-face-update-spec 'default + (list (list 'type (device-type))) + (list :family (or family from-family) + :size fsize)))) + (message "Font %s" (face-font-name 'default)))) ;; #### This should be called `font-menu-maybe-change-face' diff -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/font.el xemacs-xft/lisp/font.el --- xemacs-head-clean/lisp/font.el Sat Jul 31 13:26:07 2004 +++ xemacs-xft/lisp/font.el Sat Oct 30 09:25:27 2004 @@ -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 -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/mule/auto-autoloads.el xemacs-xft/lisp/mule/auto-autoloads.el diff -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/mule/custom-load.el xemacs-xft/lisp/mule/custom-load.el diff -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/x-faces.el xemacs-xft/lisp/x-faces.el --- xemacs-head-clean/lisp/x-faces.el Sat Jul 31 13:26:26 2004 +++ xemacs-xft/lisp/x-faces.el Sat Oct 30 09:25:32 2004 @@ -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,49 @@ (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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font) + font))) + (if (x-font-xlfd-font-name-p font-name) + (x-make-font-bold-core font device) + (x-make-font-bold-xft font-name 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 +225,26 @@ (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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font) + font))) + (if (x-font-xlfd-font-name-p font-name) + (x-make-font-unbold-core font device) + (x-make-font-unbold-xft font-name 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 +259,55 @@ (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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font) font))) + (if (x-font-xlfd-font-name-p font-name) + (x-make-font-italic-core font device) + (x-make-font-italic-xft font-name 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 +317,44 @@ (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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font) font))) + (if (x-font-xlfd-font-name-p font-name) + (x-make-font-unitalic-core font device) + (x-make-font-unitalic-xft font-name 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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font) font))) + (if (x-font-xlfd-font-name-p font-name) + (x-make-font-bold-italic-core font device) + (x-make-font-bold-italic-xft font-name 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 +388,23 @@ 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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font font)))) + (if (x-font-xlfd-font-name-p font-name) + (x-font-size-core font) + (x-font-size-xft font-name))) + (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 +523,31 @@ 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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font) font))) + (if (x-font-xlfd-font-name-p font-name) + (x-find-smaller-font-core font device) + (x-find-smaller-font-xft font-name 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 +555,18 @@ 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) + (let ((font-name (if (font-instance-p font) + (font-instance-name font) font))) + (if (x-font-xlfd-font-name-p font-name) + (x-find-larger-font-core font device) + (x-find-larger-font-xft font-name 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 -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/x-font-menu.el xemacs-xft/lisp/x-font-menu.el --- xemacs-head-clean/lisp/x-font-menu.el Fri Oct 29 15:26:06 2004 +++ xemacs-xft/lisp/x-font-menu.el Sat Oct 30 09:25:32 2004 @@ -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 @@ -82,6 +85,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 @@ -197,10 +262,47 @@ (defun x-font-menu-font-data (face dcache) (let* ((case-fold-search t) (domain (if font-menu-this-frame-only-p - (selected-frame) - (selected-device))) - (name (font-instance-name (face-font-instance face domain))) - (truename (font-instance-truename + (selected-frame) + (selected-device))) + (name (font-instance-name (face-font-instance face domain)))) + (if (featurep 'xft-fonts) + (if (xft-xlfd-font-name-p name) + (x-font-menu-font-data-core face dcache name domain) + (x-font-menu-font-data-xft face dcache name domain)) + (x-font-menu-font-data-core face dcache name domain)))) + +(defun x-font-menu-font-data-xft (face dcache name domain) + (let* ((truename (font-instance-truename + (face-font-instance face domain + (if (featurep 'mule) 'ascii)))) + 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 name domain) + (let* ((truename (font-instance-truename (face-font-instance face domain (if (featurep 'mule) 'ascii)))) family size weight entry slant) @@ -229,6 +331,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 -Nru --exclude-from=diff-exclude xemacs-head-clean/lisp/xft.el xemacs-xft/lisp/xft.el --- xemacs-head-clean/lisp/xft.el Thu Jan 1 01:00:00 1970 +++ xemacs-xft/lisp/xft.el Sat Oct 30 09:25:32 2004 @@ -0,0 +1,585 @@ +(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") + +;; Xft version 1 only +(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) + ;; Xft version 1 only + (,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 font)))) + (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 ((count 0) + res end val) + (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)))) + +(defsubst xft-pattern-get-family (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'family)) + +(defsubst xft-pattern-get-style (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'style)) + +(defsubst xft-pattern-get-encoding (xft-pattern id) + "Return the font encoding stored in xft pattern object +XFTPAT. Returns either the font encoding as a string or an error +code. This property of XFTPAT is only available on systems using Xft +version 1. + +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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'encoding)) + +(defsubst xft-pattern-get-foundry (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'foundry)) + +(defsubst xft-pattern-get-xlfd (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'xlfd)) + +(defsubst xft-pattern-get-file (xft-pattern id) + + "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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'file)) + +(defsubst xft-pattern-get-rasterizer (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'rasterizer)) + +(defsubst xft-pattern-get-size (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this function +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'size)) + +(defsubst xft-pattern-get-pixelsize (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'pixelsize)) + +(defsubst xft-pattern-get-scale (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'scale)) + +(defsubst xft-pattern-get-dpi (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'dpi)) + +(defsubst xft-pattern-get-slant (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'slant)) + +(defsubst xft-pattern-get-weight (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'weight)) + +(defsubst xft-pattern-get-spacing (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'spacing)) + +(defsubst xft-pattern-get-index (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'index)) + +(defsubst xft-pattern-get-rgba (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'rgba)) + +(defsubst xft-pattern-get-charwidth (xft-pattern id) + "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. This property of XFTPAT is only available on systems using +Xft version 1. + +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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'charwidth)) + +(defsubst xft-pattern-get-charheight (xft-pattern id) + "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. This property of XFTPAT is only available on systems using Xft +version 1. + +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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'charheight)) + +(defsubst xft-pattern-get-core (xft-pattern id) + "Returns t if xft pattern object XFTPAT represents a core font, nil +or an error code otherwise. This property of XFTPAT is only available +on systems using Xft version 1. + +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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'core)) + +(defsubst xft-pattern-get-antialias (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'antialias)) + +(defsubst xft-pattern-get-outline (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'outline)) + +(defsubst xft-pattern-get-scalable (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'scalable)) + +(defsubst xft-pattern-get-render (xft-pattern id) + "Returns t if xft pattern object XFTPAT represents a render (Xft) +font, nil or an error code otherwise. This property of XFTPAT is only +available on systems using Xft version 1. + +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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'render)) + +(defsubst xft-pattern-get-minspace (xft-pattern id) + "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. If this version of Xft lacks +support for this property of XFTPAT, this functions +returns`x-xft-unimplemented'." + (xft-pattern-get xft-pattern id 'minspace)) + +(provide 'xft) + \ No newline at end of file diff -Nru --exclude-from=diff-exclude xemacs-head-clean/modules/auto-autoloads.el xemacs-xft/modules/auto-autoloads.el diff -Nru --exclude-from=diff-exclude xemacs-head-clean/src/Makefile.in.in xemacs-xft/src/Makefile.in.in --- xemacs-head-clean/src/Makefile.in.in Tue Nov 16 11:49:18 2004 +++ xemacs-xft/src/Makefile.in.in Wed Nov 17 19:43:28 2004 @@ -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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/config.h.in xemacs-xft/src/config.h.in --- xemacs-head-clean/src/config.h.in Sat Nov 6 10:37:24 2004 +++ xemacs-xft/src/config.h.in Sat Nov 6 10:38:01 2004 @@ -205,6 +205,9 @@ /* Compile in support for the X window system? */ #undef HAVE_X_WINDOWS +/* Compile with support for Xft? */ +#undef USE_XFT + /* Defines for building X applications */ #ifdef HAVE_X_WINDOWS /* The following will be defined if xmkmf thinks they are necessary */ diff -Nru --exclude-from=diff-exclude xemacs-head-clean/src/console-x.h xemacs-xft/src/console-x.h --- xemacs-head-clean/src/console-x.h Sat Jul 31 13:26:50 2004 +++ xemacs-xft/src/console-x.h Sat Oct 30 09:25:37 2004 @@ -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) diff -Nru --exclude-from=diff-exclude xemacs-head-clean/src/emacs.c xemacs-xft/src/emacs.c --- xemacs-head-clean/src/emacs.c Sat Nov 6 10:37:28 2004 +++ xemacs-xft/src/emacs.c Sat Nov 6 11:58:56 2004 @@ -1531,6 +1531,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 @@ -2104,6 +2109,9 @@ #endif #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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/faces.c xemacs-xft/src/faces.c --- xemacs-head-clean/src/faces.c Sat Nov 6 10:37:30 2004 +++ xemacs-xft/src/faces.c Sat Nov 6 12:00:28 2004 @@ -1973,7 +1973,14 @@ Lisp_Object inst_list = Qnil; #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) - + +#ifdef USE_XFT + const Ascbyte *fonts[] = + { + "Courier", + "*" + }; +#else const Ascbyte *fonts[] = { /************** ISO-8859 fonts *************/ @@ -2104,6 +2111,7 @@ "-*-*-*-*-*-*-*-*-*-*-*-*-*-*", "*" }; +#endif /* USE_XFT */ const Ascbyte **fontptr; #ifdef HAVE_X_WINDOWS diff -Nru --exclude-from=diff-exclude xemacs-head-clean/src/inline.c xemacs-xft/src/inline.c --- xemacs-head-clean/src/inline.c Sat Jul 31 13:26:55 2004 +++ xemacs-xft/src/inline.c Sat Oct 30 09:25:39 2004 @@ -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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/lrecord.h xemacs-xft/src/lrecord.h --- xemacs-head-clean/src/lrecord.h Sat Nov 6 10:37:35 2004 +++ xemacs-xft/src/lrecord.h Sat Nov 6 10:38:07 2004 @@ -204,6 +204,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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/objects-x-impl.h xemacs-xft/src/objects-x-impl.h --- xemacs-head-clean/src/objects-x-impl.h Sat Jul 31 13:27:04 2004 +++ xemacs-xft/src/objects-x-impl.h Sat Oct 30 09:25:40 2004 @@ -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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/objects-x.c xemacs-xft/src/objects-x.c --- xemacs-head-clean/src/objects-x.c Sat Nov 6 10:37:43 2004 +++ xemacs-xft/src/objects-x.c Sat Nov 6 10:38:11 2004 @@ -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, void *); 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(pat)->xftpatPtr, 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(real_pat)->xftpatPtr, + 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, Lisp_Object maxnumber) @@ -1007,10 +1102,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); @@ -1034,6 +1133,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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/redisplay-x.c xemacs-xft/src/redisplay-x.c --- xemacs-head-clean/src/redisplay-x.c Sat Nov 6 10:37:44 2004 +++ xemacs-xft/src/redisplay-x.c Sat Nov 6 14:29:53 2004 @@ -57,6 +57,12 @@ #include +#ifdef USE_XFT +#include +#include "xft-fonts.h" +#endif + + /* Number of pixels below each line. */ int x_interline_space; /* #### implement me */ @@ -72,6 +78,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. @@ -108,6 +120,10 @@ int dimension; }; +#ifdef USE_XFT +typedef struct textual_run textual_run; +#endif + /* Separate out the text in DYN into a series of textual runs of a particular charset. Also convert the characters as necessary into the format needed by XDrawImageString(), XDrawImageString16(), et @@ -120,6 +136,68 @@ Returns the number of runs actually used. */ +#ifdef USE_XFT +/* I steal this function from redisplay-msw.c */ +static int +separate_textual_runs_xft (struct textual_run **run_storage_ptr, + const Ichar *str, Charcount len) +{ + static UExtbyte *ext_storage; + static int ext_storage_size; + static textual_run *run_storage; + static int run_storage_size; + int runs_so_far = 0; + int runbegin = 0; + int total_nchars = 0; + int i; + Lisp_Object prev_charset; + + if (len == 0) + return 0; + + prev_charset = ichar_charset (str[0]); + + for (i = 1; i <= len; i++) + { + if (i == len || !EQ (ichar_charset (str[i]), prev_charset)) + { + int j; + Ibyte *int_storage = + alloca_ibytes (MAX_ICHAR_LEN * (i - runbegin)); + int int_storage_ptr = 0; + Extbyte *alloca_ext_storage; + int nchars; + + int_storage_ptr = 0; + for (j = runbegin; j < i; j++) + int_storage_ptr += + set_itext_ichar (int_storage + int_storage_ptr, str[j]); + TO_EXTERNAL_FORMAT (DATA, (int_storage, int_storage_ptr), + ALLOCA, (alloca_ext_storage, nchars), + Qutf_8); + nchars /= sizeof (UExtbyte); /* Tricky ... */ + DO_REALLOC (ext_storage, ext_storage_size, total_nchars + nchars, + UExtbyte); + memcpy (ext_storage + total_nchars, alloca_ext_storage, + nchars * sizeof (UExtbyte)); + DO_REALLOC (run_storage, run_storage_size, runs_so_far + 1, + textual_run); + run_storage[runs_so_far].ptr = ext_storage + total_nchars; + run_storage[runs_so_far].charset = prev_charset; + run_storage[runs_so_far].len = nchars; + total_nchars += nchars; + runs_so_far++; + runbegin = i; + if (i < len) + prev_charset = ichar_charset (str[i]); + } + } + + *run_storage_ptr = run_storage; + return runs_so_far; +} +#endif + static int separate_textual_runs (unsigned char *text_storage, struct textual_run *run_storage, @@ -215,8 +293,22 @@ /* */ /****************************************************************************/ +#ifdef USE_XFT static int -x_text_width_single_run (struct face_cachel *cachel, struct textual_run *run) +x_xft_text_width_single_run (Display *dpy, XftFont *xft_font, struct textual_run *run) +{ + static XGlyphInfo glyphinfo; + + XftTextExtentsUtf8 (dpy, + xft_font, + run->ptr, run->len, &glyphinfo); + + return glyphinfo.xOff; +} +#endif + +static int +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 +316,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 } } @@ -241,7 +339,7 @@ */ static int -x_text_width (struct frame *UNUSED (f), struct face_cachel *cachel, +x_text_width (struct frame* f, struct face_cachel *cachel, const Ichar *str, Charcount len) { /* !!#### Needs review */ @@ -251,10 +349,14 @@ int nruns; int i; +#ifdef USE_XFT + nruns = separate_textual_runs_xft (&runs, str, len); +#else nruns = separate_textual_runs (text_storage, runs, str, len); +#endif 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; } @@ -662,11 +764,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)) @@ -774,7 +880,7 @@ /* General variables */ struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); - Lisp_Object window; + Lisp_Object window = wrap_window (w); Display *dpy = DEVICE_X_DISPLAY (d); Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); @@ -790,7 +896,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,11 +905,17 @@ int i; struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); - 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. */ @@ -816,11 +929,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); @@ -863,9 +973,17 @@ if (bgc) XFillRectangle (dpy, x_win, bgc, clip_start, - DISPLAY_LINE_YPOS (dl), clip_end - clip_start, + ypos, clip_end - clip_start, height); +#ifdef USE_XFT + nruns = separate_textual_runs_xft (&runs, Dynarr_atp (buf, 0), + Dynarr_length (buf)); +#else + nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), + Dynarr_length (buf)); +#endif + for (i = 0; i < nruns; i++) { Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); @@ -876,10 +994,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 @@ -895,8 +1014,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. */ @@ -922,16 +1041,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) = @@ -939,44 +1067,96 @@ 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); + } + + XftDrawStringUtf8 (xftDraw, + &fg, + renderFont, + xpos, dl->ypos, + 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 @@ -985,7 +1165,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) @@ -1007,10 +1190,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; @@ -1024,6 +1206,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; @@ -1045,39 +1232,76 @@ /* 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); + + XftDrawStringUtf8 (xftDraw, + &fg, + renderFont, + xpos, dl->ypos, + 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; } @@ -1125,12 +1349,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) @@ -1141,7 +1365,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)) @@ -1162,6 +1386,11 @@ XSetClipOrigin (dpy, gc, 0, 0); } } + +#ifdef USE_XFT + XftDrawDestroy (xftDraw); +#endif + } void @@ -1963,6 +2192,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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/redisplay.c xemacs-xft/src/redisplay.c --- xemacs-head-clean/src/redisplay.c Sat Nov 6 10:37:45 2004 +++ xemacs-xft/src/redisplay.c Sat Nov 6 12:02:50 2004 @@ -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) @@ -2144,11 +2144,46 @@ #### This variable should probably have some rethought done to it. - See also + #### It would also be really nice if you could specify that + the characters come out in hex instead of in octal. Mule + does that by adding a ctl-hexa variable similar to ctl-arrow, + but that's bogus -- we need a more general solution. I + think you need to extend the concept of display tables + into a more general conversion mechanism. Ideally you + could specify a Lisp function that converts characters, + but this violates the Second Golden Rule and besides would + make things way way way way slow. + + So instead, we extend the display-table concept, which was + historically limited to 256-byte vectors, to one of the + following: + See also (Info-goto-node "(internals)Future Work -- Display Tables") - */ + a) A 256-entry vector, for backward compatibility; + b) char-table, mapping characters to values; + c) range-table, mapping ranges of characters to values; + d) a list of the above. + + The (d) option allows you to specify multiple display tables + instead of just one. Each display table can specify conversions + for some characters and leave others unchanged. The way the + character gets displayed is determined by the first display table + with a binding for that character. This way, you could call a + function `enable-hex-display' that adds a hex display-table to + the list of display tables for the current buffer. + + #### ...not yet implemented... Also, we extend the concept of + "mapping" to include a printf-like spec. Thus you can make all + extended characters show up as hex with a display table like + this: + + #s(range-table data ((256 524288) (format "%x"))) + + Since more than one display table is possible, you have + great flexibility in mapping ranges of characters. */ + Ichar printable_min = (CHAR_OR_CHAR_INTP (b->ctl_arrow) ? XCHAR_OR_CHAR_INT (b->ctl_arrow) : ((EQ (b->ctl_arrow, Qt) || EQ (b->ctl_arrow, Qnil)) @@ -4177,9 +4212,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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/symsinit.h xemacs-xft/src/symsinit.h --- xemacs-head-clean/src/symsinit.h Sat Nov 6 10:37:48 2004 +++ xemacs-xft/src/symsinit.h Sat Nov 6 10:38:14 2004 @@ -157,6 +157,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); EXTERN_C void syms_of_postgresql (void); void syms_of_print (void); void syms_of_process (void); @@ -394,6 +395,7 @@ void vars_of_nt (void); void vars_of_number (void); void vars_of_objects (void); +void vars_of_xft_fonts (void); void reinit_vars_of_objects (void); void vars_of_objects_tty (void); void vars_of_objects_mswindows (void); diff -Nru --exclude-from=diff-exclude xemacs-head-clean/src/xft-fonts.c xemacs-xft/src/xft-fonts.c --- xemacs-head-clean/src/xft-fonts.c Thu Jan 1 01:00:00 1970 +++ xemacs-xft/src/xft-fonts.c Wed Nov 17 19:43:30 2004 @@ -0,0 +1,834 @@ +#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 Qx_xft_unimplemented; + +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); + + xftpat->xftpatPtr = XftPatternCreate(); + xftpat->fontset = 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); + + xftpat->xftpatPtr = XftNameParse(XSTRING_DATA(name)); + xftpat->fontset = 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(xftpat)->xftpatPtr, 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); + copy->xftpatPtr = XftPatternDuplicate(XXFTPATTERN(xftpat)->xftpatPtr); + XXFTPATTERN(xftpat)->fontset = 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(xftpat)->xftpatPtr, + XSTRING_DATA(object), + XSTRING_DATA(value)); + return res ? Qt : Qnil; + } + + if (INTP(value)) + { + res = XftPatternAddInteger(XXFTPATTERN(xftpat)->xftpatPtr, + XSTRING_DATA(object), + XINT(value)); + return res ? Qt : Qnil; + } + + if (FLOATP(value)) + { + res = XftPatternAddDouble(XXFTPATTERN(xftpat)->xftpatPtr, + XSTRING_DATA(object), + (double) XFLOAT_DATA(value)); + return res ? Qt : Qnil; + } + + if (SYMBOLP(value)) + { + res = XftPatternAddBool(XXFTPATTERN(xftpat)->xftpatPtr, + 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(xftpat)->xftpatPtr, XSTRING_DATA(object)); + return res ? Qt : Qnil; +} + +/**************************************************************************** + * generic property access for Lisp Xft pattern objects * + ****************************************************************************/ + +/* primitives for XftPatternGet() -- returning strings */ +static 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(xftpat)->xftpatPtr, + 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; + } +} + +/* primitives for XftPatternGet() -- returning doubles */ +static 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(xftpat)->xftpatPtr, objid, XINT(id), &d); +#else + res = XftPatternGetDouble(XXFTPATTERN(xftpat)->xftpatPtr, 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; + } +} + +/* primitives for XftPatternGet() -- returning integers */ +static 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(xftpat)->xftpatPtr, objid, XINT(id), &i); +#else + res = XftPatternGetInteger(XXFTPATTERN(xftpat)->xftpatPtr, 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; + } +} + +/* primitives for XftPatternGet() -- returning bools */ +static 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(xftpat)->xftpatPtr, 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); + } +} + +enum xft_pattern_get_return_type { + XE_XFT_INVALID, + XE_XFT_UNIMPLEMENTED, + XE_XFT_STRING, + XE_XFT_DOUBLE, + XE_XFT_INTEGER, + XE_XFT_BOOLEAN +}; + +struct xft_pattern_property { + char *name; + Lisp_Object symbol; + enum xft_pattern_get_return_type type; +}; + +/* #### should these be updated for use of fontconfig? */ +static struct xft_pattern_property xft_pattern_property_tbl [] = { + { XFT_FAMILY, (Lisp_Object) 0, XE_XFT_STRING }, + { XFT_STYLE, (Lisp_Object) 0, XE_XFT_STRING }, +#if XFT_VERSION < 2 + { XFT_ENCODING, (Lisp_Object) 0, XE_XFT_STRING }, +#else + { XFT_ENCODING, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED }, +#endif + { XFT_FOUNDRY, (Lisp_Object) 0, XE_XFT_STRING }, + { XFT_XLFD, (Lisp_Object) 0, XE_XFT_STRING }, + { XFT_FILE, (Lisp_Object) 0, XE_XFT_STRING }, + { XFT_RASTERIZER, (Lisp_Object) 0, XE_XFT_STRING }, + { XFT_SIZE, (Lisp_Object) 0, XE_XFT_DOUBLE }, + { XFT_PIXEL_SIZE, (Lisp_Object) 0, XE_XFT_DOUBLE }, + { XFT_SCALE, (Lisp_Object) 0, XE_XFT_DOUBLE }, + { XFT_DPI, (Lisp_Object) 0, XE_XFT_DOUBLE }, + { XFT_SLANT, (Lisp_Object) 0, XE_XFT_INTEGER }, + { XFT_WEIGHT, (Lisp_Object) 0, XE_XFT_INTEGER }, + { XFT_SPACING, (Lisp_Object) 0, XE_XFT_INTEGER }, + { XFT_INDEX, (Lisp_Object) 0, XE_XFT_INTEGER }, + { XFT_RGBA, (Lisp_Object) 0, XE_XFT_INTEGER }, +#if XFT_VERSION < 2 + { XFT_CHAR_WIDTH, (Lisp_Object) 0, XE_XFT_INTEGER }, + { XFT_CHAR_HEIGHT,(Lisp_Object) 0, XE_XFT_INTEGER }, + { XFT_CORE, (Lisp_Object) 0, XE_XFT_BOOLEAN }, +#else + { XFT_CHAR_WIDTH, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED }, + { XFT_CHAR_HEIGHT,(Lisp_Object) 0, XE_XFT_UNIMPLEMENTED }, + { XFT_CORE, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED }, +#endif + { XFT_ANTIALIAS, (Lisp_Object) 0, XE_XFT_BOOLEAN }, + { XFT_OUTLINE, (Lisp_Object) 0, XE_XFT_BOOLEAN }, + { XFT_SCALABLE, (Lisp_Object) 0, XE_XFT_BOOLEAN }, +#if XFT_VERSION < 2 + { XFT_RENDER, (Lisp_Object) 0, XE_XFT_BOOLEAN }, +#else + { XFT_RENDER, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED }, +#endif + { XFT_MINSPACE, (Lisp_Object) 0, XE_XFT_BOOLEAN }, + { NULL, (Lisp_Object) 0, XE_XFT_INVALID } +}; + +static char *xft_pattern_property_names[] = { + "family", "style", "encoding", "foundry", "xlfd", "file", "rasterizer", + "size", "pixelsize", "scale", "dpi", "slant", "weight", "spacing", + "index", "rgba", "charwidth", "charheight", "core", "antialias", + "outline", "scalable", "render", "minspace", NULL}; + +DEFUN("xft-pattern-get", Fxft_pattern_get, 3, 3, 0, /* +Return Xft pattern object XFTPAT's value in slot ID of PROPERTY. + +Normal returns are strings, floats, integers, or Boolean values, depending +on the property. + +Error codes are symbols: `x-xft-result-no-match' if there is no such +attribute associated with XFTPAT, `x-xft-result-no-id' if there is no +value with number ID for this attribute, or `x-xft-internal-error' if +Xft returns an unexpected value. (The value `x-xft-unimplemented' may +be added for properties not implemented in all versions of Xft.) + +Implemented properties and their types are: + + family string + style string + encoding string (Xft1 only) + foundry string + xlfd string + file string + rasterizer string + size double + pixelsize double + scale double + dpi double + slant integer + weight integer + spacing integer + index integer + rgba integer + charwidth integer (Xft1 only) + charheight integer (Xft1 only) + core boolean (Xft1 only) + antialias boolean + outline boolean + scalable boolean + render boolean (Xft1 only) + minspace boolean" */ + (xftpat, id, property)) +{ + struct xft_pattern_property *tbl; + char *str = "Xft pattern property"; + int i; + + CHECK_XFTPATTERN(xftpat); + CHECK_INT(id); + CHECK_SYMBOL(property); + + /* FIXME: move me to a better place!!! */ + for (i = 0; xft_pattern_property_names[i] != NULL; i++) + xft_pattern_property_tbl[i].symbol = + Fintern(make_string(xft_pattern_property_names[i], strlen(xft_pattern_property_names[i])), Qnil); + + for (tbl = &xft_pattern_property_tbl[0]; tbl->type != XE_XFT_INVALID; tbl++) + { + assert (tbl - xft_pattern_property_tbl + < (ptrdiff_t) (sizeof(xft_pattern_property_tbl) + / sizeof(struct xft_pattern_property))); + if (EQ(tbl->symbol,property)) break; + } + + switch (tbl->type) { + case XE_XFT_STRING: + return xft_get_pattern_string (xftpat, id, tbl->name); + case XE_XFT_DOUBLE: + return xft_get_pattern_double (xftpat, id, tbl->name); + case XE_XFT_INTEGER: + return xft_get_pattern_integer (xftpat, id, tbl->name); + case XE_XFT_BOOLEAN: + return xft_get_pattern_bool (xftpat, id, tbl->name); + case XE_XFT_UNIMPLEMENTED: + return Qx_xft_unimplemented; + default: + args_out_of_range (make_string (str, sizeof(str)), property); + } +} + +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(xftpat)->fontset = Qnil; + + XftPatternDestroy(XXFTPATTERN(xftpat)->xftpatPtr); + 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; + + res_xftpat->fontset = Qnil; + dpy = DEVICE_X_DISPLAY(XDEVICE(device)); + res_xftpat->xftpatPtr = XftFontMatch(dpy, DefaultScreen (dpy), + XXFTPATTERN(xftpat)->xftpatPtr, + &res); + + if (res_xftpat->xftpatPtr == 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); + + objset->objsetPtr = 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(xftobjset)->objsetPtr, + 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(xftobjset)->objsetPtr); + 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(); + + fontset->fontsetPtr = + FcFontList(fcc, + XXFTPATTERN(xftpat)->xftpatPtr, + XXFTOBJECTSET(xftobjset)->objsetPtr); +#else + dpy = DEVICE_X_DISPLAY(XDEVICE(device)); + screen = DefaultScreen(dpy); + + fontset->fontsetPtr = + XftListFontsPatternObjects(dpy, screen, + XXFTPATTERN(xftpat)->xftpatPtr, + XXFTOBJECTSET(xftobjset)->objsetPtr); +#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(xftfontset)->fontsetPtr->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(xftfontset)->fontsetPtr->nfont)) + { + xftpat->xftpatPtr = XXFTFONTSET(xftfontset)->fontsetPtr->fonts[idx]; + xftpat->fontset = 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(xftfontset)->fontsetPtr); + 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; + xftpat->xftpatPtr = copy; + xftpat->fontset = 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(xftpat)->xftpatPtr); +#else + XftPatternPrint(XXFTPATTERN(xftpat)->xftpatPtr); +#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; + } + } +} + +/* color conversion to xft colors */ +/* XXX: is this the right place */ +#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ + ? ((unsigned long) (x)) : ((unsigned long) (y))) + +XftColor +xft_convert_color (Display *dpy, Colormap cmap, int c, int dim) +{ + static XColor color; + XftColor result; + + color.pixel = c; + XQueryColor(dpy, cmap, &color); + + if (dim) + { + Screen *screen = DefaultScreenOfDisplay (dpy); /* XXX */ + Visual *visual = DefaultVisualOfScreen (screen); + 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, visual, &color); + } + + result.pixel = color.pixel; + result.color.red = color.red; + result.color.green = color.green; + result.color.blue = color.blue; + result.color.alpha = 0xffff; + + return result; +} + +XftColor +xft_get_color (Display *dpy, Colormap cmap, Lisp_Object c, int dim) +{ + if (COLOR_INSTANCEP (c)) + return COLOR_INSTANCE_X_XFT_COLOR (XCOLOR_INSTANCE (c)); + else + return xft_convert_color (dpy, cmap, XINT (c), dim); +} + +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); + DEFSYMBOL(Qx_xft_unimplemented); + + 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); + 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); +} + +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 -Nru --exclude-from=diff-exclude xemacs-head-clean/src/xft-fonts.h xemacs-xft/src/xft-fonts.h --- xemacs-head-clean/src/xft-fonts.h Thu Jan 1 01:00:00 1970 +++ xemacs-xft/src/xft-fonts.h Sat Oct 30 09:25:42 2004 @@ -0,0 +1,119 @@ +#include +#include "lisp.h" +#include "device.h" +#include "device-impl.h" +#include "console-x-impl.h" +#include "objects-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) + +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) + +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) + +#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); +XftColor xft_convert_color (Display *dpy, Colormap cmap, int c, int dim); +XftColor xft_get_color (Display *dpy, Colormap cmap, Lisp_Object c, int dim); +Lisp_Object make_xlfd_font_regexp (void);