[COMMIT] Fix trunk problems caused by my latest commit
18 years, 8 months
Aidan Kehoe
Aidan Kehoe
NOTE: This patch has been committed.
Bad Lisp string syntax in ethio-util.el; I am mildly shocked that this
didn’t appear in my weeks of testing of the change.
lisp/ChangeLog addition:
2006-04-29 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/ethio-util.el (ethio-fidel-to-java-buffer):
"\u" -> "\\u" as it should have been in the first place.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: lisp/mule/ethio-util.el
Index: lisp/mule/ethio-util.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/ethio-util.el,v
retrieving revision 1.7
diff -u -u -r1.7 ethio-util.el
--- lisp/mule/ethio-util.el 2004/06/06 23:58:46 1.7
+++ lisp/mule/ethio-util.el 2006/04/29 18:53:56
＠＠ -1778,7 +1778,7 ＠＠
(defun ethio-fidel-to-java-buffer nil
"Convert Ethiopic characters into the Java escape sequences.
-Each escape sequence is of the form \uXXXX, where XXXX is the
+Each escape sequence is of the form \\uXXXX, where XXXX is the
character's codepoint (in hex) in Unicode.
If `ethio-java-save-lowercase' is non-nil, use [0-9a-f].
--
In the beginning God created the heavens and the earth. And God was a
bug-eyed, hexagonal smurf with a head of electrified hair; and God said:
“Si, mi chiamano Mimi...”
- 1 participants
- 0 comments
[PATCH COMMIT] Revert patch from 2006-01-27
18 years, 8 months
Michael Albinus
Michael Albinus
Hello,
I've committed the following Tramp patch to CVS. It should solve the
autoload problem for hostname completion reported recently.
Best regards, Michael.
- 1 participants
- 0 comments
[21.5R21.4] simple.el GNU syncs
18 years, 8 months
Ville Skyttä
Ville Skyttä
21.5 RECOMMEND 21.4
Here's some trivialish GNU Emacs CVS syncs for simple.el that I've come
across in the new vc package. Will commit in a couple of days unless
there are objections. Vin, the patch applies to 21.4 with some line
offsets, so if you think these are innocent enough for the stable
branch, I have no objections to applying these there as well.
2006-04-23 Ville Skyttä <scop(a)xemacs.org>
* simple.el: Sync some bits with GNU Emacs CVS:
(goto-line): Add optional `buffer' argument.
(next-line-add-newlines): Update docstring.
(next-line): Make `count' argument optional.
(previous-line): Ditto.
- 2 participants
- 3 comments
[AC21.5] Repair Xft damage from recent commit
18 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT 21.5
I'm beginning to like git a lot, but this particular time it handed me
a loaded gun and I blew my foot off. Commit from the wrong branch,
double plus ungood.
My apologies to those who got spattered.
This patch puts all the various requires, provides, #includes as they
should be. Successfully built and run (ie, splash screen appeared and
I shut down normally with C-x C-c) for the --with-xft and
--without-xft variants.
This also contains a number of gratuitous documentation improvements
and two code clarifications. One in emacs.c (main_1) initializes
use_display, which is a char*, to NULL instead of 0. The other in
x-faces.el (Face-frob-property) gives an informative error if a device
type has no mapper function in `x-make-face-bold' and friends. Both
are hangovers from an experiment with turning Xft into a console type,
but seem useful. Will revert on request....
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.738
diff -u -r1.738 ChangeLog
--- lisp/ChangeLog 23 Apr 2006 20:12:25 -0000 1.738
+++ lisp/ChangeLog 25 Apr 2006 13:18:34 -0000
＠＠ -0,0 +1,18 ＠＠
+2006-04-25 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ Repair busted commit and gratuitous doc improvements.
+
+ * startup.el (command-line-do-help): Document options for forcing
+ initial from on a given window-system.
+
+ * faces.el (Face-frob-property): Give informative error if device
+ type has no mapper function.
+
+ * x-font-menu.el (x-font-menu-font-data-xft):
+ * x-faces.el (globally-declare-fboundp):
+ Eliminate references to `fc-font-real-pattern'.
+
+ * fontconfig.el (section header comments):
+ * x-init.el (x-init-toolbar-from-resources):
+ Improve comments.
+
Index: lwlib/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/ChangeLog,v
retrieving revision 1.84
diff -u -r1.84 ChangeLog
--- lwlib/ChangeLog 23 Apr 2006 16:11:25 -0000 1.84
+++ lwlib/ChangeLog 25 Apr 2006 13:18:35 -0000
＠＠ -1,3 +1,4 ＠＠
-2006-04-22 Stephen J. Turnbull <stephen(a)xemacs.org>
+2006-04-16 Stephen J. Turnbull <stephen(a)xemacs.org>
- * lwlib-fonts.c: Rename xft-fonts.h to font-mgr.h.
+ * lwlib-fonts.c: Change #include to "font-mgr.h". Make
+ conditional on HAVE_FONTCONFIG, not USE_XFT.
Index: src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.948
diff -u -r1.948 ChangeLog
--- src/ChangeLog 24 Apr 2006 16:09:58 -0000 1.948
+++ src/ChangeLog 25 Apr 2006 13:18:41 -0000
＠＠ -0,0 +1,18 ＠＠
+2006-04-25 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ Repair busted commit, plus some gratuitous doc improvements.
+
+ * emacs.c (main_1): Initialize display_use to NULL for clarity.
+
+ * objects-x.c (x_color_list):
+ (x_initialize_font_instance):
+ (x_font_instance_truename):
+ (x_find_charset_font):
+ * font-mgr.h (Qfc_font_name_encoding):
+ Qxft_font_name_encoding -> Qfc_font_name_encoding.
+
+ * console.h (header comment):
+ * font-mgr.c (vars_of_font_mgr):
+ * redisplay.c (Vwindow_system):
+ Improve comments.
+
Index: lisp/faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v
retrieving revision 1.37
diff -u -r1.37 faces.el
--- lisp/faces.el 26 Nov 2005 11:45:54 -0000 1.37
+++ lisp/faces.el 25 Apr 2006 13:18:34 -0000
＠＠ -990,8 +990,10 ＠＠
locale tag-set devtype-spec ffpdev)
;; devtype may be nil if it fails to match DEVTYPE-SPEC
if devtype
- if (let* ((mapper (if (functionp frob-mapping) frob-mapping
- (plist-get frob-mapping devtype)))
+ if (let* ((mapper
+ (cond ((functionp frob-mapping) frob-mapping)
+ ((plist-get frob-mapping devtype))
+ (t (error 'unimplemented "mapper" devtype))))
(result
(cond
;; if a vector ...
Index: lisp/font-mgr.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-mgr.el,v
retrieving revision 1.1
diff -u -r1.1 font-mgr.el
--- lisp/font-mgr.el 23 Apr 2006 16:11:22 -0000 1.1
+++ lisp/font-mgr.el 25 Apr 2006 13:18:34 -0000
＠＠ -234,16 +234,6 ＠＠
match other font-listing APIs."
(error 'unimplemented "font-mgr library is experimental and incomplete"))
-(when nil
- ;; #### this actually is an Xft function, should split those out
- ;; or get rid of them entirely?
- ;; #### be consistent about argument order.
-(defun fc-font-real-pattern (fontname xdevice)
- "Temporarily open FONTNAME (a string) and return the actual
-fc pattern matched by the Fc library."
- (error 'unimplemented "font-mgr library is experimental and incomplete"))
-)
-
(defun xlfd-font-name-p (fontname)
"Check whether the string FONTNAME is a XLFD font name."
(save-match-data
Index: lisp/font.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font.el,v
retrieving revision 1.19
diff -u -r1.19 font.el
--- lisp/font.el 5 Dec 2005 09:43:37 -0000 1.19
+++ lisp/font.el 25 Apr 2006 13:18:35 -0000
＠＠ -796,10 +796,12 ＠＠
"A list of font family mappings on Xft devices.")
(defun xft-font-create-object (fontname &optional device)
- "Return a font descriptor object for FONTNAME, appropriate for Xft."
+ "Return a font descriptor object for FONTNAME, appropriate for Xft.
+
+Optional DEVICE defaults to `default-x-device'."
(let* ((name fontname)
(device (or device (default-x-device)))
- (pattern (fc-font-real-pattern name device))
+ (pattern (fc-font-match device (fc-name-parse name)))
(font-obj (make-font))
(family (fc-pattern-get-family pattern 0))
(size (fc-pattern-get-size pattern 0))
Index: lisp/fontconfig.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/fontconfig.el,v
retrieving revision 1.3
diff -u -r1.3 fontconfig.el
--- lisp/fontconfig.el 23 Apr 2006 16:11:22 -0000 1.3
+++ lisp/fontconfig.el 25 Apr 2006 13:18:35 -0000
＠＠ -89,9 +89,8 ＠＠
;;
;; The fontconfig pattern API
;;
-;; The basic interfaces are defined as API wrappers in C in xft-font.c
-;; #### which should be renamed to fontconfig.c. These are prefixed
-;; with "fc-pattern-". These are
+;; The basic interfaces are defined as API wrappers in C in font-mgr.c.
+;; These are prefixed with "fc-pattern-". These are
;;
;; fc-pattern-p
;; fc-pattern-create
＠＠ -385,13 +384,11 ＠＠
;;
;; The fontconfig fontname UI
;;
-;; The basic interfaces are defined as API wrappers in C in xft-font.c
-;; #### which should be renamed to fontconfig.c. These are prefixed
-;; with "fc-name-". These are
+;; The basic interfaces are defined as API wrappers in C in font-mgr.c
+;; These are prefixed with "fc-name-". These are
;;
;; fc-name-parse
;; fc-name-unparse
-;; xft-name-unparse (nonfunctional and presumably obsolete)
;;
;; For interfacing with various font rendering systems, we need to be able
;; to convert the fontconfig patterns to names, and vice versa. The high-
＠＠ -423,14 +420,12 ＠＠
;;
;; The fontconfig font API
;;
-;; The basic interfaces are defined as API wrappers in C in xft-font.c
-;; #### which should be renamed to fontconfig.c. These are prefixed
-;; with "fc-font-". These are
+;; The basic interfaces are defined as API wrappers in C in font-mgr.c.
+;; These are prefixed with "fc-font-". These are
;;
;; fc-font-match
;; fc-list-fonts-pattern-objects
;; fc-font-sort
-;; fc-font-real-pattern
;;
;; The high-level API is
;;
Index: lisp/startup.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/startup.el,v
retrieving revision 1.55
diff -u -r1.55 startup.el
--- lisp/startup.el 5 May 2005 16:55:41 -0000 1.55
+++ lisp/startup.el 25 Apr 2006 13:18:35 -0000
＠＠ -174,7 +174,7 ＠＠
(defvar load-user-init-file-p t
"Non-nil if XEmacs should load the user's init file.")
-;; #### called `site-run-file' in FSFmacs
+;; #### called `site-run-file' in GNU Emacs
(defvar site-start-file "site-start"
"File containing site-wide run-time initializations.
＠＠ -285,6 +285,11 ＠＠
-t is given. Otherwise, a TTY frame is created.
-unmapped Do not display the initial frame. Useful to create
a \"server\" that can accept `gnuclient' connections.
+ -tty Create the initial frame on the given window system.
+ -x (Requesting an unsupported window system, or giving
+ -gtk conflicting window systems, is a fatal error.)
+ -gnome
+ -msw
Noninteractive options:
＠＠ -569,7 +574,7 ＠＠
;; ;; Modify the initial frame based on what the init file puts into
;; ;; ...-frame-alist.
(frame-notice-user-settings)
- ;; ;;####FSFmacs junk
+ ;; ;;#### GNU Emacs junk
;; ;; Now we know the user's default font, so add it to the menu.
;; (if (fboundp 'font-menu-add-default)
;; (font-menu-add-default))
＠＠ -583,7 +588,7 ＠＠
(if load-user-init-file-p
(maybe-migrate-user-init-file))
- ;; FSF calls precompute-menubar-bindings. We don't mix menubars
+ ;; GNU calls precompute-menubar-bindings. We don't mix menubars
;; and keymaps.
))
＠＠ -606,7 +611,7 ＠＠
(string= vc "simple"))
(setq version-control 'never))))
- ;;####FSFmacs
+ ;;#### GNU Emacs
;; (if (let ((ctype
;; ;; Use the first of these three envvars that has a nonempty value.
;; (or (let ((string (getenv "LC_ALL")))
Index: lisp/x-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v
retrieving revision 1.24
diff -u -r1.24 x-faces.el
--- lisp/x-faces.el 23 Apr 2006 16:11:22 -0000 1.24
+++ lisp/x-faces.el 25 Apr 2006 13:18:35 -0000
＠＠ -1,6 +1,6 ＠＠
;;; x-faces.el --- X-specific face frobnication, aka black magic.
-;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1994, 1997, 2006 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
;; Author: Jamie Zawinski <jwz(a)jwz.org>
＠＠ -74,11 +74,11 ＠＠
fc-font-name-slant-oblique fc-font-name-slant-italic
fc-font-name-slant-roman))
(globally-declare-fboundp
- '(fc-font-real-pattern fc-pattern-get-size fc-copy-pattern-partial
- fc-pattern-del-weight fc-pattern-del-style fc-pattern-duplicate
- fc-pattern-add-weight fc-try-font fc-pattern-add-size
- fc-name-unparse fc-pattern-del-slant fc-pattern-add-slant
- fc-pattern-del-size fc-pattern-get-pixelsize)))
+ '(fc-pattern-del-size fc-pattern-get-size fc-pattern-add-size
+ fc-pattern-del-style fc-pattern-duplicate fc-copy-pattern-partial
+ fc-pattern-add-weight fc-pattern-del-weight fc-try-font
+ fc-pattern-del-slant fc-pattern-add-slant fc-name-unparse
+ fc-pattern-get-pixelsize)))
(defconst x-font-regexp nil)
(defconst x-font-regexp-head nil)
＠＠ -194,8 +194,8 ＠＠
(x-make-font-bold-core font device)))
(defun x-make-font-bold-xft (font &optional device)
- (let ((pattern (fc-font-real-pattern
- font (or device (default-x-device)))))
+ (let ((pattern (fc-font-match (or device (default-x-device))
+ (fc-name-parse font))))
(if pattern
(let ((size (fc-pattern-get-size pattern 0))
(copy (fc-copy-pattern-partial pattern (list "family"))))
＠＠ -238,8 +238,8 ＠＠
(x-make-font-unbold-core font device)))
(defun x-make-font-unbold-xft (font &optional device)
- (let ((pattern (fc-font-real-pattern
- font (or device (default-x-device)))))
+ (let ((pattern (fc-font-match (or device (default-x-device))
+ (fc-name-parse font))))
(when pattern
(fc-pattern-del-weight pattern)
(fc-pattern-add-weight pattern fc-font-name-weight-medium)
＠＠ -268,8 +268,8 ＠＠
(x-make-font-italic-core font device)))
(defun x-make-font-italic-xft (font &optional device)
- (let ((pattern (fc-font-real-pattern
- font (or device (default-x-device)))))
+ (let ((pattern (fc-font-match (or device (default-x-device))
+ (fc-name-parse font))))
(if pattern
(let ((size (fc-pattern-get-size pattern 0))
(copy (fc-copy-pattern-partial pattern (list "family"))))
＠＠ -322,8 +322,8 ＠＠
(x-make-font-unitalic-core font device)))
(defun x-make-font-unitalic-xft (font &optional device)
- (let ((pattern (fc-font-real-pattern
- font (or device (default-x-device)))))
+ (let ((pattern (fc-font-match (or device (default-x-device))
+ (fc-name-parse font))))
(when pattern
(fc-pattern-del-slant pattern)
(fc-pattern-add-slant pattern fc-font-name-slant-roman)
＠＠ -389,11 +389,11 ＠＠
;; this is unbelievable &*＠#
(defun x-font-size-xft (font)
- (let ((pattern (fc-font-real-pattern
- font (default-x-device))))
+ (let ((pattern (fc-font-match (default-x-device)
+ (fc-name-parse font))))
(when pattern
(let ((pixelsize (fc-pattern-get-pixelsize pattern 0)))
- (if (floatp pixelsize) (round pixelsize))))))
+ (if (floatp pixelsize) (round pixelsize) pixelsize)))))
(defun x-font-size-core (font)
(if (font-instance-p font) (setq font (font-instance-name font)))
＠＠ -521,8 +521,8 ＠＠
(x-find-smaller-font-core font device)))
(defun x-find-xft-font-of-size (font new-size-proc &optional device)
- (let* ((pattern (fc-font-real-pattern
- font (or device (default-x-device)))))
+ (let* ((pattern (fc-font-match (or device (default-x-device))
+ (fc-name-parse font))))
(when pattern
(let ((size (fc-pattern-get-size pattern 0)))
(if (floatp size)
Index: lisp/x-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v
retrieving revision 1.15
diff -u -r1.15 x-font-menu.el
--- lisp/x-font-menu.el 23 Apr 2006 16:11:22 -0000 1.15
+++ lisp/x-font-menu.el 25 Apr 2006 13:18:35 -0000
＠＠ -35,7 +35,6 ＠＠
(require 'font-menu)
(when (featurep 'xft-fonts)
- (require 'xft)
(require 'fontconfig))
(globally-declare-boundp
＠＠ -276,6 +275,7 ＠＠
(x-font-menu-font-data-core face dcache))))
(defun x-font-menu-font-data-xft (face dcache name domain)
+ ;; DOMAIN is expected to be a device.
(let* ((truename (font-instance-truename
(face-font-instance face domain
(if (featurep 'mule) 'ascii))))
＠＠ -284,7 +284,7 ＠＠
(progn
nil)
(progn
- (let* ((pattern (fc-font-real-pattern name domain))
+ (let* ((pattern (fc-font-match domain (fc-name-parse name)))
(family (and pattern
(fc-pattern-get-family pattern 0))))
(if (fc-pattern-get-successp family)
Index: lisp/x-init.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-init.el,v
retrieving revision 1.15
diff -u -r1.15 x-init.el
--- lisp/x-init.el 26 Jun 2005 18:04:50 -0000 1.15
+++ lisp/x-init.el 25 Apr 2006 13:18:35 -0000
＠＠ -271,7 +271,7 ＠＠
(fill-paragraph nil))))))
-;; Moved from x-toolbar.el, since InfoDock doesn't dump a x-toolbar.el.
+;; Moved from x-toolbar.el, since InfoDock doesn't dump x-toolbar.el.
(defun x-init-toolbar-from-resources (locale)
(loop for (specifier . resname) in
`(( ,top-toolbar-height . "topToolBarHeight")
Index: lwlib/lwlib-fonts.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-fonts.c,v
retrieving revision 1.3
diff -u -r1.3 lwlib-fonts.c
--- lwlib/lwlib-fonts.c 23 Apr 2006 16:11:26 -0000 1.3
+++ lwlib/lwlib-fonts.c 25 Apr 2006 13:18:35 -0000
＠＠ -36,7 +36,9 ＠＠
#include "device.h"
#include "device-impl.h"
#include "console-x-impl.h"
+#ifdef HAVE_FONTCONFIG
#include "font-mgr.h"
+#endif
#endif
/*
Index: src/console.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console.h,v
retrieving revision 1.42
diff -u -r1.42 console.h
--- src/console.h 8 Mar 2004 15:23:02 -0000 1.42
+++ src/console.h 25 Apr 2006 13:18:41 -0000
＠＠ -28,20 +28,25 ＠＠
/* Devices and consoles are similar entities. The idea is that
a console represents a physical keyboard/mouse/other-input-source
while a device represents a display where frames appear on.
+ Nowadays "multi-headed" displays with multiple physical screens
+ are becoming familiar; in the XEmacs nomenclature, this maps to a
+ "console" supporting multiple "devices".
+
In the X world, a console is a "Display" while a device is a
"Screen". Implementationally, it can sometimes get confusing:
under X, multiple devices on a single console are different
"Display" connections to what is in reality the same Display on
- the same server. Because of this, input comes from the device
- and not from the console. This is OK because events are basically
- always tagged to a particular X window (i.e. frame),
- which exists on only one screen; therefore the event won't be
- reported multiple times even if there are multiple devices on
- the same physical display. This is an implementation detail
- specific to X consoles (e.g. under NeXTstep or Windows, this
- could be different, and input would come directly from the console).
-*/
+ the same server. Furthermore, in the X model input comes from the
+ device and not from the console. This causes no confusion because
+ events are basically always tagged to a particular X window (i.e.
+ frame), which exists on only one screen; therefore the event won't
+ be reported multiple times even if there are multiple devices on
+ the same physical display.
+ This is an implementation detail specific to X consoles (e.g. under
+ NeXTstep or Windows, this could be different, and input would come
+ directly from the console).
+*/
/* GCC does not like forward enum declaration. This needs to be
defined here. What a disgust! */
Index: src/emacs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.165
diff -u -r1.165 emacs.c
--- src/emacs.c 23 Apr 2006 16:11:32 -0000 1.165
+++ src/emacs.c 25 Apr 2006 13:18:41 -0000
＠＠ -911,7 +911,7 ＠＠
#endif /* not SYSTEM_MALLOC or HAVE_LIBMCHECK or DOUG_LEA_MALLOC */
noninteractive = 0;
- display_use = 0;
+ display_use = NULL;
inhibit_non_essential_conversion_operations = 1;
#ifdef NEW_GC
Index: src/font-mgr.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.c,v
retrieving revision 1.1
diff -u -r1.1 font-mgr.c
--- src/font-mgr.c 23 Apr 2006 16:11:33 -0000 1.1
+++ src/font-mgr.c 25 Apr 2006 13:18:41 -0000
＠＠ -32,8 +32,6 ＠＠
/* This module provides the Lisp interface to fonts in X11, including Xft,
but (at least at first) not GTK+ or Qt.
- It should be renamed to fonts-x.h.
-
Sealevel code should be in ../lwlib/lwlib-fonts.c or
../lwlib/lwlib-colors.c.
*/
＠＠ -69,7 +67,7 ＠＠
. Fontconfig fontnames are encoded in UTF-8.
*/
-Lisp_Object Qxft_font;
+Lisp_Object Qfont_mgr;
Lisp_Object Qfc_patternp;
Lisp_Object Qfc_fontsetp;
/* Lisp_Object Qfc_result_match; */ /* FcResultMatch */
＠＠ -122,9 +120,11 ＠＠
is a Lisp string.
*/
#define extract_fcapi_string(str) \
- ((FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((str), Qnative))
+ ((FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((str), Qfc_font_name_encoding))
+
+/* #### This homebrew lashup should be replaced with FcConstants.
-/* fontconfig assumes that objects (property names) are statically allocated,
+ fontconfig assumes that objects (property names) are statically allocated,
and you will get bizarre results if you pass Lisp string data or strings
allocated on the stack as objects. fontconfig _does_ copy values, so we
(I hope) don't have to worry about that member.
＠＠ -135,12 +135,20 ＠＠
I suspect that using symbol names or even keywords does not provide
assurance that the string won't move in memory. So we hash them
- ourselves; hash.c hashtables do not interpret the value pointers. */
-static FcChar8 *fc_standard_properties[] = {
- "antialias", "aspect", "autohint", "charset", "dpi", "family", "file",
+ ourselves; hash.c hashtables do not interpret the value pointers.
+
+ This array should be FcChar8**, but GCC 4.x bitches about signedness. */
+static Extbyte *fc_standard_properties[] = {
+ /* treated specially, ordered first */
+ "family", "size",
+ /* remaining are alphabetized by group */
+ /* standard properties in fontconfig and Xft v.2 */
+ "antialias", "aspect", "autohint", "charset", "dpi", "file",
"foundry", "ftface", "globaladvance", "hinting", "index", "lang",
"minspace", "outline", "pixelsize", "rasterizer", "rgba", "scalable",
- "scale", "size", "slant", "spacing", "style", "verticallayout", "weight",
+ "scale", "slant", "spacing", "style", "verticallayout", "weight",
+ /* common in modern fonts */
+ "fontformat", "fontversion",
/* obsolete after Xft v. 1 */
"charwidth", "charheight", "core", "encoding", "render"
};
＠＠ -213,7 +221,7 ＠＠
CHECK_FCPATTERN(pattern);
{
FcChar8 *temp = FcNameUnparse(XFCPATTERN_PTR(pattern));
- Lisp_Object res = build_ext_string (temp, Qxft_font_name_encoding);
+ Lisp_Object res = build_ext_string (temp, Qfc_font_name_encoding);
free (temp);
return res;
}
＠＠ -419,7 +427,7 ＠＠
case FcTypeString:
return ((!NILP (type) && !EQ (type, Qstring))
? Qfc_result_type_mismatch
- : build_ext_string (fc_value.u.s, Qxft_font_name_encoding));
+ : build_ext_string (fc_value.u.s, Qfc_font_name_encoding));
case FcTypeBool:
return ((!NILP (type) && !EQ (type, Qboolean))
? Qfc_result_type_mismatch : fc_value.u.b ? Qt : Qnil);
＠＠ -457,7 +465,6 ＠＠
`fc-result-no-match' and `fc-result-no-id'. */
(device, pattern))
{
- Display *dpy;
FcResult res;
struct fc_pattern *res_fcpat =
＠＠ -469,11 +476,15 ＠＠
if (!DEVICE_LIVE_P(XDEVICE(device)))
return Qnil;
- dpy = DEVICE_X_DISPLAY(XDEVICE(device));
- /* More Xft vs fontconfig brain damage? */
- res_fcpat->fcpatPtr = XftFontMatch(dpy, DefaultScreen (dpy),
- XFCPATTERN_PTR(pattern), &res);
-
+ {
+ FcPattern *p = XFCPATTERN_PTR(pattern);
+ FcConfig *fcc = FcConfigGetCurrent ();
+
+ FcConfigSubstitute (fcc, p, FcMatchPattern);
+ FcDefaultSubstitute (p);
+ res_fcpat->fcpatPtr = FcFontMatch (fcc, p, &res);
+ }
+
if (res_fcpat->fcpatPtr == NULL)
switch (res) {
case FcResultNoMatch:
＠＠ -576,41 +587,6 ＠＠
}
}
-/* #### this actually is an Xft function, should split those out
- or get rid of them entirely? */
-/* #### be consistent about argument order. */
-DEFUN("fc-font-real-pattern", Ffc_font_real_pattern, 2, 2, 0, /*
-Temporarily open FONTNAME (a string) and return the actual
-fc pattern matched by the Fc library. */
- (fontname, xdevice))
-{
- FcPattern *copy;
- Display *dpy;
- XftFont *font;
- struct fc_pattern *fcpat =
- ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
-
- CHECK_STRING (fontname); /* #### MEMORY LEAK?! maybe not ... */
- if (NILP(xdevice))
- return Qnil;
- CHECK_X_DEVICE (xdevice);
- if (!DEVICE_LIVE_P(XDEVICE(xdevice)))
- return Qnil;
-
- /* #### these gymnastics should be unnecessary, just use FcFontMatch */
- dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice));
- font = XftFontOpenName (dpy, DefaultScreen(dpy),
- extract_fcapi_string (fontname));
- if (font == NULL)
- return Qnil;
- copy = FcPatternDuplicate(font->pattern);
- XftFontClose(dpy, font);
- if (copy == NULL)
- return Qnil;
- fcpat->fcpatPtr = copy;
- return wrap_fcpattern(fcpat);
-}
-
DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
Check whether the string FONTNAME is a XLFD font name. */
(fontname))
＠＠ -744,7 +720,7 ＠＠
DEFSYMBOL(Qfc_result_no_match);
DEFSYMBOL(Qfc_result_no_id);
DEFSYMBOL(Qfc_internal_error);
- DEFSYMBOL(Qxft_font);
+ DEFSYMBOL(Qfont_mgr);
DEFSUBR(Ffc_pattern_p);
DEFSUBR(Ffc_pattern_create);
＠＠ -757,14 +733,13 ＠＠
DEFSUBR(Ffc_list_fonts_pattern_objects);
DEFSUBR(Ffc_font_sort);
DEFSUBR(Ffc_font_match);
- DEFSUBR(Ffc_font_real_pattern);
DEFSUBR(Fxlfd_font_name_p);
}
void
vars_of_font_mgr (void)
{
- /* #### These two variables need to go somewhere else. */
+ /* #### The next two functions belong somewhere else. */
/* #### I know, but the right fix is use the generic debug facility. */
DEFVAR_INT ("xft-debug-level", &debug_xft /*
＠＠ -780,7 +761,7 ＠＠
*/ );
Vxft_version = make_int(XFT_VERSION);
- Fprovide (intern ("xft"));
+ Fprovide (intern ("font-mgr"));
}
void
Index: src/font-mgr.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.h,v
retrieving revision 1.1
diff -u -r1.1 font-mgr.h
--- src/font-mgr.h 23 Apr 2006 16:11:33 -0000 1.1
+++ src/font-mgr.h 25 Apr 2006 13:18:41 -0000
＠＠ -48,7 +48,7 ＠＠
extern Fixnum debug_xft;
/* Standard for fontconfig. Use a macro to show we're not guessing. */
-#define Qxft_font_name_encoding Qutf_8
+#define Qfc_font_name_encoding Qutf_8
#define XE_XLFD_MAKE_LISP_STRING(s) (make_string(s, strlen(s)))
Index: src/objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.38
diff -u -r1.38 objects-x.c
--- src/objects-x.c 23 Apr 2006 16:11:33 -0000 1.38
+++ src/objects-x.c 25 Apr 2006 13:18:41 -0000
＠＠ -255,7 +255,7 ＠＠
DECLARE_EISTRING (eistrpxft_name); \
FcChar8 *name = FcNameUnparse (pattern); \
\
- eicpy_ext(eistrpxft_name, name, Qxft_font_name_encoding); \
+ eicpy_ext(eistrpxft_name, name, Qfc_font_name_encoding); \
DEBUG_XFT1 (level, format, eidata(eistrpxft_name)); \
free (name); \
} while (0)
＠＠ -267,7 +267,7 ＠＠
#define CHECKING_LANG(level,font,lang) \
do { \
DECLARE_EISTRING (eistrcl_name); \
- eicpy_ext(eistrcl_name, font, Qxft_font_name_encoding); \
+ eicpy_ext(eistrcl_name, font, Qfc_font_name_encoding); \
DEBUG_XFT2 (level, "checking if %s handles %s\n", \
eidata(eistrcl_name), lang); \
} while (0)
＠＠ -295,7 +295,7 ＠＠
The problem is that the fontconfig/Xft functions work much too hard
to ensure that something is returned; but that something need not be
at all close to what we asked for. */
- LISP_STRING_TO_EXTERNAL (f->name, extname, Qxft_font_name_encoding);
+ LISP_STRING_TO_EXTERNAL (f->name, extname, Qfc_font_name_encoding);
rf = xft_open_font_by_name (dpy, extname);
#endif
LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding);
＠＠ -808,7 +808,7 ＠＠
if (res)
{
FONT_INSTANCE_TRUENAME (f) =
- build_ext_string (res, Qxft_font_name_encoding);
+ build_ext_string (res, Qfc_font_name_encoding);
free (res);
return FONT_INSTANCE_TRUENAME (f);
}
＠＠ -1218,7 +1218,7 ＠＠
DECLARE_EISTRING (eistr_longname); /* omit FC_LANG and FC_CHARSET */
DECLARE_EISTRING (eistr_fullname); /* everything */
- LISP_STRING_TO_EXTERNAL (font, patternext, Qxft_font_name_encoding);
+ LISP_STRING_TO_EXTERNAL (font, patternext, Qfc_font_name_encoding);
fcc = FcConfigGetCurrent ();
/* parse the name, do the substitutions, and match the font */
＠＠ -1251,7 +1251,7 ＠＠
/* full name, including language coverage and repertoire */
name = FcNameUnparse (p);
- eicpy_ext (eistr_fullname, name, Qxft_font_name_encoding);
+ eicpy_ext (eistr_fullname, name, Qfc_font_name_encoding);
free (name);
/* long name, omitting coverage and repertoire, plus a number
＠＠ -1268,7 +1268,7 ＠＠
FcPatternDel (p, FC_SCALE);
FcPatternDel (p, FC_FONTVERSION);
name = FcNameUnparse (p);
- eicpy_ext (eistr_longname, name, Qxft_font_name_encoding);
+ eicpy_ext (eistr_longname, name, Qfc_font_name_encoding);
free (name);
/* nickname, just family and size, but
＠＠ -1282,7 +1282,7 ＠＠
FcPatternDel (p, FC_SCALABLE);
FcPatternDel (p, FC_DPI);
name = FcNameUnparse (p);
- eicpy_ext (eistr_shortname, name, Qxft_font_name_encoding);
+ eicpy_ext (eistr_shortname, name, Qfc_font_name_encoding);
free (name);
FcPatternDestroy (p);
Index: src/redisplay.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v
retrieving revision 1.98
diff -u -r1.98 redisplay.c
--- src/redisplay.c 26 Nov 2005 11:46:10 -0000 1.98
+++ src/redisplay.c 25 Apr 2006 13:18:41 -0000
＠＠ -470,9 +470,12 ＠＠
where one page is used for Emacs and another for all else. */
int no_redraw_on_reenter;
-Lisp_Object Vwindow_system; /* nil or a symbol naming the window system
+Lisp_Object Vwindow_system; /* #### this variable is deprecated
+ nil or a symbol naming the window system
under which emacs is running
- (`x' is the only current possibility) */
+ (`x', `gtk', `mswindows', and `tty' are
+ supported -- yes, TTYs are window systems
+ for this purpose. */
Lisp_Object Vinitial_window_system;
Lisp_Object Vglobal_mode_string;
Index: src/symsinit.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symsinit.h,v
retrieving revision 1.56
diff -u -r1.56 symsinit.h
--- src/symsinit.h 23 Apr 2006 16:11:33 -0000 1.56
+++ src/symsinit.h 25 Apr 2006 13:18:41 -0000
＠＠ -149,7 +149,7 ＠＠
void syms_of_menubar_x (void);
void syms_of_minibuf (void);
void syms_of_module (void);
-void syms_of_canna_api (void);
+EXTERN_C void syms_of_canna_api (void);
void syms_of_mule_ccl (void);
void syms_of_mule_charset (void);
void syms_of_mule_coding (void);
＠＠ -388,7 +388,7 ＠＠
void reinit_vars_of_minibuf (void);
void vars_of_module (void);
void reinit_vars_of_module (void);
-void vars_of_canna_api (void);
+EXTERN_C void vars_of_canna_api (void);
void vars_of_mule_ccl(void);
void vars_of_mule_charset (void);
void vars_of_mule_coding (void);
--
School of Systems and Information Engineering http://turnbull.sk.tsukuba.ac.jp
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Ask not how you can "do" free software business;
ask what your business can "do for" free software.
- 1 participants
- 0 comments
[PATCH 21.5] XEmacs crashes with menu-accelerator-enabled followed by Shift-spacebar
18 years, 8 months
Jerry James
Jerry James
PATCH 21.5
Further investigation showed that it was only the console slot that
wasn't being copied and should have. This fixes the problem for me.
Doug, can you give this patch a try?
src/ChangeLog addition:
2006-04-22 Jerry James <james(a)xemacs.org>
* event-stream.c (copy_command_builder): Also copy the console.
xemacs-21.5 source patch:
Diff command: cvs -q diff -uN
Files affected: src/event-stream.c
Index: src/event-stream.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-stream.c,v
retrieving revision 1.93
diff -d -u -r1.93 event-stream.c
--- src/event-stream.c 2006/02/27 16:29:24 1.93
+++ src/event-stream.c 2006/04/23 03:05:24
＠＠ -429,6 +429,8 ＠＠
if (!new_buildings)
new_buildings = XCOMMAND_BUILDER (allocate_command_builder (Qnil, 0));
+ new_buildings->console = collapsing->console;
+
new_buildings->self_insert_countdown = collapsing->self_insert_countdown;
deallocate_event_chain (new_buildings->current_events);
--
Jerry James, Assistant Professor james(a)xemacs.org
Computer Science Department http://www.cs.usu.edu/~jerry/
Utah State University
- 2 participants
- 3 comments
[COMMIT] Docstring improvements for basic Lisp functions, CL
18 years, 8 months
Aidan Kehoe
Aidan Kehoe
NOTE: This patch has been committed.
Back in January, Alan made a suggestion on the FSF’s emacs-devel that was,
as his suggestions so often are, full of good sense.
http://article.gmane.org/gmane.emacs.devel/49575 for the particular changes
that I’ve incorporated in this patch; at the same time, I’ve also made the
CL macro documentation a bit clearer and more consistent.
lisp/ChangeLog addition:
2006-04-16 Aidan Kehoe <kehoea(a)parhasard.net>
* cl.el (incf):
* cl.el (decf):
* cl.el (pop):
* cl.el (push):
* cl.el (pushnew):
Docstring clarifications; drop non-standard formatting for incf,
decf, pop, move to GNU's parameter names for push, pushnew since
they make it much easier to remember the right order.
src/ChangeLog addition:
2006-04-16 Aidan Kehoe <kehoea(a)parhasard.net>
* data.c (Fconsp):
* data.c (Fsymbolp):
* data.c (Fcar):
* data.c (Flistp):
* data.c (Fsetcar):
* data.c (Fsetcdr):
* data.c (Flss):
* data.c (Fgtr):
Short docstring clarifications to make life easier for people who
are learning Lisp; explain what a cons is in the consp docstring,
what a symbol is in the symbolp docstring, and so forth. Thank you
Alan Mackenzie on emacs-devel.
Expand on "monotonically increasing" and "monotonically
decreasing" in the Flss and Fgtr docstrings.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/data.c lisp/cl.el
Index: lisp/cl.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cl.el,v
retrieving revision 1.15
diff -u -u -r1.15 cl.el
--- lisp/cl.el 2005/01/26 09:53:32 1.15
+++ lisp/cl.el 2006/04/16 15:29:57
＠＠ -132,7 +132,7 ＠＠
;;; can safely be used in .emacs files.
(defmacro incf (place &optional x)
- "(incf PLACE [X]): increment PLACE by X (1 by default).
+ "Increment PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The return value is the incremented value of PLACE."
(if (symbolp place)
＠＠ -142,7 +142,7 ＠＠
(list 'callf '+ place (or x 1))))
(defmacro decf (place &optional x)
- "(decf PLACE [X]): decrement PLACE by X (1 by default).
+ "Decrement PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The return value is the decremented value of PLACE."
(if (symbolp place)
＠＠ -150,7 +150,7 ＠＠
(list 'callf '- place (or x 1))))
(defmacro pop (place)
- "(pop PLACE): remove and return the head of the list stored in PLACE.
+ "Remove and return the head of the list stored in PLACE.
Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
careful about evaluating each argument only once and in the right order.
PLACE may be a symbol, or any generalized variable allowed by `setf'."
＠＠ -158,21 +158,22 ＠＠
`(car (prog1 ,place (setq ,place (cdr ,place))))
(cl-do-pop place)))
-(defmacro push (x place)
- "(push X PLACE): insert X at the head of the list stored in PLACE.
-Analogous to (setf PLACE (cons X PLACE)), though more careful about
-evaluating each argument only once and in the right order. PLACE may
+(defmacro push (newelt listname)
+ "Add NEWELT to the list stored in LISTNAME.
+Analogous to (setf LISTNAME (cons NEWELT LISTNAME)), though more careful about
+evaluating each argument only once and in the right order. LISTNAME may
be a symbol, or any generalized variable allowed by `setf'."
- (if (symbolp place) `(setq ,place (cons ,x ,place))
- (list 'callf2 'cons x place)))
+ (if (symbolp listname) `(setq ,listname (cons ,newelt ,listname))
+ (list 'callf2 'cons newelt listname)))
-(defmacro pushnew (x place &rest keys)
- "(pushnew X PLACE): insert X at the head of the list if not already there.
-Like (push X PLACE), except that the list is unmodified if X is `eql' to
-an element already on the list.
+(defmacro pushnew (newelt listname &rest keys)
+ "Add NEWELT to the list stored in LISTNAME, unless it's already there.
+Like (push NEWELT LISTNAME), except that the list is unmodified if NEWELT is
+`eql' to an element already on the list.
Keywords supported: :test :test-not :key"
- (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
- (list* 'callf2 'adjoin x place keys)))
+ (if (symbolp listname) (list 'setq listname
+ (list* 'adjoin newelt listname keys))
+ (list* 'callf2 'adjoin newelt listname keys)))
(defun cl-set-elt (seq n val)
(if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
Index: src/data.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/data.c,v
retrieving revision 1.65
diff -u -u -r1.65 data.c
--- src/data.c 2005/10/24 10:07:35 1.65
+++ src/data.c 2006/04/16 15:29:58
＠＠ -216,6 +216,11 ＠＠
DEFUN ("consp", Fconsp, 1, 1, 0, /*
Return t if OBJECT is a cons cell. `nil' is not a cons cell.
+
+A cons cell is a Lisp object (an area in memory) comprising two pointers
+called the CAR and the CDR. Each of these pointers can point to any other
+Lisp object. The common Lisp data type, the list, is a specially-structured
+series of cons cells.
*/
(object))
{
＠＠ -232,6 +237,10 ＠＠
DEFUN ("listp", Flistp, 1, 1, 0, /*
Return t if OBJECT is a list. `nil' is a list.
+
+A list is implemented as a series of cons cells structured such that the CDR
+of each cell either points to another cons cell or to `nil', the special
+Lisp value for both Boolean false and the empty list.
*/
(object))
{
＠＠ -256,6 +265,9 ＠＠
DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /*
Return t if OBJECT is a symbol.
+
+A symbol is a Lisp object with a name. It can optionally have any and all of
+a value, a property list and an associated function.
*/
(object))
{
＠＠ -600,19 +612,21 ＠＠
/* Extract and set components of lists */
DEFUN ("car", Fcar, 1, 1, 0, /*
-Return the car of LIST. If arg is nil, return nil.
-Error if arg is not nil and not a cons cell. See also `car-safe'.
+Return the car of CONS. If CONS is nil, return nil.
+The car of a list or a dotted pair is its first element.
+
+Error if CONS is not nil and not a cons cell. See also `car-safe'.
*/
- (list))
+ (cons))
{
while (1)
{
- if (CONSP (list))
- return XCAR (list);
- else if (NILP (list))
+ if (CONSP (cons))
+ return XCAR (cons);
+ else if (NILP (cons))
return Qnil;
else
- list = wrong_type_argument (Qlistp, list);
+ cons = wrong_type_argument (Qlistp, cons);
}
}
＠＠ -625,19 +639,22 ＠＠
}
DEFUN ("cdr", Fcdr, 1, 1, 0, /*
-Return the cdr of LIST. If arg is nil, return nil.
+Return the cdr of CONS. If CONS is nil, return nil.
+The cdr of a list is the list without its first element. The cdr of a
+dotted pair (A . B) is the second element, B.
+
Error if arg is not nil and not a cons cell. See also `cdr-safe'.
*/
- (list))
+ (cons))
{
while (1)
{
- if (CONSP (list))
- return XCDR (list);
- else if (NILP (list))
+ if (CONSP (cons))
+ return XCDR (cons);
+ else if (NILP (cons))
return Qnil;
else
- list = wrong_type_argument (Qlistp, list);
+ cons = wrong_type_argument (Qlistp, cons);
}
}
＠＠ -651,6 +668,7 ＠＠
DEFUN ("setcar", Fsetcar, 2, 2, 0, /*
Set the car of CONS-CELL to be NEWCAR. Return NEWCAR.
+The car of a list or a dotted pair is its first element.
*/
(cons_cell, newcar))
{
＠＠ -663,6 +681,8 ＠＠
DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /*
Set the cdr of CONS-CELL to be NEWCDR. Return NEWCDR.
+The cdr of a list is the list without its first element. The cdr of a
+dotted pair (A . B) is the second element, B.
*/
(cons_cell, newcdr))
{
＠＠ -986,7 +1006,12 ＠＠
DEFUN ("<", Flss, 1, MANY, 0, /*
Return t if the sequence of arguments is monotonically increasing.
-The arguments may be numbers, characters or markers.
+
+(That is, if there is a second argument, it must be numerically greater than
+the first. If there is a third, it must be numerically greater than the
+second, and so on.) At least one argument is required.
+
+The arguments may be numbers, characters or markers.
*/
(int nargs, Lisp_Object *args))
{
＠＠ -995,6 +1020,11 ＠＠
DEFUN (">", Fgtr, 1, MANY, 0, /*
Return t if the sequence of arguments is monotonically decreasing.
+
+(That is, if there is a second argument, it must be numerically less than
+the first. If there is a third, it must be numerically less than the
+second, and so forth.) At least one argument is required.
+
The arguments may be numbers, characters or markers.
*/
(int nargs, Lisp_Object *args))
--
In the beginning God created the heavens and the earth. And God was a
bug-eyed, hexagonal smurf with a head of electrified hair; and God said:
“Si, mi chiamano Mimi...”
- 2 participants
- 3 comments
[AC21.5] A small refactoring in the Xft code
18 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT 21.5
Not for 21.4.
This patch has the following goals:
- Clean out cruft related to Xft v.1, which we don't support at all.
- Eliminate some obsolete or unneeded Xft APIs (often related to v.1).
- Avoid load/require'ing fontconfig.el when Xft isn't available.
- Eliminate redundant XEmacs APIs. Specifically, we had both named
constants for font pattern components and component-specific
accessors in fontconfig.el. I got rid of the former in favor of the
latter.
- Begin separating fontconfig from Xft. I plan to use the former as a
platform-independent API for font instantiators, for use in face
frobbing. This part of the API is easy to emulate in Lisp, and we
already use a very similar API in font.el. Although this isn't the
same as having font components separately handled in faces, it
should be close enough. This involves
- Renaming src/xft-fonts.* to src/font-mgr.*. If Lisp emulation is
too inefficient, we can probably do this in C even without
fontconfig itself. font-mgr.* contain almost no Xft-specific code
at this point, they're purely fontconfig-based.
- A stub lisp/font-mgr.el, which I'll fill in with the fontconfig
emulation over time (patches welcome, of course!) This may
actually replace font.el completely.
- A new config.h symbol, HAVE_FONTCONFIG. Currently it's a synonym
for USE_XFT. (I plan to rename the USE_XFT family to HAVE_XFT.)
- A new Internals node describing some of the issues I ran into in
trying (and failing, for now) to create a separate Xft console.
This may be of limited interest to Jerry in working on Doug Kramer's
bug report, and also to implementers of new consoles such as Carbon
or Cocoa on the Mac, Qt, or BeOS. (All of these already exist
although often as 3rd-party branches, but I hope more people will
work on them.)
In the process of updating the nodes and menus, a few other menus
that needed update were caught, and minor style differences in menus
and node links were brought into conformance with what
texinfo-master-menu thinks is correct.
The only code that actually gets executed that changed is the
elimination of the "object constants" for fontconfig. This code gets
heavily exercised at startup, so I believe it's well-enough tested to
commit. Some of the changes might affect builds, but the default
build --with-xft=emacs,tabs,menubars,gauges and also --without-xft
both succeed, so I think that's ok.
Will fix any new bugs and revert on request, of course.
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/ChangeLog,v
retrieving revision 1.499
diff -u -r1.499 ChangeLog
--- ChangeLog 31 Mar 2006 19:18:51 -0000 1.499
+++ ChangeLog 23 Apr 2006 14:24:06 -0000
＠＠ -0,0 +1,4 ＠＠
+2006-04-15 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * configure.ac: Add stubs for fontconfig configuration.
+
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.736
diff -u -r1.736 ChangeLog
--- lisp/ChangeLog 16 Apr 2006 15:54:16 -0000 1.736
+++ lisp/ChangeLog 23 Apr 2006 14:24:10 -0000
＠＠ -0,0 +1,32 ＠＠
+2006-04-24 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * dumped-lisp.el (fontconfig): Load only with Xft.
+
+ * x-faces.el (fontconfig): Require only with Xft.
+
+2006-04-16 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * font-mgr.el: New file. Provides Lisp emulation of fontconfig.
+
+ * fontconfig.el: Require 'font-mgr.
+
+2006-04-11 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * fontconfig.el:
+ Add some comments on proposed generic APIs.
+ Remove some unused and probably broken code.
+ Use `fc-define-property' to define new X11 XLFD standard
+ properties: x11-swidth, x11-adstyle, x11-resx, x11-resy,
+ x11-registry, and x11-encoding.
+ Delete fc-font-name-property-PROPERTY constants.
+ (fc-define-property):
+ Add `fc-pattern-del-PROPERTY'.
+
+ * x-faces.el (x-make-font-bold-xft):
+ (x-make-font-unbold-xft):
+ (x-make-font-italic-xft):
+ (x-make-font-unitalic-xft):
+ (x-find-xft-font-of-size):
+ * x-font-menu.el (x-font-menu-load-font-xft):
+ Use property-specific APIs instead of defconsts for property names.
+
Index: lwlib/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/ChangeLog,v
retrieving revision 1.83
diff -u -r1.83 ChangeLog
--- lwlib/ChangeLog 31 Mar 2006 19:19:36 -0000 1.83
+++ lwlib/ChangeLog 23 Apr 2006 14:24:10 -0000
＠＠ -0,0 +1,4 ＠＠
+2006-04-22 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * lwlib-fonts.c: Rename xft-fonts.h to font-mgr.h.
+
Index: man/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/man/ChangeLog,v
retrieving revision 1.336
diff -u -r1.336 ChangeLog
--- man/ChangeLog 31 Mar 2006 19:19:47 -0000 1.336
+++ man/ChangeLog 23 Apr 2006 14:24:10 -0000
＠＠ -0,0 +1,5 ＠＠
+2006-04-23 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * internals/internals.texi: Run texinfo-master-menu.
+ (Creating a New Console/Device/Frame Type): New node.
+
Index: src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.945
diff -u -r1.945 ChangeLog
--- src/ChangeLog 22 Apr 2006 15:18:54 -0000 1.945
+++ src/ChangeLog 23 Apr 2006 14:24:21 -0000
＠＠ -0,0 +1,33 ＠＠
+2006-04-23 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * Makefile.in.in (x_objs): Change xft-fonts.o to font-mgr.o.
+
+2006-04-17 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * config.h.in: New symbol HAVE_FONTCONFIG.
+
+2006-04-22 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ Rename xft-fonts.{c,h} to font-mgr.{c,h}.
+
+ * font-mgr.c:
+ * emacs.c:
+ * symsinit.h:
+ (syms_of_font_mgr):
+ (vars_of_font_mgr):
+ (reinit_vars_of_font_mgr):
+ (complex_vars_of_font_mgr):
+ Renamed from *_xft_fonts versions.
+
+ * font-mgr.c:
+ * inline.c:
+ * objects-x.c:
+ Update #includes and comments to refer to font-mgr.h.
+ N.B. The feature provided by objects-x.c is still "xft-fonts",
+ which is separate from the font management by fontconfig (from
+ font-mgr.*).
+
+2006-04-15 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * console-x.h (<X11/Xft/Xft.h>): Don't cater to Xft v.1.
+
Index: configure.ac
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v
retrieving revision 1.40
diff -u -r1.40 configure.ac
--- configure.ac 30 Mar 2006 18:11:17 -0000 1.40
+++ configure.ac 23 Apr 2006 14:24:07 -0000
＠＠ -669,6 +669,11 ＠＠
[AC_DEFINE(INFOPATH_USER_DEFINED)], [])
dnl
XE_HELP_SUBSECTION([Window-system options])
+dnl Enable when fontconfig support is factored out of Xft.
+dnl XE_MERGED_ARG([fontconfig],
+dnl AS_HELP_STRING([--with-fontconfig],
+dnl [Use fontconfig library to configure fonts.],
+dnl [],[])
dnl if you change defaults, make sure to fix arg 6 of the OPTION_HELP macro.
XE_COMPLEX_ARG([xft],
[XE_COMPLEX_OPTION_HELP_STRING([--with-xft],
＠＠ -3463,6 +3468,9 ＠＠
[XE_DIE(["Unable to find libfontconfig for --with-xft"])])
AC_CHECK_LIB(Xft, XftFontOpen, XE_PREPEND(-lXft, libs_x),
[XE_DIE(["Unable to find libXft for --with-xft"])])
+ dnl #### detect fontconfig properly!!!!
+ with_fontconfig=yes
+ AC_DEFINE(HAVE_FONTCONFIG)
AC_DEFINE(USE_XFT)
dnl Due to interactions with other libraries, must postpone AC_DEFINE
dnl of USE_XFT_MENUBARS, USE_XFT_TABS, and USE_XFT_GAUGE.
＠＠ -5976,6 +5984,9 ＠＠
fi
if test "$with_wmcommand" != no; then
echo " - Handling WM_COMMAND properly."
+ fi
+ if test "$with_fontconfig" = "yes"; then
+ echo " - Using fontconfig to manage fonts."
fi
if test "$with_xft_emacs" = "yes"; then
echo " - Compiling in support for Xft antialiased fonts (EXPERIMENTAL)."
Index: lisp/dumped-lisp.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/dumped-lisp.el,v
retrieving revision 1.57
diff -u -r1.57 dumped-lisp.el
--- lisp/dumped-lisp.el 26 Nov 2005 11:45:53 -0000 1.57
+++ lisp/dumped-lisp.el 23 Apr 2006 16:00:29 -0000
＠＠ -54,7 +54,7 ＠＠
"specifier"
"frame" ; needed by faces
;; #### this should be (featurep 'xft)
- (when (featurep 'x) "fontconfig") ; needed by x-faces
+ (when (featurep 'xft-fonts) "fontconfig") ; needed by x-faces
(when (featurep 'x) "x-faces") ; needed by faces
(when (featurep 'gtk) "gtk-faces")
(when (valid-console-type-p 'mswindows) "msw-faces")
Index: lisp/font-mgr.el
===================================================================
RCS file: lisp/font-mgr.el
diff -N lisp/font-mgr.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/font-mgr.el 23 Apr 2006 14:24:10 -0000
＠＠ -0,0 +1,255 ＠＠
+;;; font-mgr.el --- Lisp emulation of fontconfig for X fonts.
+
+;; Copyright (C) 2006 Free Software Foundation, Inc.
+
+;; Author: Stephen J. Turnbull <stephen(a)xemacs.org>
+;; Created: 12 Apr 2006 by Stephen J. Turnbull
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by the
+;; Free Software Foundation; either version 2, or (at your option) any
+;; later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;; for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; Synched up with: Not in GNU Emacs.
+
+;; Commentary
+;; This module provides the Lisp interface to fonts in X11, including Xft,
+;; but (at least at first) not GTK+ or Qt. It is a substitute for the
+;; C library fontconfig, whose interface is provided in ../src/font-mgr.c.
+
+;; static FcChar8 *fc_standard_properties[] = {
+;; "antialias", "aspect", "autohint", "charset", "dpi", "family", "file",
+;; "foundry", "ftface", "globaladvance", "hinting", "index", "lang",
+;; "minspace", "outline", "pixelsize", "rasterizer", "rgba", "scalable",
+;; "scale", "size", "slant", "spacing", "style", "verticallayout", "weight",
+;; /* obsolete after Xft v. 1 */
+;; "charwidth", "charheight", "core", "encoding", "render"
+
+;; #### should we wrap the world in `(unless (featurep 'font-mgr) ... )'?
+
+(provide 'font-mgr)
+
+(defvar xft-xlfd-font-regexp
+ (concat
+ ;; XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII
+ ;; in Mule when this function is called. So use HPC.
+ ;; (xe_xlfd_prefix "\\(\\+[\040-\176\240-\377]*\\)?-")
+ ;; (xe_xlfd_opt_text "\\([\040-\044\046-\176\240-\377]*\\)")
+ ;; (xe_xlfd_text "\\([\040-\044\046-\176\240-\377]+\\)")
+ "\\`"
+ "\\(\\+[\040-\176]*\\)?-" ; prefix
+ "\\([^-]+\\)" ; foundry
+ "-"
+ "\\([^-]+\\)" ; family
+ "-"
+ "\\([^-]+\\)" ; weight
+ "-"
+ "\\([0-9ior?*][iot]?\\)" ; slant
+ "-"
+ "\\([^-]+\\)" ; swidth
+ "-"
+ "\\([^-]*\\)" ; adstyle
+ "-"
+ "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)" ; pixelsize
+ "-"
+ "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)" ; pointsize
+ "-"
+ "\\([0-9?*]+\\)" ; resx
+ "-"
+ "\\([0-9?*]+\\)" ; resy
+ "-"
+ "\\([cmp?*]\\)" ; spacing
+ "-"
+ "~?" ; avgwidth
+ "\\([0-9?*]+\\)"
+ "-"
+ "\\([^-]+\\)" ; registry
+ "-"
+ "\\([^-]+\\)" ; encoding
+ "\\'")
+ "The regular expression used to match XLFD font names.")
+
+(defun fc-pattern-p (object)
+ "Returns t if OBJECT is of type fc-pattern, nil otherwise."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(defun fc-pattern-create ()
+ "Return a new, empty fc-pattern object."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(defun fc-name-parse (fontname)
+ "Parse an Fc font name and return its representation as a fc pattern object."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(defun fc-name-unparse (pattern)
+ "Unparse an fc pattern object to a string."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(defun fc-pattern-duplicate (pattern)
+ "Make a copy of the fc pattern object PATTERN and return it."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(defun fc-pattern-add (pattern property value)
+ "Add attributes to the pattern object PATTERN. PROPERTY is a string naming
+the attribute to add, VALUE the value for this attribute.
+
+VALUE may be a string, integer, float, or symbol, in which case the value
+will be added as an FcChar8[], int, double, or FcBool respectively."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(defun fc-pattern-del (pattern property)
+ "Remove attribute PROPERTY from fc pattern object PATTERN."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+;; Generic interface to FcPatternGet()
+;; Don't support the losing symbol-for-property interface.
+
+(defun fc-pattern-get (pattern property &optional id type)
+ "From PATTERN, extract PROPERTY for the ID'th member, of type TYPE.
+
+PATTERN is an Xft \(fontconfig) pattern object.
+PROPERTY is a string naming an fontconfig font property.
+Optional ID is a nonnegative integer indexing the list of values for PROPERTY
+ stored in PATTERN, defaulting to 0 (the first value).
+Optional TYPE is a symbol, one of 'string, 'boolean, 'integer, 'float,
+ 'double, 'matrix, 'charset, or 'void, corresponding to the FcValue types.
+ \('float is an alias for 'double).
+
+The Lisp types returned will conform to TYPE:
+ string string
+ boolean `t' or `nil'
+ integer integer
+ double \(float) float
+ matrix not implemented
+ charset not implemented
+ void not implemented
+
+Symbols with names of the form \"fc-result-DESCRIPTION\" are returned when
+the desired value is not available. These are
+
+ fc-result-type-mismatch the value found has an unexpected type
+ fc-result-no-match there is no such attribute
+ fc-result-no-id there is no value for the requested ID
+
+The types of the following standard properties are predefined by fontconfig.
+The symbol 'fc-result-type-mismatch will be returned if the object exists but
+TYPE does not match the predefined type. It is best not to specify a type
+for predefined properties, as a mistake here ensures error returns on the
+correct type.
+
+Each standard property has a convenience accessor defined in fontconfig.el,
+named in the form \"fc-pattern-get-PROPERTY\". The convenience functions are
+preferred to `fc-pattern-get' since a typo in the string naming a property
+will result in a silent null return, while a typo in a function name will
+usually result in a compiler or runtime \"not fboundp\" error. You may use
+`defsubst' to define convenience functions for non-standard properties.
+
+family String Font family name
+style String Font style. Overrides weight and slant
+slant Int Italic, oblique or roman
+weight Int Light, medium, demibold, bold or black
+size Double Point size
+aspect Double Stretches glyphs horizontally before hinting
+pixelsize Double Pixel size
+spacing Int Proportional, monospace or charcell
+foundry String Font foundry name
+antialias Bool Whether glyphs can be antialiased
+hinting Bool Whether the rasterizer should use hinting
+verticallayout Bool Use vertical layout
+autohint Bool Use autohinter instead of normal hinter
+globaladvance Bool Use font global advance data
+file String The filename holding the font
+index Int The index of the font within the file
+ftface FT_Face Use the specified FreeType face object
+rasterizer String Which rasterizer is in use
+outline Bool Whether the glyphs are outlines
+scalable Bool Whether glyphs can be scaled
+scale Double Scale factor for point->pixel conversions
+dpi Double Target dots per inch
+rgba Int unknown, rgb, bgr, vrgb, vbgr, none - subpixel geometry
+minspace Bool Eliminate leading from line spacing
+charset CharSet Unicode chars encoded by the font
+lang String List of RFC-3066-style languages this font supports
+
+The FT_Face, Matrix, CharSet types are unimplemented, so the corresponding
+properties are not accessible from Lisp at this time. If the value of a
+property returned has type FT_Face, FcCharSet, or FcMatrix,
+`fc-result-type-mismatch' is returned.
+
+The following properties which were standard in Xft v.1 are obsolete in
+Xft v.2: encoding, charwidth, charheight, core, and render."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(defun fc-font-match (device pattern)
+ "Return the font on DEVICE that most closely matches PATTERN.
+
+DEVICE is an X11 device.
+PATTERN is a fontconfig pattern object.
+Returns a fontconfig pattern object representing the closest match to the
+given pattern, or an error code. Possible error codes are
+`fc-result-no-match' and `fc-result-no-id'."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+;; #### fix this name to correspond to Ben's new nomenclature
+(defun fc-list-fonts-pattern-objects (device pattern properties)
+ "Return a list of fonts on DEVICE that match PATTERN for PROPERTIES.
+Each font is represented by a fontconfig pattern object.
+
+DEVICE is an X11 device.
+PATTERN is a fontconfig pattern to be matched.
+PROPERTIES is a list of property names (strings) that should match.
+
+#### DEVICE is unused, ignored, and may be removed if it's not needed to
+match other font-listing APIs."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+;; #### maybe this can/should be folded into fc-list-fonts-pattern-objects?
+(defun fc-font-sort (device pattern &optional trim nosub)
+ "Return a list of all fonts sorted by proximity to PATTERN.
+Each font is represented by a fontconfig pattern object.
+
+DEVICE is an X11 device.
+PATTERN is a fontconfig pattern to be matched.
+Optional argument TRIM, if non-nil, means to trim trailing fonts that do not
+contribute new characters to the union repertoire.
+
+#### Optional argument NOSUB, if non-nil, suppresses some of the usual
+property substitutions. DON'T USE THIS in production code, it is intended
+for exploring behavior of fontconfig and will be removed when this code is
+stable.
+
+#### DEVICE is unused, ignored, and may be removed if it's not needed to
+match other font-listing APIs."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+
+(when nil
+ ;; #### this actually is an Xft function, should split those out
+ ;; or get rid of them entirely?
+ ;; #### be consistent about argument order.
+(defun fc-font-real-pattern (fontname xdevice)
+ "Temporarily open FONTNAME (a string) and return the actual
+fc pattern matched by the Fc library."
+ (error 'unimplemented "font-mgr library is experimental and incomplete"))
+)
+
+(defun xlfd-font-name-p (fontname)
+ "Check whether the string FONTNAME is a XLFD font name."
+ (save-match-data
+ (string-match xft-xlfd-font-regexp fontname)))
+
+;; FcPatternPrint: there is no point in having wrappers fc-pattern-print,
+;; Ffc_pattern_print since this function prints to stdout.
+
+;;; end font-mgr.el
Index: lisp/fontconfig.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/fontconfig.el,v
retrieving revision 1.2
diff -u -r1.2 fontconfig.el
--- lisp/fontconfig.el 26 Nov 2005 11:45:54 -0000 1.2
+++ lisp/fontconfig.el 23 Apr 2006 14:24:10 -0000
＠＠ -105,10 +105,11 ＠＠
;; constructor function `fc-pattern-create'. #### It might make sense
;; to generalize `make-fc-pattern' by allowing a plist of properties
;; as an optional argument. We also provide accessors
-;; `fc-pattern-get-PROPERTY' and mutators `fc-pattern-add-PROPERTY'
-;; for each of the standard properties used by Xft, which overlap
-;; substantially with the properties defined by X11. #### We probably
-;; should provide `fc-pattern-delete-PROPERTY', too.
+;; `fc-pattern-get-PROPERTY' and mutators `fc-pattern-add-PROPERTY' and
+;; `fc-pattern-del-PROPERTY' for each of the standard properties used by
+;; Xft, which overlap substantially with the properties defined by X11.
+
+(require 'font-mgr)
(defalias 'make-fc-pattern 'fc-pattern-create)
＠＠ -117,10 +118,10 ＠＠
A font property is a key in a fontconfig pattern and is associated with
one or more values of a given type. This macro creates wrappers around
-`fc-pattern-get' and `fc-pattern-add' for PROPERTY. Wrappers are
-preferred to use of primitives with a string as the OBJECT argument because
-typos in wrappers result in \"not fboundp\" errors, while a typo in a string
-produces a silent null return.
+`fc-pattern-get', `fc-pattern-add', and `fc-pattern-del' for PROPERTY.
+\(Wrappers are preferred to use of primitives with a string as the OBJECT
+argument because typos in wrappers result in \"not fboundp\" errors, while
+a typo in a string produces a silent null return.)
PROPERTY is a string.
TYPE is a symbol indicating the type of the property value. It is used only
＠＠ -140,7 +141,10 ＠＠
A mutator `fc-pattern-add-PROPERTY' which takes a fontconfig pattern object
and a value as arguments, and adds the value to the property with the next
id. The type of the value is recognized by `fc-pattern-add', and the id
-is chosen by the fontconfig implementation."
+is chosen by the fontconfig implementation.
+
+A mutator `fc-pattern-del-PROPERTY' which takes a fontconfig pattern object,
+and deletes all values of that property from the pattern."
`(progn
(defsubst ,(intern (concat "fc-pattern-get-" property))
＠＠ -179,6 +183,20 ＠＠
"")
type)
(fc-pattern-add pattern ,property value))
+
+ (defsubst ,(intern (concat "fc-pattern-del-" property))
+ (pattern)
+ ,(format "\
+Delete all values of the %s property of fontconfig pattern PATTERN.%s
+
+This function is a convenience wrapper for `fc-pattern-del'.
+See `fc-pattern-del' for documentation of patterns and error returns."
+ property
+ (if obsolete-p "
+\(Obsolete, only available on systems using Xft version 1.)"
+ "")
+ type)
+ (fc-pattern-del pattern ,property))
,property))
;; define the standard properties for Xft v.2 here
＠＠ -202,67 +220,25 ＠＠
(fc-define-property "weight" integer "the weight")
(fc-define-property "xlfd" string "the XLFD (full name in X11)")
-;; Xft v.1 properties (marked as obsolete)
+;; Xft v.1 properties (generally marked as obsolete)
+;; had different semantics from XLFD "encoding"
(fc-define-property "encoding" string "the encoding" t)
-(fc-define-property "charwidth" integer "the average character width" t)
+;; also used by X11 XLFDs, so not obsolete
+(fc-define-property "charwidth" integer "the average character width")
(fc-define-property "charheight" integer "the average character height" t)
(fc-define-property "core" boolean "represents a core font" t)
(fc-define-property "render" boolean "represents a render (Xft) font" t)
+;; X11 XLFD and other standard properties
+(fc-define-property "x11-swidth" string "the 'set' width")
+(fc-define-property "x11-adstyle" string "any additional style")
+(fc-define-property "x11-resx" string "the horizontal design resolution")
+(fc-define-property "x11-resy" string "the vertical design resolution")
+;; use "charwidth" instead of "x11-avgwidth"
+(fc-define-property "x11-registry" string "the encoding registry")
+;; "x11-encoding" has different semantics from Xft v.1 "encoding"
+(fc-define-property "x11-encoding" string "the encoding index")
-(defconst fc-font-name-property-family "family")
-(defconst fc-font-name-property-style "style")
-(defconst fc-font-name-property-slant "slant")
-(defconst fc-font-name-property-weight "weight")
-(defconst fc-font-name-property-size "size")
-(defconst fc-font-name-property-pixelsize "pixelsize")
-(defconst fc-font-name-property-spacing "spacing")
-(defconst fc-font-name-property-foundry "foundry")
-(defconst fc-font-name-property-antialias "antialias")
-(defconst fc-font-name-property-xlfd "xlfd")
-(defconst fc-font-name-property-file "file")
-(defconst fc-font-name-property-index "index")
-(defconst fc-font-name-property-rasterizer "rasterizer")
-(defconst fc-font-name-property-outline "outline")
-(defconst fc-font-name-property-scalable "scalable")
-(defconst fc-font-name-property-rgba "rgba")
-(defconst fc-font-name-property-minspace "minspace")
-(defconst fc-font-name-property-dpi "dpi")
-
-;; Xft version 1 only
-;;(defconst fc-font-name-property-encoding "encoding")
-;;(defconst fc-font-name-property-charwidth "charwidth")
-;;(defconst fc-font-name-property-charheight "charheight")
-;;(defconst fc-font-name-property-core "core")
-;;(defconst fc-font-name-property-render "render")
-
-
-(defconst fc-pattern-selector-mapping
- `((,fc-font-name-property-family . fc-pattern-get-family)
- (,fc-font-name-property-style . fc-pattern-get-style)
- (,fc-font-name-property-slant . fc-pattern-get-slant)
- (,fc-font-name-property-weight . fc-pattern-get-weight)
- (,fc-font-name-property-size . fc-pattern-get-size)
- (,fc-font-name-property-pixelsize . fc-pattern-get-pixelsize)
- (,fc-font-name-property-spacing . fc-pattern-get-spacing)
- (,fc-font-name-property-foundry . fc-pattern-get-foundry)
- (,fc-font-name-property-antialias . fc-pattern-get-antialias)
- (,fc-font-name-property-xlfd . fc-pattern-get-xlfd)
- (,fc-font-name-property-file . fc-pattern-get-file)
- (,fc-font-name-property-index . fc-pattern-get-index)
- (,fc-font-name-property-rasterizer . fc-pattern-get-rasterizer)
- (,fc-font-name-property-outline . fc-pattern-get-outline)
- (,fc-font-name-property-scalable . fc-pattern-get-scalable)
- (,fc-font-name-property-rgba . fc-pattern-get-rgba)
- (,fc-font-name-property-minspace . fc-pattern-get-minspace)
- (,fc-font-name-property-dpi . fc-pattern-get-dpi)
- ;; Xft version 1 only
- ;; (,fc-font-name-property-encoding . fc-pattern-get-encoding)
- ;; (,fc-font-name-property-charwidth . fc-pattern-get-char-width)
- ;; (,fc-font-name-property-charheight . fc-pattern-get-char-height)
- ;; (,fc-font-name-property-core . fc-pattern-get-core)
- ;; (,fc-font-name-property-render . fc-pattern-get-render)
- ))
(defvar fc-find-available-font-families-fc-fonts-only t
"If `fc-find-available-font-families-fc-fonts-only' is set to `t',
＠＠ -415,7 +391,33 ＠＠
;;
;; fc-name-parse
;; fc-name-unparse
-;; xft-name-unparse
+;; xft-name-unparse (nonfunctional and presumably obsolete)
+;;
+;; For interfacing with various font rendering systems, we need to be able
+;; to convert the fontconfig patterns to names, and vice versa. The high-
+;; level API is
+;;
+;; font-default-name-syntax
+;; variable naming the default naming syntax
+;; maybe this could be a list to try in order?
+;;
+;; font-name-to-pattern NAME &optional SYNTAX
+;; returns a fontconfig pattern, or nil if the name could not be parsed
+;; NAME is a string
+;; SYNTAX is a name syntax symbol
+;;
+;; font-pattern-to-name PATTERN &optional SYNTAX
+;; returns a string
+;; PATTERN is a fontconfig pattern
+;; SYNTAX is a name syntax symbol
+;;
+;; A "name syntax symbol" is a symbol for a font naming syntax. This may be
+;; a rendering engine syntax or a font manager syntax. Initially, 'x and
+;; 'fontconfig will be supported. Patterns may be unambiguous (one value for
+;; each specified property) or ambiguous (multiple values are allowed for
+;; some specified properties). `font-name-to-pattern' should be unambiguous,
+;; but `font-pattern-to-name' may not be an exact conversion for some
+;; syntaxes, especially for ambiguous patterns.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
＠＠ -429,6 +431,29 ＠＠
;; fc-list-fonts-pattern-objects
;; fc-font-sort
;; fc-font-real-pattern
+;;
+;; The high-level API is
+;;
+;; font-list &optional PATTERN DEVICE ATTRIBUTE-LIST OPTION-LIST
+;; returns a list of patterns matching pattern
+;; PATTERN is an ambiguous pattern, defaulting to the empty pattern
+;; DEVICE is the display device to query (default: selected device)
+;; ATTRIBUTE-LIST is a list of font attributes to restrict the patterns
+;; in the returned list to; other attributes will not be present in
+;; the patterns, and duplicates will be removed after pruning unwanted
+;; attributes; ATTRIBUTE-LIST has no necessary relation to the active
+;; attributes in PATTERN, both subset and superset make sense; if nil,
+;; the active attributes in PATTERN is used
+;; OPTION-LIST is a list of presentation options, such as sort order
+;; and refresh-cache (if any).
+;;
+;; font-match PATTERN &optional DEVICE
+;; returns a pattern representing the platform match for PATTERN,
+;; which should unambiguously select the same font
+;; PATTERN is an ambiguous pattern
+;; DEVICE is the display device to query (default: selected device)
+;;
+;; Maybe these APIs should get an error-behavior argument?
;; #### it might make sense to generalize `fc-try-font' by having a
;; global variable that contains a list of font name parsers. They are
＠＠ -446,15 +471,17 ＠＠
(fc-name-parse font))
nil))
+;; for example, we'd like these next two to be implementable as
+;; (font-list (fc-create-pattern) device '("family" "style")) and
+;; (font-list (let ((p (fc-create-pattern))) (fc-pattern-add "family" family))
+;; device
+;; '("weight"))
+
(defun fc-find-available-font-families (&optional device filter-fun)
"Find all available font families."
(let ((device (or device (default-x-device)))
(pattern (make-fc-pattern))
(objectset '("family" "style")))
-; Xft2: does not work anymore
-; (if (not fc-find-available-font-families-fc-fonts-only)
-; (fc-pattern-add pattern fc-font-name-property-core t))
-; (fc-objectset-add objectset fc-font-name-property-encoding)
(let* ((all-fonts
(fc-list-fonts-pattern-objects device pattern objectset)))
(fc-delete-duplicates
＠＠ -465,24 +492,14 ＠＠
(fc-filter all-fonts filter-fun)
all-fonts))))))
-; Xft2: does not work anymore
-; (defun fc-find-available-font-families-non-mule (&optional device)
-; (fc-find-available-font-families
-; device
-; '(lambda (pattern)
-; (let ((encodings (fc-pattern-get-all-attributes
-; pattern 'fc-pattern-get-encoding)))
-; ;; Be sure that the font support ISO-8859-1
-; (member "iso8859-1" encodings)))))
-
(defun fc-find-available-weights-for-family (family &optional style device)
"Find available weights for font FAMILY."
(let* ((device (or device (default-x-device)))
(pattern (make-fc-pattern))
(objectset '("weight")))
- (fc-pattern-add pattern fc-font-name-property-family family)
+ (fc-pattern-add-family pattern family)
(if style
- (fc-pattern-add pattern fc-font-name-property-style style))
+ (fc-pattern-add-style pattern style))
(mapcar
'(lambda (pattern)
(let ((fc-weight-constant (fc-pattern-get-weight pattern 0)))
Index: lisp/x-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v
retrieving revision 1.23
diff -u -r1.23 x-faces.el
--- lisp/x-faces.el 5 Dec 2005 09:43:37 -0000 1.23
+++ lisp/x-faces.el 23 Apr 2006 16:00:29 -0000
＠＠ -66,7 +66,19 ＠＠
'(x-get-resource-and-maybe-bogosity-check
x-get-resource x-init-pointer-shape))
-(require 'fontconfig)
+(if (featurep 'xft-fonts)
+ (require 'fontconfig)
+ (globally-declare-boundp
+ '(fc-font-name-weight-bold fc-font-name-weight-black
+ fc-font-name-weight-demibold fc-font-name-weight-medium
+ fc-font-name-slant-oblique fc-font-name-slant-italic
+ fc-font-name-slant-roman))
+ (globally-declare-fboundp
+ '(fc-font-real-pattern fc-pattern-get-size fc-copy-pattern-partial
+ fc-pattern-del-weight fc-pattern-del-style fc-pattern-duplicate
+ fc-pattern-add-weight fc-try-font fc-pattern-add-size
+ fc-name-unparse fc-pattern-del-slant fc-pattern-add-slant
+ fc-pattern-del-size fc-pattern-get-pixelsize)))
(defconst x-font-regexp nil)
(defconst x-font-regexp-head nil)
＠＠ -186,32 +186,28 ＠＠
font (or device (default-x-device)))))
(if pattern
(let ((size (fc-pattern-get-size pattern 0))
- (copy (fc-copy-pattern-partial
- pattern (list fc-font-name-property-family))))
- (fc-pattern-del copy fc-font-name-property-weight)
- (fc-pattern-del copy fc-font-name-property-style)
+ (copy (fc-copy-pattern-partial pattern (list "family"))))
+ (fc-pattern-del-weight copy)
+ (fc-pattern-del-style copy)
(when copy
(or
;; try bold font
(let ((copy-2 (fc-pattern-duplicate copy)))
- (fc-pattern-add copy-2 fc-font-name-property-weight
- fc-font-name-weight-bold)
+ (fc-pattern-add-weight copy-2 fc-font-name-weight-bold)
(when (fc-try-font copy-2 device)
- (fc-pattern-add copy-2 fc-font-name-property-size size)
+ (fc-pattern-add-size copy-2 size)
(fc-name-unparse copy-2)))
;; try black font
(let ((copy-2 (fc-pattern-duplicate copy)))
- (fc-pattern-add copy-2 fc-font-name-property-weight
- fc-font-name-weight-black)
+ (fc-pattern-add-weight copy-2 fc-font-name-weight-black)
(when (fc-try-font copy-2 device)
- (fc-pattern-add copy-2 fc-font-name-property-size size)
+ (fc-pattern-add-size copy-2 size)
(fc-name-unparse copy-2)))
;; try demibold font
(let ((copy-2 (fc-pattern-duplicate copy)))
- (fc-pattern-add copy-2 fc-font-name-property-weight
- fc-font-name-weight-demibold)
+ (fc-pattern-add-weight copy-2 fc-font-name-weight-demibold)
(when (fc-try-font copy-2 device)
- (fc-pattern-add copy-2 fc-font-name-property-size size)
+ (fc-pattern-add-size copy-2 size)
(fc-name-unparse copy-2)))))))))
(defun x-make-font-bold-core (font &optional device)
＠＠ -233,9 +229,8 ＠＠
(let ((pattern (fc-font-real-pattern
font (or device (default-x-device)))))
(when pattern
- (fc-pattern-del pattern fc-font-name-property-weight)
- (fc-pattern-add pattern fc-font-name-property-weight
- fc-font-name-weight-medium)
+ (fc-pattern-del-weight pattern)
+ (fc-pattern-add-weight pattern fc-font-name-weight-medium)
(if (fc-try-font pattern device)
(fc-name-unparse pattern)))))
＠＠ -265,39 +260,37 ＠＠
font (or device (default-x-device)))))
(if pattern
(let ((size (fc-pattern-get-size pattern 0))
- (copy (fc-copy-pattern-partial
- pattern (list fc-font-name-property-family))))
+ (copy (fc-copy-pattern-partial pattern (list "family"))))
(when copy
- (fc-pattern-del copy fc-font-name-property-slant)
- (fc-pattern-del copy fc-font-name-property-style)
+ (fc-pattern-del-slant copy)
+ (fc-pattern-del-style copy)
+ ;; #### can't we do this with one ambiguous pattern?
(let ((pattern-oblique (fc-pattern-duplicate copy))
(pattern-italic (fc-pattern-duplicate copy)))
- (fc-pattern-add pattern-oblique fc-font-name-property-slant
- fc-font-name-slant-oblique)
- (fc-pattern-add pattern-italic fc-font-name-property-slant
- fc-font-name-slant-italic)
+ (fc-pattern-add-slant pattern-oblique fc-font-name-slant-oblique)
+ (fc-pattern-add-slant pattern-italic fc-font-name-slant-italic)
(let ((have-oblique (fc-try-font pattern-oblique device))
(have-italic (fc-try-font pattern-italic device)))
(if try-oblique-before-italic-fonts
(if have-oblique
(progn
(if size
- (fc-pattern-add pattern-oblique fc-font-name-property-size size))
+ (fc-pattern-add-size pattern-oblique size))
(fc-name-unparse pattern-oblique))
(if have-italic
(progn
(if size
- (fc-pattern-add pattern-italic fc-font-name-property-size size))
+ (fc-pattern-add-size pattern-italic size))
(fc-name-unparse pattern-italic))))
(if have-italic
(progn
(if size
- (fc-pattern-add pattern-italic fc-font-name-property-size size))
+ (fc-pattern-add-size pattern-italic size))
(fc-name-unparse pattern-italic))
(if have-oblique
(progn
(if size
- (fc-pattern-add pattern-oblique fc-font-name-property-size size))
+ (fc-pattern-add-size pattern-oblique size))
(fc-name-unparse pattern-oblique))))))))))))
(defun x-make-font-italic-core (font &optional device)
＠＠ -320,9 +313,8 ＠＠
(let ((pattern (fc-font-real-pattern
font (or device (default-x-device)))))
(when pattern
- (fc-pattern-del pattern fc-font-name-property-slant)
- (fc-pattern-add pattern fc-font-name-property-slant
- fc-font-name-slant-roman)
+ (fc-pattern-del-slant pattern)
+ (fc-pattern-add-slant pattern fc-font-name-slant-roman)
(if (fc-try-font pattern device)
(fc-name-unparse pattern)))))
＠＠ -523,9 +515,8 ＠＠
(let ((size (fc-pattern-get-size pattern 0)))
(if (floatp size)
(let ((copy (fc-pattern-duplicate pattern)))
- (fc-pattern-del copy fc-font-name-property-size)
- (fc-pattern-add copy fc-font-name-property-size
- (funcall new-size-proc size))
+ (fc-pattern-del-size copy)
+ (fc-pattern-add-size copy (funcall new-size-proc size))
(if (fc-try-font font device)
(fc-name-unparse copy))))))))
Index: lisp/x-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v
retrieving revision 1.14
diff -u -r1.14 x-font-menu.el
--- lisp/x-font-menu.el 26 Nov 2005 11:45:55 -0000 1.14
+++ lisp/x-font-menu.el 23 Apr 2006 14:24:10 -0000
＠＠ -346,15 +346,15 ＠＠
(defun x-font-menu-load-font-xft (family weight size slant resolution)
(let ((pattern (make-fc-pattern)))
- (fc-pattern-add pattern fc-font-name-property-family family)
+ (fc-pattern-add-family pattern family)
(if weight
- (fc-pattern-add pattern fc-font-name-property-weight
- (fc-font-weight-translate-from-string weight)))
+ (fc-pattern-add-weight pattern
+ (fc-font-weight-translate-from-string weight)))
(if size
- (fc-pattern-add pattern fc-font-name-property-size size))
+ (fc-pattern-add-size pattern size))
(if slant
- (fc-pattern-add pattern fc-font-name-property-slant
- (fc-font-slant-translate-from-string slant)))
+ (fc-pattern-add-slant pattern
+ (fc-font-slant-translate-from-string slant)))
(make-font-instance (fc-name-unparse pattern))))
(defun x-font-menu-load-font-core (family weight size slant resolution)
Index: lwlib/lwlib-fonts.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-fonts.c,v
retrieving revision 1.2
diff -u -r1.2 lwlib-fonts.c
--- lwlib/lwlib-fonts.c 26 Nov 2005 11:45:59 -0000 1.2
+++ lwlib/lwlib-fonts.c 23 Apr 2006 14:24:10 -0000
＠＠ -36,7 +36,7 ＠＠
#include "device.h"
#include "device-impl.h"
#include "console-x-impl.h"
-#include "xft-fonts.h"
+#include "font-mgr.h"
#endif
/*
Index: man/internals/internals.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/man/internals/internals.texi,v
retrieving revision 1.74
diff -u -r1.74 internals.texi
--- man/internals/internals.texi 31 Mar 2006 17:51:29 -0000 1.74
+++ man/internals/internals.texi 23 Apr 2006 14:24:16 -0000
＠＠ -311,7 +311,7 ＠＠
* XEmacs from the Perspective of Building::
* Build-Time Dependencies::
* The Modules of XEmacs::
-* The Build Configuration System::
+* The Build Configuration System::
* Rules When Writing New C Code::
* Regression Testing XEmacs::
* CVS Techniques::
＠＠ -361,6 +361,7 ＠＠
The Modules of XEmacs
* A Summary of the Various XEmacs Modules::
+* Modules for Building XEmacs::
* Low-Level Modules::
* Basic Lisp Modules::
* Modules for Standard Editing Operations::
＠＠ -368,6 +369,19 ＠＠
* Modules for Other Aspects of the Lisp Interpreter and Object System::
* Modules for Interfacing with the Operating System::
+Modules for Building XEmacs
+
+* Modules for Build Configuration::
+* Modules for Compiling XEmacs::
+* Modules for Preloading Lisp::
+
+The Build Configuration System
+
+* The version.sh Script::
+* Adding Configurable Features::
+* The configure Script::
+* The Makefile Precursors::
+
Rules When Writing New C Code
* Introduction to Writing C Code::
＠＠ -393,7 +407,7 ＠＠
CVS Techniques
-* Creating a Branch::
+* Creating a Branch::
* Merging a Branch into the Trunk::
Low-Level Allocation
＠＠ -471,12 +485,12 ＠＠
* Encodings::
* Internal Mule Encodings::
* Byte/Character Types; Buffer Positions; Other Typedefs::
-* Internal Text APIs::
+* Internal Text APIs::
* Coding for Mule::
* CCL::
* Microsoft Windows-Related Multilingual Issues::
* Modules for Internationalization::
-* The Great Mule Merge of March 2002::
+* The Great Mule Merge of March 2002::
Encodings
＠＠ -525,18 +539,18 ＠＠
The Great Mule Merge of March 2002
-* List of changed files in new Mule workspace::
-* Changes to the MULE subsystems::
-* Pervasive changes throughout XEmacs sources::
-* Changes to specific subsystems::
-* Mule changes by theme::
-* File-coding rewrite::
-* General User-Visible Changes::
-* General Lisp-Visible Changes::
-* User documentation::
-* General internal changes::
-* Ben's TODO list:: Probably obsolete.
-* Ben's README:: Probably obsolete.
+* List of changed files in new Mule workspace::
+* Changes to the MULE subsystems::
+* Pervasive changes throughout XEmacs sources::
+* Changes to specific subsystems::
+* Mule changes by theme::
+* File-coding rewrite::
+* General User-Visible Changes::
+* General Lisp-Visible Changes::
+* User documentation::
+* General internal changes::
+* Ben's TODO list:: Probably obsolete.
+* Ben's README:: Probably obsolete.
Consoles; Devices; Frames; Windows
＠＠ -544,6 +558,7 ＠＠
* Point::
* Window Hierarchy::
* The Window Object::
+* Creating a New Console/Device/Frame Type::
* Modules for the Basic Displayable Lisp Objects::
The Redisplay Mechanism
＠＠ -595,7 +610,7 ＠＠
Subprocesses
-* Ben's separate stderr notes:: Probably obsolete.
+* Ben's separate stderr notes:: Probably obsolete.
Interface to MS Windows
＠＠ -603,7 +618,7 ＠＠
* Windows Build Flags::
* Windows I18N Introduction::
* Modules for Interfacing with MS Windows::
-* CHANGES from 21.4-windows branch:: Probably obsolete.
+* CHANGES from 21.4-windows branch:: Probably obsolete.
Interface to the X Window System
＠＠ -661,7 +676,7 ＠＠
* Future Work -- Display Tables::
* Future Work -- Making Elisp Function Calls Faster::
* Future Work -- Lisp Engine Replacement::
-* Future Work -- Better Rendering Support::
+* Future Work -- Better Rendering Support::
Future Work -- Toolbars
＠＠ -697,6 +712,20 ＠＠
* Future Work -- Lisp Engine Replacement -- Implementation::
* Future Work -- Startup File Modification by Packages::
+Future Work -- Better Rendering Support
+
+* Better Rendering Support -- Review Criteria::
+* Better Rendering Support -- Implementation::
+* Better Rendering Support -- Current Status::
+* Better Rendering Support -- Configuration with the Interim Patches::
+* Better Rendering Support -- Modern Font Support::
+
+Better Rendering Support -- Modern Font Support
+
+* Modern Font Support -- Font Concepts:: GUI devices, fonts, glyphs, rendering.
+* Modern Font Support -- fontconfig:: Querying and selecting fonts.
+* Modern Font Support -- Xft:: Rendering fonts on X11.
+
Future Work Discussion
* Discussion -- Garbage Collection::
＠＠ -2737,7 +2766,7 ＠＠
＠menu
* A Summary of the Various XEmacs Modules::
-* Modules for Building XEmacs::
+* Modules for Building XEmacs::
* Low-Level Modules::
* Basic Lisp Modules::
* Modules for Standard Editing Operations::
＠＠ -3247,9 +3276,9 ＠＠
＠cindex building XEmacs, modules for
＠menu
-* Modules for Build Configuration::
-* Modules for Compiling XEmacs::
-* Modules for Preloading Lisp::
+* Modules for Build Configuration::
+* Modules for Compiling XEmacs::
+* Modules for Preloading Lisp::
＠end menu
＠＠ -3288,7 +3317,7 ＠＠
-＠node Modules for Preloading Lisp, , Modules for Compiling XEmacs, Modules for Building XEmacs
+＠node Modules for Preloading Lisp, , Modules for Compiling XEmacs, Modules for Building XEmacs
＠subsection Modules for Preloading Lisp
＠cindex modules for preloading lisp
＠cindex preloading lisp, modules for
＠＠ -4357,10 +4386,10 ＠＠
system.
＠menu
-* The version.sh Script::
+* The version.sh Script::
* Adding Configurable Features::
-* The configure Script::
-* The Makefile Precursors::
+* The configure Script::
+* The Makefile Precursors::
＠end menu
＠＠ -4836,7 +4865,7 ＠＠
-＠node The Makefile Precursors, , The configure Script, The Build Configuration System
+＠node The Makefile Precursors, , The configure Script, The Build Configuration System
＠section The Makefile Precursors
＠cindex Makefile precursors
＠cindex precursors, Makefile
＠＠ -6603,7 +6632,7 ＠＠
＠cindex CVS techniques
＠menu
-* Creating a Branch::
+* Creating a Branch::
* Merging a Branch into the Trunk::
＠end menu
＠＠ -10389,12 +10418,12 ＠＠
* Encodings::
* Internal Mule Encodings::
* Byte/Character Types; Buffer Positions; Other Typedefs::
-* Internal Text APIs::
+* Internal Text APIs::
* Coding for Mule::
* CCL::
* Microsoft Windows-Related Multilingual Issues::
* Modules for Internationalization::
-* The Great Mule Merge of March 2002::
+* The Great Mule Merge of March 2002::
＠end menu
＠node Introduction to Multilingual Issues #1, Introduction to Multilingual Issues #2, Multilingual Support, Multilingual Support
＠＠ -14102,7 +14131,7 ＠＠
prepended with an L (causing it to be a wide string) depending on
XEUNICODE_P.
-＠node Modules for Internationalization, The Great Mule Merge of March 2002, Microsoft Windows-Related Multilingual Issues, Multilingual Support
+＠node Modules for Internationalization, The Great Mule Merge of March 2002, Microsoft Windows-Related Multilingual Issues, Multilingual Support
＠section Modules for Internationalization
＠cindex modules for internationalization
＠cindex internationalization, modules for
＠＠ -14208,22 +14237,22 ＠＠
remains to be done.
＠menu
-* List of changed files in new Mule workspace::
-* Changes to the MULE subsystems::
-* Pervasive changes throughout XEmacs sources::
-* Changes to specific subsystems::
-* Mule changes by theme::
-* File-coding rewrite::
-* General User-Visible Changes::
-* General Lisp-Visible Changes::
-* User documentation::
-* General internal changes::
-* Ben's TODO list:: Probably obsolete.
-* Ben's README:: Probably obsolete.
+* List of changed files in new Mule workspace::
+* Changes to the MULE subsystems::
+* Pervasive changes throughout XEmacs sources::
+* Changes to specific subsystems::
+* Mule changes by theme::
+* File-coding rewrite::
+* General User-Visible Changes::
+* General Lisp-Visible Changes::
+* User documentation::
+* General internal changes::
+* Ben's TODO list:: Probably obsolete.
+* Ben's README:: Probably obsolete.
＠end menu
-＠node List of changed files in new Mule workspace, Changes to the MULE subsystems, , The Great Mule Merge of March 2002
+＠node List of changed files in new Mule workspace, Changes to the MULE subsystems, The Great Mule Merge of March 2002, The Great Mule Merge of March 2002
＠subsection List of changed files in new Mule workspace
This node lists the files that were touched in the Great Mule Merge.
＠＠ -15307,7 +15336,7 ＠＠
interrupt the same process, use the injection method.
＠end itemize
-＠node Ben's README, , Ben's TODO list, The Great Mule Merge of March 2002
+＠node Ben's README, , Ben's TODO list, The Great Mule Merge of March 2002
＠subsection Ben's README (probably obsolete)
These notes substantially overlap those in ＠ref{Ben's TODO list}. They
＠＠ -17176,6 +17205,7 ＠＠
* Point::
* Window Hierarchy::
* The Window Object::
+* Creating a New Console/Device/Frame Type::
* Modules for the Basic Displayable Lisp Objects::
＠end menu
＠＠ -17345,7 +17375,7 ＠＠
artifact that should be fixed.)
＠end enumerate
-＠node The Window Object, Modules for the Basic Displayable Lisp Objects, Window Hierarchy, Consoles; Devices; Frames; Windows
+＠node The Window Object, Creating a New Console/Device/Frame Type, Window Hierarchy, Consoles; Devices; Frames; Windows
＠section The Window Object
＠cindex window object, the
＠cindex object, the window
＠＠ -17452,7 +17482,144 ＠＠
this field is ＠code{nil}.
＠end table
-＠node Modules for the Basic Displayable Lisp Objects, , The Window Object, Consoles; Devices; Frames; Windows
+
+＠node Creating a New Console/Device/Frame Type, Modules for the Basic Displayable Lisp Objects, The Window Object, Consoles; Devices; Frames; Windows
+＠section Creating a New Console, Device, or Frame Type
+＠cindex creating a new console type
+＠cindex console type, creating a new
+＠cindex creating a new device type
+＠cindex device type, creating a new
+＠cindex creating a new frame type
+＠cindex frame type, creating a new
+
+Unfortunately, at the present time, only the console abstraction is at
+all well-maintained. Device and frame internals are referred to from
+many places in the redisplay and console code. The best that can be
+done therefore is to create a whole new console type, even though much
+code will be shared. (Ben Wing has complained about the code
+duplication in the GTK+ v1 console, and probably would not be happy with
+the unpublished Qt console or Andrew Choi's Carbon console, but it's
+hard to see how those consoles could have been done better without
+fixing the abstractions in the X (actually Xt), MS Windows, and tty
+consoles as well as doing a complete refactoring of the console, device,
+and frame code.)
+
+What is desireable is sharing console, device, and frame methods across
+platforms in a more general way, reducing the amount of duplicated code
+by pulling it back into the redisplay engine proper or the Lisp modules
+as appropriate. For example, we should be able to use
+＠samp{make-frame-on-device} to share a single X connection among GTK, X,
+and Xft frames. Xft is partially implemented, but GTK would be much
+harder (impossible?) because it has its own event loop. (Xft shares the
+Xt event loop with the X console.)
+
+The way all methods get added to the console type is uncool. A console
+should be a composite, which indicates a collection of I/O resources
+``used together.'' It should indicate where operations that change
+``focus'' search for targets, ＠emph{i.e.}, by default new frames are
+created on the selected device of the console where the input that
+invoked the command was received, ＠samp{pop-to-buffer-other-window} only
+considers existing windows on the same device of the same console,
+(a)emph{etc.} But it should be possible to assemble consoles out of
+component input channels, imaging devices, and multimedia (audio)
+channels.
+
+The following notes may provide some guidance to those who wish to
+create new console types (＠emph{i.e.}, port the redisplay code to a new
+platform). They are based on an unsuccessful attempt to refactor the
+Xft code into a new console type while sharing most routines with the X
+console. (For clarification or suggestions, feel free to write
+＠email{stephen＠(a)xemacs.org,Stephen Turnbull}.)
+
+The first thing to realize is that the naming of many modules obscures
+their relationship to the console abstraction. For example, the
+＠file{objects-＠var{console-type}}, ＠file{redisplay-＠var{console-type}},
+and ＠file{glyphs-＠var{console-type}} series of modules have nothing to
+do with Lisp objects and little to do with redisplay, respectively.
+Rather they implement abstractions used for rendering on each console
+type, such as fonts and colors (＠file{objects}) and string and graphics
+drawing primitives (＠file{rendering}). These modules are conceptually
+part of the console implementations, not part of redisplay or Lisp.
+
+Public methods of a console are implemented as C functions declared
+＠code{static}, following a rigid naming convention:
+＠samp{＠var{console-type}_＠var{method-name}}. Methods are bound to the
+console type in the ＠samp{console_type_create_＠var{file}} functions for
+each console component (console, device, and frame) using the
+＠samp{CONSOLE_HAS_METHOD} family of macros. Methods for displaying
+images are bound using the ＠samp{IIFORMAT_HAS_DEVMETHOD} family of
+macros. Methods are invoked using the ＠samp{CONMETH}, ＠samp{DEVMETH},
+and ＠samp{FRAMEMETH} families of macros, which look up the relevant
+methods in the object's table of methods.
+
+(a)strong{N.B.} All of the object tables are actually references to
+console method tables. To create a variant of an existing console,
+there is a ＠samp{CONSOLE_INHERITS_METHOD} constructor, but this actually
+constructs the name of the parent's method pointer and stores in the
+derived console type's method table. Of course this is time-efficient,
+and since there are few console types it is a neglible waste of space.
+However in practice this may have contributed to breaking the various
+abstractions, and the variant console must be coded in the same file as
+the parent (because the methods are static). Another minor symptom of
+the incompleteness of the abstraction is the fact that the API for
+inheritance of device methods for image formats is named
+＠samp{IIFORMAT_HAS_SHARED_METHOD}, although the semantics are identical.
+
+One problem encountered in attempting to create an Xft console type as a
+derivative of the X console type was that there is no support for such
+union types in the consistency-checking code, whether for the
+fundamental Lisp consistency checks (the ＠samp{CHECK_SOMETHING} family
+of macros) or for the error-checking variants of many functions. These
+APIs all simply check for the apparent console type, which is a single
+symbol (or enumerator).
+
+To create a new console with mostly new methods, it's probably best to
+copy all of the ＠file{＠var{function}-＠var{console-type}} files from a
+similar console (or several, if the new console type seems like a
+combination of several existing console types), renaming the files by
+substituting ＠var{new-console-type} for ＠var{console-type}. Then
+proceed in the obvious way by renaming methods from
+＠samp{＠var{console-type}_＠var{method-name}} to
+＠samp{＠var{new-console-type}_＠var{method-name}}, and implementing them.
+
+Once you've done that, then the fun starts. Insert the initialization
+functions (＠samp{syms_of_＠var{file}}, ＠samp{vars_of_＠var{file}},
+＠samp{console_type_create_＠var{file}}, ＠emph{etc.}) in ＠samp{main_1} in
+(a)file{emacs.c}.
+
+Add a device creation function ＠samp{make-＠var{console-type}-device} in
+(a)file{device.el}. Add the device type to the calls to
+＠samp{Face-frob-property} in ＠file{faces.el}, as well as calls to the
+device initializer functions for devices and frames, and ``additional
+frobbing'' in that file.
+
+You may wish to add an option to force the initial frame to that device
+type to ＠file{emacs.c}. Don't forget to document it in the command help
+function in ＠file{startup.el}.
+
+You may need to add support for your console type in
+＠samp{init_event_stream} in ＠file{event-stream.c}.
+
+If your console has a different UI for fonts or colors, or adds new
+capability, you may need to add a ＠file{(a)var{console-type}-faces.el}
+file, or add code to the ＠file{(a)var{parent-type}-faces.el} file, to
+support new font or color capability. Probably initialization code in
+(a)file{faces.c} will be needed too.
+
+A check for the console type is probably needed in ＠samp{init_redisplay}
+in ＠file{redisplay.c}.
+
+Ditto for the ＠file{(a)var{console-type}-init.el} file.
+
+Don't forget that Emacs windows are console-dependent, too. At least a
+＠samp{WINDOW_＠var{console-type}_P}-checking macro should be added in
+(a)file{window-impl.h}.
+
+Note that this project failed; there are probably many other details to
+be implemented that I didn't get to. But don't let that stop you!
+
+
+＠node Modules for the Basic Displayable Lisp Objects, , Creating a New Console/Device/Frame Type, Consoles; Devices; Frames; Windows
＠section Modules for the Basic Displayable Lisp Objects
＠cindex modules for the basic displayable Lisp objects
＠cindex displayable Lisp objects, modules for the basic
＠＠ -17602,6 +17769,7 ＠＠
is part of the redisplay mechanism or the code for particular object
types such as scrollbars.
+
＠node The Redisplay Mechanism, Extents, Consoles; Devices; Frames; Windows, Top
＠chapter The Redisplay Mechanism
＠cindex redisplay mechanism, the
＠＠ -20404,11 +20572,11 ＠＠
＠end table
＠menu
-* Ben's separate stderr notes:: Probably obsolete.
+* Ben's separate stderr notes:: Probably obsolete.
＠end menu
-＠node Ben's separate stderr notes, , , Subprocesses
+＠node Ben's separate stderr notes, , Subprocesses, Subprocesses
＠subsection Ben's separate stderr notes (probably obsolete)
This node contains some notes that Ben kept on his separate subprocess
＠＠ -20449,7 +20617,7 ＠＠
* Windows Build Flags::
* Windows I18N Introduction::
* Modules for Interfacing with MS Windows::
-* CHANGES from 21.4-windows branch:: Probably obsolete.
+* CHANGES from 21.4-windows branch:: Probably obsolete.
＠end menu
＠node Different kinds of Windows environments, Windows Build Flags, Interface to MS Windows, Interface to MS Windows
＠＠ -20978,7 +21146,7 ＠＠
＠end table
-＠node CHANGES from 21.4-windows branch, , Modules for Interfacing with MS Windows, Interface to MS Windows
+＠node CHANGES from 21.4-windows branch, , Modules for Interfacing with MS Windows, Interface to MS Windows
＠section CHANGES from 21.4-windows branch (probably obsolete)
This node contains the ＠file{CHANGES-msw} log that Andy Piper kept while
＠＠ -26741,7 +26909,7 ＠＠
＠end itemize
-＠node Future Work -- Lisp Engine Replacement, Future Work -- Better Rendering Support, Future Work -- Making Elisp Function Calls Faster, Future Work
+＠node Future Work -- Lisp Engine Replacement, Future Work -- Better Rendering Support, Future Work -- Making Elisp Function Calls Faster, Future Work
＠section Future Work -- Lisp Engine Replacement
＠cindex future work, lisp engine replacement
＠cindex lisp engine replacement, future work
＠＠ -27354,7 +27522,7 ＠＠
-＠node Future Work -- Better Rendering Support, , Future Work -- Lisp Engine Replacement, Future Work
+＠node Future Work -- Better Rendering Support, , Future Work -- Lisp Engine Replacement, Future Work
＠section Future Work -- Better Rendering Support
＠cindex future work, better rendering support
＠cindex better rendering support, future work
＠＠ -27387,15 +27555,15 ＠＠
one may be made available for the Knauel-Matthias patch soon.
＠menu
-* Better Rendering Support -- Review Criteria::
-* Better Rendering Support -- Implementation::
-* Better Rendering Support -- Current Status::
-* Better Rendering Support -- Configuration with the Interim Patches::
-* Better Rendering Support -- Modern Font Support::
+* Better Rendering Support -- Review Criteria::
+* Better Rendering Support -- Implementation::
+* Better Rendering Support -- Current Status::
+* Better Rendering Support -- Configuration with the Interim Patches::
+* Better Rendering Support -- Modern Font Support::
＠end menu
-＠node Better Rendering Support -- Review Criteria, Better Rendering Support -- Implementation, , Future Work -- Better Rendering Support
+＠node Better Rendering Support -- Review Criteria, Better Rendering Support -- Implementation, Future Work -- Better Rendering Support, Future Work -- Better Rendering Support
＠subsection Better Rendering Support -- Review Criteria
＠cindex better rendering support, issues
＠cindex issues, better rendering support
＠＠ -27738,7 +27906,7 ＠＠
-＠node Better Rendering Support -- Modern Font Support, , Better Rendering Support -- Configuration with the Interim Patches, Future Work -- Better Rendering Support
+＠node Better Rendering Support -- Modern Font Support, , Better Rendering Support -- Configuration with the Interim Patches, Future Work -- Better Rendering Support
＠subsection Better Rendering Support -- Modern Font Support
＠c Maybe eventually all these ＠cindexes should be spread about?
＠＠ -27784,12 +27952,12 ＠＠
available on all ＠file{fontconfig} systems.
＠menu
-* Modern Font Support -- Font Concepts:: GUI devices, fonts, glyphs, rendering.
-* Modern Font Support -- fontconfig:: Querying and selecting fonts.
-* Modern Font Support -- Xft:: Rendering fonts on X11.
+* Modern Font Support -- Font Concepts:: GUI devices, fonts, glyphs, rendering.
+* Modern Font Support -- fontconfig:: Querying and selecting fonts.
+* Modern Font Support -- Xft:: Rendering fonts on X11.
＠end menu
-＠node Modern Font Support -- Font Concepts, Modern Font Support -- fontconfig, , Better Rendering Support -- Modern Font Support
+＠node Modern Font Support -- Font Concepts, Modern Font Support -- fontconfig, Better Rendering Support -- Modern Font Support, Better Rendering Support -- Modern Font Support
＠subsubsection Modern Font Support -- Font Concepts
In modern systems, displays are invariably ＠dfn{raster graphic devices},
＠＠ -28201,7 +28369,7 ＠＠
-＠node Modern Font Support -- Xft, , Modern Font Support -- fontconfig, Better Rendering Support -- Modern Font Support
+＠node Modern Font Support -- Xft, , Modern Font Support -- fontconfig, Better Rendering Support -- Modern Font Support
＠subsubsection Modern Font Support -- fontconfig
IIRC, we don't really provide any ＠file{Xft} APIs at the LISP level yet.
Index: src/Makefile.in.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Makefile.in.in,v
retrieving revision 1.124
diff -u -r1.124 Makefile.in.in
--- src/Makefile.in.in 27 Feb 2006 16:29:21 -0000 1.124
+++ src/Makefile.in.in 23 Apr 2006 14:24:21 -0000
＠＠ -134,7 +134,7 ＠＠
x_objs=console-x.o device-x.o event-Xt.o frame-x.o \
glyphs-x.o objects-x.o redisplay-x.o select-x.o xgccache.o intl-x.o
#ifdef USE_XFT
-x_objs += xft-fonts.o
+x_objs += font-mgr.o
#endif
x_gui_objs=$(gui_objs:.o=-x.o)
#ifdef HAVE_TOOLBARS
Index: src/config.h.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v
retrieving revision 1.107
diff -u -r1.107 config.h.in
--- src/config.h.in 27 Mar 2006 17:40:58 -0000 1.107
+++ src/config.h.in 23 Apr 2006 14:24:21 -0000
＠＠ -206,6 +206,9 ＠＠
/* Compile in support for the X window system? */
#undef HAVE_X_WINDOWS
+/* Compile with support for fontconfig? */
+#undef HAVE_FONTCONFIG
+
/* Compile with support for Xft? */
#undef USE_XFT
/* Per-widget stuff will go away? */
Index: src/console-x.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x.h,v
retrieving revision 1.22
diff -u -r1.22 console-x.h
--- src/console-x.h 26 Nov 2005 11:46:07 -0000 1.22
+++ src/console-x.h 23 Apr 2006 14:24:21 -0000
＠＠ -58,10 +58,6 ＠＠
#include <X11/Xft/Xft.h>
#undef glyph_index
#undef face_index
-/* #### this should be made gone */
-#ifndef XFT_VERSION
-#define XFT_VERSION 1
-#endif
#endif
/* R5 defines the XPointer type, but R4 doesn't.
Index: src/emacs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.164
diff -u -r1.164 emacs.c
--- src/emacs.c 27 Feb 2006 16:29:23 -0000 1.164
+++ src/emacs.c 23 Apr 2006 14:24:22 -0000
＠＠ -1620,7 +1620,7 ＠＠
#endif /* HAVE_XIM */
#ifdef USE_XFT
- syms_of_xft_fonts();
+ syms_of_font_mgr();
#endif
#endif /* HAVE_X_WINDOWS */
＠＠ -2205,7 +2205,7 ＠＠
#endif
#ifdef USE_XFT
- vars_of_xft_fonts ();
+ vars_of_font_mgr ();
#endif
#endif /* HAVE_X_WINDOWS */
＠＠ -2335,7 +2335,7 ＠＠
reinit_vars_of_gui_x ();
#endif
#ifdef USE_XFT
- reinit_vars_of_xft_fonts ();
+ reinit_vars_of_font_mgr ();
#endif
#endif /* HAVE_X_WINDOWS */
＠＠ -2407,7 +2407,7 ＠＠
#ifdef USE_XFT
/* This uses coding systems. Must be done before faces are init'ed. */
/* not in xft reloaded #3 */
- complex_vars_of_xft_fonts ();
+ complex_vars_of_font_mgr ();
#endif
/* Depends on specifiers. */
Index: src/font-mgr.c
===================================================================
RCS file: src/font-mgr.c
diff -N src/font-mgr.c
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ src/font-mgr.c 23 Apr 2006 14:24:22 -0000
＠＠ -0,0 +1,806 ＠＠
+/* Lisp font handling implementation for X with Xft.
+
+Copyright (C) 2003 Eric Knauel and Matthias Neubauer
+Copyright (C) 2005 Eric Knauel
+Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de>
+ Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de>
+ Stephen J. Turnbull <stephen(a)xemacs.org>
+Created: 27 Oct 2003
+Updated: 05 Mar 2005 by Stephen J. Turnbull
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not in GNU Emacs. */
+
+/* This module provides the Lisp interface to fonts in X11, including Xft,
+ but (at least at first) not GTK+ or Qt.
+
+ It should be renamed to fonts-x.h.
+
+ Sealevel code should be in ../lwlib/lwlib-fonts.c or
+ ../lwlib/lwlib-colors.c.
+*/
+
+#include <config.h>
+#include "lisp.h"
+#include "device.h"
+#include "device-impl.h"
+#include "console-x-impl.h"
+#include "objects-x.h"
+#include "objects-x-impl.h"
+#include "hash.h"
+#include "font-mgr.h"
+
+/* #### TO DO ####
+ . The "x-xft-*" and "x_xft_*" nomenclature is mostly redundant, especially
+ if we separate X fonts from Xft fonts, and use fontconfig more generally.
+ . We should support the most recent Xft first, old Xft libraries later.
+ . We may (think about it) wish to use fontconfig generally, even if we're
+ not using Xft. Either way, names that are really from fontconfig should
+ use the Fc* namespace.
+ . Mule-ize this file.
+ . Separate X Font Struct ops from Xft Font ops; give precedence to Xft but
+ allow fallback to X.
+ . Push decisions about font choice, defaults, fallbacks to Lisp; if we
+ really need efficiency, can reimplement in C later.
+ . Implement symbols interned in this file in the Q* namespace.
+ . Implement FcMatrix (Lisp vector).
+ . Implement FcCharSets (Lisp chartable? For implementation hints, see
+ FcCharSetFirstPage and FcCharSetNextPage).
+ . Implement FcConfigs.
+ DONE
+ . Fontconfig fontnames are encoded in UTF-8.
+*/
+
+Lisp_Object Qxft_font;
+Lisp_Object Qfc_patternp;
+Lisp_Object Qfc_fontsetp;
+/* Lisp_Object Qfc_result_match; */ /* FcResultMatch */
+Lisp_Object Qfc_result_type_mismatch; /* FcResultTypeMismatch */
+Lisp_Object Qfc_result_no_match; /* FcResultNoMatch */
+Lisp_Object Qfc_result_no_id; /* FcResultNoId */
+Lisp_Object Qfc_internal_error;
+Lisp_Object Vxlfd_font_name_regexp; /* #### Really needed? */
+Lisp_Object Vxft_version;
+/* Lisp_Object Vfc_version; */ /* #### Should have this, too! */
+Fixnum debug_xft; /* Set to 1 enables lots of obnoxious messages.
+ Setting it to 2 or 3 enables even more. */
+
+/****************************************************************
+* FcPattern objects *
+****************************************************************/
+
+static void
+finalize_fc_pattern (void *header, int UNUSED (for_disksave))
+{
+ struct fc_pattern *p = (struct fc_pattern *) header;
+ if (p->fcpatPtr)
+ {
+ FcPatternDestroy (p->fcpatPtr);
+ p->fcpatPtr = 0;
+ }
+}
+
+static const struct memory_description fcpattern_description [] = {
+ /* #### nothing here, is this right?? */
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION("fc-pattern", fc_pattern,
+ 0, 0, 0, finalize_fc_pattern, 0, 0,
+ fcpattern_description,
+ struct fc_pattern);
+
+/*
+ * Helper Functions
+ */
+static Lisp_Object make_xlfd_font_regexp (void);
+static void string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os);
+
+/*
+ extract the C representation of the Lisp string STR and convert it
+ to the encoding used by the Fontconfig API for property and font
+ names. I suppose that Qnative is the right encoding, the manual
+ doesn't say much about this topic. This functions assumes that STR
+ is a Lisp string.
+*/
+#define extract_fcapi_string(str) \
+ ((FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((str), Qnative))
+
+/* fontconfig assumes that objects (property names) are statically allocated,
+ and you will get bizarre results if you pass Lisp string data or strings
+ allocated on the stack as objects. fontconfig _does_ copy values, so we
+ (I hope) don't have to worry about that member.
+
+ Probably these functions don't get called so often that the memory leak
+ due to strdup'ing every time we add a property would matter, but XEmacs
+ _is_ a long-running process. So we hash them.
+
+ I suspect that using symbol names or even keywords does not provide
+ assurance that the string won't move in memory. So we hash them
+ ourselves; hash.c hashtables do not interpret the value pointers. */
+static FcChar8 *fc_standard_properties[] = {
+ "antialias", "aspect", "autohint", "charset", "dpi", "family", "file",
+ "foundry", "ftface", "globaladvance", "hinting", "index", "lang",
+ "minspace", "outline", "pixelsize", "rasterizer", "rgba", "scalable",
+ "scale", "size", "slant", "spacing", "style", "verticallayout", "weight",
+ /* obsolete after Xft v. 1 */
+ "charwidth", "charheight", "core", "encoding", "render"
+};
+
+static struct hash_table *fc_property_name_hash_table;
+
+/* #### Maybe fc_intern should be exposed to LISP? The idea is that
+ fc-pattern-add could warn or error if the property isn't interned. */
+
+static FcChar8 *
+fc_intern (Lisp_Object property)
+{
+ const void *dummy;
+ FcChar8 *prop = extract_fcapi_string (property);
+ const void *val = gethash (prop, fc_property_name_hash_table, &dummy);
+
+ /* extract_fcapi_string returns something alloca'd
+ so we can just drop the old value of prop on the floor */
+ if (val)
+ prop = (FcChar8 *) val;
+ else
+ {
+ prop = FcStrCopy (prop);
+ puthash (prop, NULL, fc_property_name_hash_table);
+ }
+ return prop;
+}
+
+DEFUN("fc-pattern-p", Ffc_pattern_p, 1, 1, 0, /*
+Returns t if OBJECT is of type fc-pattern, nil otherwise.
+*/
+ (object))
+{
+ return FCPATTERNP(object) ? Qt : Qnil;
+}
+
+DEFUN("fc-pattern-create", Ffc_pattern_create, 0, 0, 0, /*
+Return a new, empty fc-pattern object.
+*/
+ ())
+{
+ fc_pattern *fcpat =
+ ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
+
+ fcpat->fcpatPtr = FcPatternCreate();
+ return wrap_fcpattern(fcpat);
+}
+
+DEFUN("fc-name-parse", Ffc_name_parse, 1, 1, 0, /*
+Parse an Fc font name and return its representation as a fc pattern object.
+*/
+ (name))
+{
+ struct fc_pattern *fcpat =
+ ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
+
+ CHECK_STRING(name); /* #### MEMORY LEAK!! maybe not ... */
+
+ fcpat->fcpatPtr = FcNameParse (extract_fcapi_string (name));
+ return wrap_fcpattern(fcpat);
+}
+
+/* #### Ga-a-ack! Xft's similar function is actually a different API.
+ We provide both. */
+DEFUN("fc-name-unparse", Ffc_name_unparse, 1, 1, 0, /*
+Unparse an fc pattern object to a string.
+*/
+ (pattern))
+{
+ CHECK_FCPATTERN(pattern);
+ {
+ FcChar8 *temp = FcNameUnparse(XFCPATTERN_PTR(pattern));
+ Lisp_Object res = build_ext_string (temp, Qxft_font_name_encoding);
+ free (temp);
+ return res;
+ }
+}
+
+DEFUN("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /*
+Make a copy of the fc pattern object PATTERN and return it.
+*/
+ (pattern))
+{
+ struct fc_pattern *copy = NULL;
+ CHECK_FCPATTERN(pattern);
+
+ copy = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
+ copy->fcpatPtr = FcPatternDuplicate(XFCPATTERN_PTR(pattern));
+ return wrap_fcpattern(copy);
+}
+
+DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /*
+Add attributes to the pattern object PATTERN. PROPERTY is a string naming
+the attribute to add, VALUE the value for this attribute.
+
+VALUE may be a string, integer, float, or symbol, in which case the value
+will be added as an FcChar8[], int, double, or FcBool respectively.
+*/
+ (pattern, property, value))
+{
+ Bool res = 0;
+ Extbyte *obj;
+ FcPattern *fcpat;
+
+ CHECK_FCPATTERN(pattern);
+ CHECK_STRING(property);
+
+ obj = fc_intern (property);
+ fcpat = XFCPATTERN_PTR (pattern);
+
+ if (STRINGP(value))
+ {
+ FcChar8 *str = (FcChar8 *) extract_fcapi_string (value);
+ res = FcPatternAddString (fcpat, obj, str);
+ }
+ else if (INTP(value))
+ {
+ res = FcPatternAddInteger (fcpat, obj, XINT(value));
+ }
+ else if (FLOATP(value))
+ {
+ res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA(value));
+ }
+ else if (SYMBOLP(value))
+ {
+ res = FcPatternAddBool (fcpat, obj, !NILP(value));
+ }
+ /* else ... maybe we should wta here? */
+
+ return res ? Qt : Qnil;
+}
+
+DEFUN("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /*
+Remove attribute PROPERTY from fc pattern object OBJECT.
+*/
+ (pattern, property))
+{
+ Bool res;
+
+ CHECK_FCPATTERN(pattern);
+ CHECK_STRING(property);
+
+ res = FcPatternDel(XFCPATTERN_PTR(pattern),
+ extract_fcapi_string (property));
+ return res ? Qt : Qnil;
+}
+
+/* Generic interface to FcPatternGet()
+ * Don't support the losing symbol-for-property interface.
+ */
+DEFUN("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /*
+From PATTERN, extract PROPERTY for the ID'th member, of type TYPE.
+
+PATTERN is an Xft (fontconfig) pattern object.
+PROPERTY is a string naming an fontconfig font property.
+Optional ID is a nonnegative integer indexing the list of values for PROPERTY
+ stored in PATTERN, defaulting to 0 (the first value).
+Optional TYPE is a symbol, one of 'string, 'boolean, 'integer, 'float,
+ 'double, 'matrix, 'charset, or 'void, corresponding to the FcValue types.
+ ('float is an alias for 'double).
+
+The Lisp types returned will conform to TYPE:
+ string string
+ boolean `t' or `nil'
+ integer integer
+ double (float) float
+ matrix not implemented
+ charset not implemented
+ void not implemented
+
+Symbols with names of the form "fc-result-DESCRIPTION" are returned when
+the desired value is not available. These are
+
+ fc-result-type-mismatch the value found has an unexpected type
+ fc-result-no-match there is no such attribute
+ fc-result-no-id there is no value for the requested ID
+
+The types of the following standard properties are predefined by fontconfig.
+The symbol 'fc-result-type-mismatch will be returned if the object exists but
+TYPE does not match the predefined type. It is best not to specify a type
+for predefined properties, as a mistake here ensures error returns on the
+correct type.
+
+Each standard property has a convenience accessor defined in fontconfig.el,
+named in the form "fc-pattern-get-PROPERTY". The convenience functions are
+preferred to `fc-pattern-get' since a typo in the string naming a property
+will result in a silent null return, while a typo in a function name will
+usually result in a compiler or runtime \"not fboundp\" error. You may use
+`defsubst' to define convenience functions for non-standard properties.
+
+family String Font family name
+style String Font style. Overrides weight and slant
+slant Int Italic, oblique or roman
+weight Int Light, medium, demibold, bold or black
+size Double Point size
+aspect Double Stretches glyphs horizontally before hinting
+pixelsize Double Pixel size
+spacing Int Proportional, monospace or charcell
+foundry String Font foundry name
+antialias Bool Whether glyphs can be antialiased
+hinting Bool Whether the rasterizer should use hinting
+verticallayout Bool Use vertical layout
+autohint Bool Use autohinter instead of normal hinter
+globaladvance Bool Use font global advance data
+file String The filename holding the font
+index Int The index of the font within the file
+ftface FT_Face Use the specified FreeType face object
+rasterizer String Which rasterizer is in use
+outline Bool Whether the glyphs are outlines
+scalable Bool Whether glyphs can be scaled
+scale Double Scale factor for point->pixel conversions
+dpi Double Target dots per inch
+rgba Int unknown, rgb, bgr, vrgb, vbgr, none - subpixel geometry
+minspace Bool Eliminate leading from line spacing
+charset CharSet Unicode chars encoded by the font
+lang String List of RFC-3066-style languages this font supports
+
+The FT_Face, Matrix, CharSet types are unimplemented, so the corresponding
+properties are not accessible from Lisp at this time. If the value of a
+property returned has type FT_Face, FcCharSet, or FcMatrix,
+`fc-result-type-mismatch' is returned.
+
+The following properties which were standard in Xft v.1 are obsolete in
+Xft v.2: encoding, charwidth, charheight, core, and render. */
+ (pattern, property, id, type))
+{
+ FcChar8 *fc_property; /* UExtbyte * */
+ FcResult fc_result;
+ FcValue fc_value;
+
+ /*
+ process arguments
+ */
+ CHECK_FCPATTERN (pattern);
+
+#if 0
+ /* Don't support the losing symbol-for-property interface. */
+ property = SYMBOLP (property) ? symbol_name (XSYMBOL (property)) : property;
+#endif
+ if (STRINGP (property))
+ {
+ fc_property = (FcChar8 *) extract_fcapi_string (property);
+ }
+ else
+ {
+ /* if we allow symbols, this would need to be
+ list3 (Qlambda, list1 (Qobject),
+ list3 (Qor, list2 (Qstringp, Qobject),
+ list2 (Qsymbolp, Qobject)))
+ or something like that? */
+ dead_wrong_type_argument (Qstringp, property);
+ }
+
+ if (!NILP (id)) CHECK_NATNUM (id);
+ if (!NILP (type)) CHECK_SYMBOL (type);
+
+ /* get property */
+ fc_result = FcPatternGet (XFCPATTERN_PTR (pattern),
+ fc_property,
+ NILP (id) ? 0 : XINT(id),
+ &fc_value);
+
+ switch (fc_result)
+ {
+ case FcResultMatch:
+ /* wrap it and return */
+ switch (fc_value.type)
+ {
+ case FcTypeInteger:
+ return ((!NILP (type) && !EQ (type, Qinteger))
+ ? Qfc_result_type_mismatch : make_int (fc_value.u.i));
+ case FcTypeDouble:
+ return ((!NILP (type) && !EQ (type, intern ("double"))
+ && !EQ (type, Qfloat))
+ ? Qfc_result_type_mismatch : make_float (fc_value.u.d));
+ case FcTypeString:
+ return ((!NILP (type) && !EQ (type, Qstring))
+ ? Qfc_result_type_mismatch
+ : build_ext_string (fc_value.u.s, Qxft_font_name_encoding));
+ case FcTypeBool:
+ return ((!NILP (type) && !EQ (type, Qboolean))
+ ? Qfc_result_type_mismatch : fc_value.u.b ? Qt : Qnil);
+ case FcTypeMatrix:
+ return Qfc_result_type_mismatch;
+ /* #### unimplemented
+ return ((!NILP (type) && !EQ (type, intern ("matrix")))
+ ? Qfc_result_type_mismatch : make_int (fc_value.u.m));
+ */
+ case FcTypeCharSet:
+ return Qfc_result_type_mismatch;
+ /* #### unimplemented
+ return ((!NILP (type) && !EQ (type, intern ("charset")))
+ ? Qfc_result_type_mismatch : make_int (fc_value.u.c));
+ */
+ }
+ case FcResultTypeMismatch:
+ return Qfc_result_type_mismatch;
+ case FcResultNoMatch:
+ return Qfc_result_no_match;
+ case FcResultNoId:
+ return Qfc_result_no_id;
+ default:
+ return Qfc_internal_error;
+ }
+}
+
+DEFUN("fc-font-match", Ffc_font_match, 2, 2, 0, /*
+Return the font on DEVICE that most closely matches PATTERN.
+
+DEVICE is an X11 device.
+PATTERN is a fontconfig pattern object.
+Returns a fontconfig pattern object representing the closest match to the
+given pattern, or an error code. Possible error codes are
+`fc-result-no-match' and `fc-result-no-id'. */
+ (device, pattern))
+{
+ Display *dpy;
+ FcResult res;
+
+ struct fc_pattern *res_fcpat =
+ ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
+ CHECK_FCPATTERN(pattern); /* #### MEMORY LEAKS!!! */
+ if (NILP(device))
+ return Qnil;
+ CHECK_X_DEVICE(device);
+ if (!DEVICE_LIVE_P(XDEVICE(device)))
+ return Qnil;
+
+ dpy = DEVICE_X_DISPLAY(XDEVICE(device));
+ /* More Xft vs fontconfig brain damage? */
+ res_fcpat->fcpatPtr = XftFontMatch(dpy, DefaultScreen (dpy),
+ XFCPATTERN_PTR(pattern), &res);
+
+ if (res_fcpat->fcpatPtr == NULL)
+ switch (res) {
+ case FcResultNoMatch:
+ return Qfc_result_no_match;
+ case FcResultNoId:
+ return Qfc_result_no_id;
+ default:
+ return Qfc_internal_error;
+ }
+ else
+ return wrap_fcpattern(res_fcpat);
+}
+
+/* NOTE NOTE NOTE This function destroys the FcFontSet passed to it. */
+static Lisp_Object
+fontset_to_list (FcFontSet *fontset)
+{
+ int idx;
+ Lisp_Object fontlist = Qnil;
+ fc_pattern *fcpat;
+
+ /* #### improve this error message */
+ if (!fontset)
+ Fsignal (Qinvalid_state,
+ list1 (build_string ("failed to create FcFontSet")));
+ for (idx = 0; idx < fontset->nfont; ++idx)
+ {
+ fcpat =
+ ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
+ fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]);
+ fontlist = Fcons (wrap_fcpattern(fcpat), fontlist);
+ }
+ FcFontSetDestroy (fontset);
+ return fontlist;
+}
+
+/* #### fix this name to correspond to Ben's new nomenclature */
+DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects,
+ 3, 3, 0, /*
+Return a list of fonts on DEVICE that match PATTERN for PROPERTIES.
+Each font is represented by a fontconfig pattern object.
+
+DEVICE is an X11 device.
+PATTERN is a fontconfig pattern to be matched.
+PROPERTIES is a list of property names (strings) that should match.
+
+#### DEVICE is unused, ignored, and may be removed if it's not needed to
+match other font-listing APIs. */
+ (UNUSED (device), pattern, properties))
+{
+ FcObjectSet *os;
+ FcFontSet *fontset;
+
+ CHECK_FCPATTERN (pattern);
+ CHECK_LIST (properties);
+
+ os = FcObjectSetCreate ();
+ string_list_to_fcobjectset (properties, os);
+ /* #### why don't we need to do the "usual substitutions"? */
+ fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os);
+ FcObjectSetDestroy (os);
+
+ return fontset_to_list (fontset);
+
+}
+
+/* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */
+DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /*
+Return a list of all fonts sorted by proximity to PATTERN.
+Each font is represented by a fontconfig pattern object.
+
+DEVICE is an X11 device.
+PATTERN is a fontconfig pattern to be matched.
+Optional argument TRIM, if non-nil, means to trim trailing fonts that do not
+contribute new characters to the union repertoire.
+
+#### Optional argument NOSUB, if non-nil, suppresses some of the usual
+property substitutions. DON'T USE THIS in production code, it is intended
+for exploring behavior of fontconfig and will be removed when this code is
+stable.
+
+#### DEVICE is unused, ignored, and may be removed if it's not needed to
+match other font-listing APIs. */
+ (UNUSED (device), pattern, trim, nosub))
+{
+ CHECK_FCPATTERN (pattern);
+
+ {
+ FcConfig *fcc = FcConfigGetCurrent();
+ FcFontSet *fontset;
+ FcPattern *p = XFCPATTERN_PTR (pattern);
+ FcResult fcresult;
+
+ if (NILP(nosub)) /* #### temporary debug hack */
+ FcDefaultSubstitute (p);
+ FcConfigSubstitute (fcc, p, FcMatchPattern);
+ fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult);
+
+ return fontset_to_list (fontset);
+ }
+}
+
+/* #### this actually is an Xft function, should split those out
+ or get rid of them entirely? */
+/* #### be consistent about argument order. */
+DEFUN("fc-font-real-pattern", Ffc_font_real_pattern, 2, 2, 0, /*
+Temporarily open FONTNAME (a string) and return the actual
+fc pattern matched by the Fc library. */
+ (fontname, xdevice))
+{
+ FcPattern *copy;
+ Display *dpy;
+ XftFont *font;
+ struct fc_pattern *fcpat =
+ ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
+
+ CHECK_STRING (fontname); /* #### MEMORY LEAK?! maybe not ... */
+ if (NILP(xdevice))
+ return Qnil;
+ CHECK_X_DEVICE (xdevice);
+ if (!DEVICE_LIVE_P(XDEVICE(xdevice)))
+ return Qnil;
+
+ /* #### these gymnastics should be unnecessary, just use FcFontMatch */
+ dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice));
+ font = XftFontOpenName (dpy, DefaultScreen(dpy),
+ extract_fcapi_string (fontname));
+ if (font == NULL)
+ return Qnil;
+ copy = FcPatternDuplicate(font->pattern);
+ XftFontClose(dpy, font);
+ if (copy == NULL)
+ return Qnil;
+ fcpat->fcpatPtr = copy;
+ return wrap_fcpattern(fcpat);
+}
+
+DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
+Check whether the string FONTNAME is a XLFD font name. */
+ (fontname))
+{
+ CHECK_STRING(fontname);
+ /* #### should bind `case-fold-search' here? */
+ return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil);
+}
+
+/* FcPatternPrint: there is no point in having wrappers fc-pattern-print,
+ Ffc_pattern_print since this function prints to stdout. */
+
+/* Initialization of font-mgr */
+
+#define XE_XLFD_SEPARATOR "-"
+ /* XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII
+ in Mule when this function is called. So use HPC. */
+#if 0
+#define XE_XLFD_PREFIX "\\(\\+[\040-\176\240-\377]*\\)?-"
+#define XE_XLFD_OPT_TEXT "\\([\040-\044\046-\176\240-\377]*\\)"
+#define XE_XLFD_TEXT "\\([\040-\044\046-\176\240-\377]+\\)"
+#else
+#define XE_XLFD_PREFIX "\\(\\+[\040-\176]*\\)?-"
+#define XE_XLFD_OPT_TEXT "\\([^-]*\\)"
+#define XE_XLFD_TEXT "\\([^-]+\\)"
+#endif
+
+#define XE_XLFD_SLANT "\\([0-9ior?*][iot]?\\)"
+#define XE_XLFD_SPACING "\\([cmp?*]\\)"
+ /* Hyphen as minus conflicts with use as separator. */
+#define XE_XLFD_OPT_NEGATE "~?"
+#define XE_XLFD_NUMBER "\\([0-9?*]+\\)"
+#define XE_XLFD_PSIZE "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)"
+
+/* Call this only from the init code
+ #### This is really horrible, let's get rid of it, please. */
+static Lisp_Object
+make_xlfd_font_regexp (void)
+{
+ struct gcpro gcpro1;
+ unsigned i;
+ Lisp_Object reg = Qnil;
+ const Extbyte *re[] = /* #### This could just be catenated by
+ cpp and passed to build_ext_string. */
+ {
+ /* Regular expression matching XLFDs as defined by XLFD v. 1.5.
+ Matches must be case-insensitive.
+ PSIZE is a pixel or point size, which may be a "matrix". The
+ syntax of a matrix is not checked, just some lexical properties.
+ AFAICT none of the TEXT fields except adstyle is optional.
+
+ NB. It should not be a problem if this matches "too much", since
+ an "old" server will simply not be able to find a matching font. */
+ "\\`",
+ XE_XLFD_PREFIX, /* prefix */
+ XE_XLFD_TEXT, /* foundry */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_TEXT, /* family */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_TEXT, /* weight */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_SLANT, /* slant */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_TEXT, /* swidth */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_OPT_TEXT, /* adstyle */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_PSIZE, /* pixelsize */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_PSIZE, /* pointsize */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_NUMBER, /* resx */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_NUMBER, /* resy */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_SPACING, /* spacing */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_OPT_NEGATE, /* avgwidth */
+ XE_XLFD_NUMBER,
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_TEXT, /* registry */
+ XE_XLFD_SEPARATOR,
+ XE_XLFD_TEXT, /* encoding */
+ "\\'"
+ };
+
+ GCPRO1 (reg);
+ for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++)
+ {
+ /* #### Currently this is Host Portable Coding, not ISO 8859-1. */
+ reg = concat2(reg, build_ext_string (re[i], Qx_font_name_encoding));
+ }
+
+ RETURN_UNGCPRO (reg);
+}
+#undef XE_XLFD_SEPARATOR
+#undef XE_XLFD_PREFIX
+#undef XE_XLFD_OPT_TEXT
+#undef XE_XLFD_TEXT
+#undef XE_XLFD_OPT_SLANT
+#undef XE_XLFD_OPT_SPACING
+#undef XE_XLFD_OPT_NEGATE
+#undef XE_XLFD_NUMBER
+#undef XE_XLFD_PSIZE
+
+#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
+ ? ((unsigned long) (x)) : ((unsigned long) (y)))
+
+static void
+string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os)
+{
+ EXTERNAL_LIST_LOOP_2 (elt, list)
+ {
+ FcChar8 *s;
+
+ CHECK_STRING (elt);
+ s = fc_intern (elt);
+ fprintf (stderr, "%s\n", s);
+ FcObjectSetAdd (os, s);
+ }
+}
+
+void
+syms_of_font_mgr (void)
+{
+ INIT_LRECORD_IMPLEMENTATION(fc_pattern);
+
+ DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp);
+
+ DEFSYMBOL(Qfc_result_type_mismatch);
+ DEFSYMBOL(Qfc_result_no_match);
+ DEFSYMBOL(Qfc_result_no_id);
+ DEFSYMBOL(Qfc_internal_error);
+ DEFSYMBOL(Qxft_font);
+
+ DEFSUBR(Ffc_pattern_p);
+ DEFSUBR(Ffc_pattern_create);
+ DEFSUBR(Ffc_name_parse);
+ DEFSUBR(Ffc_name_unparse);
+ DEFSUBR(Ffc_pattern_duplicate);
+ DEFSUBR(Ffc_pattern_add);
+ DEFSUBR(Ffc_pattern_del);
+ DEFSUBR(Ffc_pattern_get);
+ DEFSUBR(Ffc_list_fonts_pattern_objects);
+ DEFSUBR(Ffc_font_sort);
+ DEFSUBR(Ffc_font_match);
+ DEFSUBR(Ffc_font_real_pattern);
+ DEFSUBR(Fxlfd_font_name_p);
+}
+
+void
+vars_of_font_mgr (void)
+{
+ /* #### These two variables need to go somewhere else. */
+
+ /* #### I know, but the right fix is use the generic debug facility. */
+ DEFVAR_INT ("xft-debug-level", &debug_xft /*
+Level of debugging messages to issue to stderr for Xft.
+A nonnegative integer. Set to 0 to suppress all warnings.
+Default is 1 to ensure a minimum of debugging output at initialization.
+Higher levels give even more information.
+*/ );
+ debug_xft = 1;
+
+ DEFVAR_LISP("xft-version", &Vxft_version /*
+The major version number of the Xft library being used.
+*/ );
+ Vxft_version = make_int(XFT_VERSION);
+
+ Fprovide (intern ("xft"));
+}
+
+void
+complex_vars_of_font_mgr (void)
+{
+ DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /*
+The regular expression used to match XLFD font names. */
+ );
+ Vxlfd_font_name_regexp = make_xlfd_font_regexp();
+}
+
+void
+reinit_vars_of_font_mgr (void)
+{
+ int i, size = (int) countof (fc_standard_properties);
+
+ FcInit ();
+
+ fc_property_name_hash_table = make_string_hash_table (size);
+ for (i = 0; i < size; ++i)
+ puthash (fc_standard_properties[i], NULL, fc_property_name_hash_table);
+}
+
Index: src/font-mgr.h
===================================================================
RCS file: src/font-mgr.h
diff -N src/font-mgr.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ src/font-mgr.h 23 Apr 2006 14:24:22 -0000
＠＠ -0,0 +1,71 ＠＠
+/* Lisp font data structures for X and Xft.
+
+Copyright (C) 2003 Eric Knauel and Matthias Neubauer
+Copyright (C) 2005 Eric Knauel
+Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de>
+ Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de>
+ Stephen J. Turnbull <stephen(a)xemacs.org>
+Created: 27 Oct 2003
+Updated: 05 Mar 2005 by Stephen J. Turnbull
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not in GNU Emacs. */
+
+/* This module provides the Lisp interface to fonts in X11, including Xft,
+ but (at least at first) not GTK+ or Qt.
+
+ It should be renamed to fonts-x.h.
+
+ Sealevel code should be in ../lwlib/lwlib-fonts.h or
+ ../lwlib/lwlib-colors.h.
+*/
+
+
+#ifndef INCLUDED_font_mgr_h_
+#define INCLUDED_font_mgr_h_
+
+#include "../lwlib/lwlib-fonts.h"
+#include "../lwlib/lwlib-colors.h"
+
+extern Fixnum debug_xft;
+
+/* Standard for fontconfig. Use a macro to show we're not guessing. */
+#define Qxft_font_name_encoding Qutf_8
+
+#define XE_XLFD_MAKE_LISP_STRING(s) (make_string(s, strlen(s)))
+
+struct fc_pattern
+{
+ struct LCRECORD_HEADER header;
+ FcPattern *fcpatPtr;
+};
+
+typedef struct fc_pattern fc_pattern;
+
+DECLARE_LRECORD(fc_pattern, struct fc_pattern);
+#define XFCPATTERN(x) XRECORD (x, fc_pattern, struct fc_pattern)
+#define wrap_fcpattern(p) wrap_record (p, fc_pattern)
+#define FCPATTERNP(x) RECORDP (x, fc_pattern)
+#define CHECK_FCPATTERN(x) CHECK_RECORD (x, fc_pattern)
+#define CONCHECK_FCPATTERN(x) CONCHECK_RECORD (x, fc_pattern)
+#define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr)
+
+#endif /* INCLUDED_font_mgr_h_ */
Index: src/inline.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/inline.c,v
retrieving revision 1.22
diff -u -r1.22 inline.c
--- src/inline.c 26 Nov 2005 11:46:09 -0000 1.22
+++ src/inline.c 23 Apr 2006 14:24:22 -0000
＠＠ -101,7 +101,7 ＠＠
#ifdef HAVE_X_WINDOWS
#include "glyphs-x.h"
#ifdef USE_XFT
-#include "xft-fonts.h"
+#include "font-mgr.h"
#endif
#endif
Index: src/objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.37
diff -u -r1.37 objects-x.c
--- src/objects-x.c 17 Mar 2006 14:30:45 -0000 1.37
+++ src/objects-x.c 23 Apr 2006 14:24:22 -0000
＠＠ -39,7 +39,7 ＠＠
#include "objects-x-impl.h"
#ifdef USE_XFT
-#include "xft-fonts.h"
+#include "font-mgr.h"
#endif
int x_handle_non_fully_specified_fonts;
＠＠ -206,7 +206,7 ＠＠
/************************************************************************/
#ifdef USE_XFT
-/* #### all these #defines should probably move to xft-fonts.h */
+/* #### all these #defines should probably move to font-mgr.h */
/*
The format of a fontname (as returned by fontconfig) is not well-documented,
Index: src/symsinit.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symsinit.h,v
retrieving revision 1.55
diff -u -r1.55 symsinit.h
--- src/symsinit.h 27 Feb 2006 16:29:29 -0000 1.55
+++ src/symsinit.h 23 Apr 2006 14:24:23 -0000
＠＠ -160,7 +160,7 ＠＠
void syms_of_objects_mswindows (void);
void syms_of_objects_tty (void);
void syms_of_objects_x (void);
-void syms_of_xft_fonts (void);
+void syms_of_font_mgr (void);
EXTERN_C void syms_of_postgresql (void);
void syms_of_print (void);
void syms_of_process (void);
＠＠ -398,8 +398,8 ＠＠
void vars_of_nt (void);
void vars_of_number (void);
void vars_of_objects (void);
-void vars_of_xft_fonts (void);
-void reinit_vars_of_xft_fonts (void);
+void vars_of_font_mgr (void);
+void reinit_vars_of_font_mgr (void);
void reinit_vars_of_objects (void);
void vars_of_objects_tty (void);
void vars_of_objects_mswindows (void);
＠＠ -484,7 +484,7 ＠＠
void complex_vars_of_minibuf (void);
void reinit_complex_vars_of_minibuf (void);
void complex_vars_of_keymap (void);
-void complex_vars_of_xft_fonts (void);
+void complex_vars_of_font_mgr (void);
/* Late initialization -- stuff pertaining only to interactive usage,
I/O, or Lisp reading. (Dump-time and run-time, but the code itself
Index: src/xft-fonts.c
===================================================================
RCS file: src/xft-fonts.c
diff -N src/xft-fonts.c
--- src/xft-fonts.c 26 Nov 2005 18:25:03 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
＠＠ -1,823 +0,0 ＠＠
-/* Lisp font handling implementation for X with Xft.
-
-Copyright (C) 2003 Eric Knauel and Matthias Neubauer
-Copyright (C) 2005 Eric Knauel
-Copyright (C) 2004, 2005 Free Software Foundation, Inc.
-
-Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de>
- Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de>
- Stephen J. Turnbull <stephen(a)xemacs.org>
-Created: 27 Oct 2003
-Updated: 05 Mar 2005 by Stephen J. Turnbull
-
-This file is part of XEmacs.
-
-XEmacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-XEmacs is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License
-along with XEmacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Synched up with: Not in GNU Emacs. */
-
-/* This module provides the Lisp interface to fonts in X11, including Xft,
- but (at least at first) not GTK+ or Qt.
-
- It should be renamed to fonts-x.h.
-
- Sealevel code should be in ../lwlib/lwlib-fonts.c or
- ../lwlib/lwlib-colors.c.
-*/
-
-#include <config.h>
-#include "lisp.h"
-#include "device.h"
-#include "device-impl.h"
-#include "console-x-impl.h"
-#include "objects-x.h"
-#include "objects-x-impl.h"
-#include "hash.h"
-#include "xft-fonts.h"
-
-/* #### TO DO ####
- . The "x-xft-*" and "x_xft_*" nomenclature is mostly redundant, especially
- if we separate X fonts from Xft fonts, and use fontconfig more generally.
- . We should support the most recent Xft first, old Xft libraries later.
- . We may (think about it) wish to use fontconfig generally, even if we're
- not using Xft. Either way, names that are really from fontconfig should
- use the Fc* namespace.
- . Mule-ize this file.
- . Separate X Font Struct ops from Xft Font ops; give precedence to Xft but
- allow fallback to X.
- . Push decisions about font choice, defaults, fallbacks to Lisp; if we
- really need efficiency, can reimplement in C later.
- . Implement symbols interned in this file in the Q* namespace.
- . Implement FcMatrix (Lisp vector).
- . Implement FcCharSets (Lisp chartable? For implementation hints, see
- FcCharSetFirstPage and FcCharSetNextPage).
- . Implement FcConfigs.
- DONE
- . Fontconfig fontnames are encoded in UTF-8.
-*/
-
-Lisp_Object Qxft_font;
-Lisp_Object Qfc_patternp;
-Lisp_Object Qfc_fontsetp;
-/* Lisp_Object Qfc_result_match; */ /* FcResultMatch */
-Lisp_Object Qfc_result_type_mismatch; /* FcResultTypeMismatch */
-Lisp_Object Qfc_result_no_match; /* FcResultNoMatch */
-Lisp_Object Qfc_result_no_id; /* FcResultNoId */
-Lisp_Object Qfc_internal_error;
-Lisp_Object Vxlfd_font_name_regexp; /* #### Really needed? */
-Lisp_Object Vxft_version;
-/* Lisp_Object Vfc_version; */ /* #### Should have this, too! */
-Fixnum debug_xft; /* Set to 1 enables lots of obnoxious messages.
- Setting it to 2 or 3 enables even more. */
-
-/****************************************************************
-* FcPattern objects *
-****************************************************************/
-
-static void
-finalize_fc_pattern (void *header, int UNUSED (for_disksave))
-{
- struct fc_pattern *p = (struct fc_pattern *) header;
- if (p->fcpatPtr)
- {
- FcPatternDestroy (p->fcpatPtr);
- p->fcpatPtr = 0;
- }
-}
-
-static const struct memory_description fcpattern_description [] = {
- /* #### nothing here, is this right?? */
- { XD_END }
-};
-
-DEFINE_LRECORD_IMPLEMENTATION("fc-pattern", fc_pattern,
- 0, 0, 0, finalize_fc_pattern, 0, 0,
- fcpattern_description,
- struct fc_pattern);
-
-/*
- * Helper Functions
- */
-static Lisp_Object make_xlfd_font_regexp (void);
-static void string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os);
-
-/*
- extract the C representation of the Lisp string STR and convert it
- to the encoding used by the Fontconfig API for property and font
- names. I suppose that Qnative is the right encoding, the manual
- doesn't say much about this topic. This functions assumes that STR
- is a Lisp string.
-*/
-#define extract_fcapi_string(str) \
- ((FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((str), Qnative))
-
-/* fontconfig assumes that objects (property names) are statically allocated,
- and you will get bizarre results if you pass Lisp string data or strings
- allocated on the stack as objects. fontconfig _does_ copy values, so we
- (I hope) don't have to worry about that member.
-
- Probably these functions don't get called so often that the memory leak
- due to strdup'ing every time we add a property would matter, but XEmacs
- _is_ a long-running process. So we hash them.
-
- I suspect that using symbol names or even keywords does not provide
- assurance that the string won't move in memory. So we hash them
- ourselves; hash.c hashtables do not interpret the value pointers. */
-static FcChar8 *fc_standard_properties[] = {
- "antialias", "aspect", "autohint", "charset", "dpi", "family", "file",
- "foundry", "ftface", "globaladvance", "hinting", "index", "lang",
- "minspace", "outline", "pixelsize", "rasterizer", "rgba", "scalable",
- "scale", "size", "slant", "spacing", "style", "verticallayout", "weight",
- /* obsolete after Xft v. 1 */
- "charwidth", "charheight", "core", "encoding", "render"
-};
-
-static struct hash_table *fc_property_name_hash_table;
-
-/* #### Maybe fc_intern should be exposed to LISP? The idea is that
- fc-pattern-add could warn or error if the property isn't interned. */
-
-static FcChar8 *
-fc_intern (Lisp_Object property)
-{
- const void *dummy;
- FcChar8 *prop = extract_fcapi_string (property);
- const void *val = gethash (prop, fc_property_name_hash_table, &dummy);
-
- /* extract_fcapi_string returns something alloca'd
- so we can just drop the old value of prop on the floor */
- if (val)
- prop = (FcChar8 *) val;
- else
- {
- prop = FcStrCopy (prop);
- puthash (prop, NULL, fc_property_name_hash_table);
- }
- return prop;
-}
-
-DEFUN("fc-pattern-p", Ffc_pattern_p, 1, 1, 0, /*
-Returns t if OBJECT is of type fc-pattern, nil otherwise.
-*/
- (object))
-{
- return FCPATTERNP(object) ? Qt : Qnil;
-}
-
-DEFUN("fc-pattern-create", Ffc_pattern_create, 0, 0, 0, /*
-Return a new, empty fc-pattern object.
-*/
- ())
-{
- fc_pattern *fcpat =
- ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
-
- fcpat->fcpatPtr = FcPatternCreate();
- return wrap_fcpattern(fcpat);
-}
-
-DEFUN("fc-name-parse", Ffc_name_parse, 1, 1, 0, /*
-Parse an Fc font name and return its representation as a fc pattern object.
-*/
- (name))
-{
- struct fc_pattern *fcpat =
- ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
-
- CHECK_STRING(name); /* #### MEMORY LEAK!! maybe not ... */
-
- fcpat->fcpatPtr = FcNameParse (extract_fcapi_string (name));
- return wrap_fcpattern(fcpat);
-}
-
-/* #### Ga-a-ack! Xft's similar function is actually a different API.
- We provide both. */
-DEFUN("fc-name-unparse", Ffc_name_unparse, 1, 1, 0, /*
-Unparse an fc pattern object to a string.
-*/
- (pattern))
-{
- CHECK_FCPATTERN(pattern);
- {
- FcChar8 *temp = FcNameUnparse(XFCPATTERN_PTR(pattern));
- Lisp_Object res = build_ext_string (temp, Qxft_font_name_encoding);
- free (temp);
- return res;
- }
-}
-
-#if 0
-/* #### This seems to not work? */
-DEFUN("xft-name-unparse", Fxft_name_unparse, 1, 1, 0, /*
-Unparse an fc pattern object to a string (using the Xft API).
-*/
- (pattern))
-{
- char temp[FCSTRLEN];
- Bool res;
-
- CHECK_FCPATTERN(pattern);
- res = XftNameUnparse(XFCPATTERN_PTR(pattern), temp, FCSTRLEN-1);
- return res ? build_ext_string (temp, Qxft_font_name_encoding) : Qnil;
-}
-#endif
-
-DEFUN("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /*
-Make a copy of the fc pattern object PATTERN and return it.
-*/
- (pattern))
-{
- struct fc_pattern *copy = NULL;
- CHECK_FCPATTERN(pattern);
-
- copy = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
- copy->fcpatPtr = FcPatternDuplicate(XFCPATTERN_PTR(pattern));
- return wrap_fcpattern(copy);
-}
-
-DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /*
-Add attributes to the pattern object PATTERN. PROPERTY is a string naming
-the attribute to add, VALUE the value for this attribute.
-
-VALUE may be a string, integer, float, or symbol, in which case the value
-will be added as an FcChar8[], int, double, or FcBool respectively.
-*/
- (pattern, property, value))
-{
- Bool res = 0;
- Extbyte *obj;
- FcPattern *fcpat;
-
- CHECK_FCPATTERN(pattern);
- CHECK_STRING(property);
-
- obj = fc_intern (property);
- fcpat = XFCPATTERN_PTR (pattern);
-
- if (STRINGP(value))
- {
- FcChar8 *str = (FcChar8 *) extract_fcapi_string (value);
- res = FcPatternAddString (fcpat, obj, str);
- }
- else if (INTP(value))
- {
- res = FcPatternAddInteger (fcpat, obj, XINT(value));
- }
- else if (FLOATP(value))
- {
- res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA(value));
- }
- else if (SYMBOLP(value))
- {
- res = FcPatternAddBool (fcpat, obj, !NILP(value));
- }
- /* else ... maybe we should wta here? */
-
- return res ? Qt : Qnil;
-}
-
-DEFUN("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /*
-Remove attribute PROPERTY from fc pattern object OBJECT.
-*/
- (pattern, property))
-{
- Bool res;
-
- CHECK_FCPATTERN(pattern);
- CHECK_STRING(property);
-
- res = FcPatternDel(XFCPATTERN_PTR(pattern),
- extract_fcapi_string (property));
- return res ? Qt : Qnil;
-}
-
-/* Generic interface to FcPatternGet()
- * Don't support the losing symbol-for-property interface.
- */
-DEFUN("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /*
-From PATTERN, extract PROPERTY for the ID'th member, of type TYPE.
-
-PATTERN is an Xft (fontconfig) pattern object.
-PROPERTY is a string naming an fontconfig font property.
-Optional ID is a nonnegative integer indexing the list of values for PROPERTY
- stored in PATTERN, defaulting to 0 (the first value).
-Optional TYPE is a symbol, one of 'string, 'boolean, 'integer, 'float,
- 'double, 'matrix, 'charset, or 'void, corresponding to the FcValue types.
- ('float is an alias for 'double).
-
-The Lisp types returned will conform to TYPE:
- string string
- boolean `t' or `nil'
- integer integer
- double (float) float
- matrix not implemented
- charset not implemented
- void not implemented
-
-Symbols with names of the form "fc-result-DESCRIPTION" are returned when
-the desired value is not available. These are
-
- fc-result-type-mismatch the value found has an unexpected type
- fc-result-no-match there is no such attribute
- fc-result-no-id there is no value for the requested ID
-
-The types of the following standard properties are predefined by fontconfig.
-The symbol 'fc-result-type-mismatch will be returned if the object exists but
-TYPE does not match the predefined type. It is best not to specify a type
-for predefined properties, as a mistake here ensures error returns on the
-correct type.
-
-Each standard property has a convenience accessor defined in fontconfig.el,
-named in the form "fc-pattern-get-PROPERTY". The convenience functions are
-preferred to `fc-pattern-get' since a typo in the string naming a property
-will result in a silent null return, while a typo in a function name will
-usually result in a compiler or runtime \"not fboundp\" error. You may use
-`defsubst' to define convenience functions for non-standard properties.
-
-family String Font family name
-style String Font style. Overrides weight and slant
-slant Int Italic, oblique or roman
-weight Int Light, medium, demibold, bold or black
-size Double Point size
-aspect Double Stretches glyphs horizontally before hinting
-pixelsize Double Pixel size
-spacing Int Proportional, monospace or charcell
-foundry String Font foundry name
-antialias Bool Whether glyphs can be antialiased
-hinting Bool Whether the rasterizer should use hinting
-verticallayout Bool Use vertical layout
-autohint Bool Use autohinter instead of normal hinter
-globaladvance Bool Use font global advance data
-file String The filename holding the font
-index Int The index of the font within the file
-ftface FT_Face Use the specified FreeType face object
-rasterizer String Which rasterizer is in use
-outline Bool Whether the glyphs are outlines
-scalable Bool Whether glyphs can be scaled
-scale Double Scale factor for point->pixel conversions
-dpi Double Target dots per inch
-rgba Int unknown, rgb, bgr, vrgb, vbgr, none - subpixel geometry
-minspace Bool Eliminate leading from line spacing
-charset CharSet Unicode chars encoded by the font
-lang String List of RFC-3066-style languages this font supports
-
-The FT_Face, Matrix, CharSet types are unimplemented, so the corresponding
-properties are not accessible from Lisp at this time. If the value of a
-property returned has type FT_Face, FcCharSet, or FcMatrix,
-`fc-result-type-mismatch' is returned.
-
-The following properties which were standard in Xft v.1 are obsolete in
-Xft v.2: encoding, charwidth, charheight, core, and render. */
- (pattern, property, id, type))
-{
- FcChar8 *fc_property; /* UExtbyte * */
- FcResult fc_result;
- FcValue fc_value;
-
- /*
- process arguments
- */
- CHECK_FCPATTERN (pattern);
-
-#if 0
- /* Don't support the losing symbol-for-property interface. */
- property = SYMBOLP (property) ? symbol_name (XSYMBOL (property)) : property;
-#endif
- if (STRINGP (property))
- {
- fc_property = (FcChar8 *) extract_fcapi_string (property);
- }
- else
- {
- /* if we allow symbols, this would need to be
- list3 (Qlambda, list1 (Qobject),
- list3 (Qor, list2 (Qstringp, Qobject),
- list2 (Qsymbolp, Qobject)))
- or something like that? */
- dead_wrong_type_argument (Qstringp, property);
- }
-
- if (!NILP (id)) CHECK_NATNUM (id);
- if (!NILP (type)) CHECK_SYMBOL (type);
-
- /* get property */
- fc_result = FcPatternGet (XFCPATTERN_PTR (pattern),
- fc_property,
- NILP (id) ? 0 : XINT(id),
- &fc_value);
-
- switch (fc_result)
- {
- case FcResultMatch:
- /* wrap it and return */
- switch (fc_value.type)
- {
- case FcTypeInteger:
- return ((!NILP (type) && !EQ (type, Qinteger))
- ? Qfc_result_type_mismatch : make_int (fc_value.u.i));
- case FcTypeDouble:
- return ((!NILP (type) && !EQ (type, intern ("double"))
- && !EQ (type, Qfloat))
- ? Qfc_result_type_mismatch : make_float (fc_value.u.d));
- case FcTypeString:
- return ((!NILP (type) && !EQ (type, Qstring))
- ? Qfc_result_type_mismatch
- : build_ext_string (fc_value.u.s, Qxft_font_name_encoding));
- case FcTypeBool:
- return ((!NILP (type) && !EQ (type, Qboolean))
- ? Qfc_result_type_mismatch : fc_value.u.b ? Qt : Qnil);
- case FcTypeMatrix:
- return Qfc_result_type_mismatch;
- /* #### unimplemented
- return ((!NILP (type) && !EQ (type, intern ("matrix")))
- ? Qfc_result_type_mismatch : make_int (fc_value.u.m));
- */
- case FcTypeCharSet:
- return Qfc_result_type_mismatch;
- /* #### unimplemented
- return ((!NILP (type) && !EQ (type, intern ("charset")))
- ? Qfc_result_type_mismatch : make_int (fc_value.u.c));
- */
- }
- case FcResultTypeMismatch:
- return Qfc_result_type_mismatch;
- case FcResultNoMatch:
- return Qfc_result_no_match;
- case FcResultNoId:
- return Qfc_result_no_id;
- default:
- return Qfc_internal_error;
- }
-}
-
-DEFUN("fc-font-match", Ffc_font_match, 2, 2, 0, /*
-Return the font on DEVICE that most closely matches PATTERN.
-
-DEVICE is an X11 device.
-PATTERN is a fontconfig pattern object.
-Returns a fontconfig pattern object representing the closest match to the
-given pattern, or an error code. Possible error codes are
-`fc-result-no-match' and `fc-result-no-id'. */
- (device, pattern))
-{
- Display *dpy;
- FcResult res;
-
- struct fc_pattern *res_fcpat =
- ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
- CHECK_FCPATTERN(pattern); /* #### MEMORY LEAKS!!! */
- if (NILP(device))
- return Qnil;
- CHECK_X_DEVICE(device);
- if (!DEVICE_LIVE_P(XDEVICE(device)))
- return Qnil;
-
- dpy = DEVICE_X_DISPLAY(XDEVICE(device));
- /* More Xft vs fontconfig brain damage? */
- res_fcpat->fcpatPtr = XftFontMatch(dpy, DefaultScreen (dpy),
- XFCPATTERN_PTR(pattern), &res);
-
- if (res_fcpat->fcpatPtr == NULL)
- switch (res) {
- case FcResultNoMatch:
- return Qfc_result_no_match;
- case FcResultNoId:
- return Qfc_result_no_id;
- default:
- return Qfc_internal_error;
- }
- else
- return wrap_fcpattern(res_fcpat);
-}
-
-/* NOTE NOTE NOTE This function destroys the FcFontSet passed to it. */
-static Lisp_Object
-fontset_to_list (FcFontSet *fontset)
-{
- int idx;
- Lisp_Object fontlist = Qnil;
- fc_pattern *fcpat;
-
- /* #### improve this error message */
- if (!fontset)
- Fsignal (Qinvalid_state,
- list1 (build_string ("failed to create FcFontSet")));
- for (idx = 0; idx < fontset->nfont; ++idx)
- {
- fcpat =
- ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
- fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]);
- fontlist = Fcons (wrap_fcpattern(fcpat), fontlist);
- }
- FcFontSetDestroy (fontset);
- return fontlist;
-}
-
-/* #### fix this name to correspond to Ben's new nomenclature */
-DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects,
- 3, 3, 0, /*
-Return a list of fonts on DEVICE that match PATTERN for PROPERTIES.
-Each font is represented by a fontconfig pattern object.
-
-DEVICE is an X11 device.
-PATTERN is a fontconfig pattern to be matched.
-PROPERTIES is a list of property names (strings) that should match.
-
-#### DEVICE is unused, ignored, and may be removed if it's not needed to
-match other font-listing APIs. */
- (UNUSED (device), pattern, properties))
-{
- FcObjectSet *os;
- FcFontSet *fontset;
-
- CHECK_FCPATTERN (pattern);
- CHECK_LIST (properties);
-
- os = FcObjectSetCreate ();
- string_list_to_fcobjectset (properties, os);
- /* #### why don't we need to do the "usual substitutions"? */
- fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os);
- FcObjectSetDestroy (os);
-
- return fontset_to_list (fontset);
-
-}
-
-/* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */
-DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /*
-Return a list of all fonts sorted by proximity to PATTERN.
-Each font is represented by a fontconfig pattern object.
-
-DEVICE is an X11 device.
-PATTERN is a fontconfig pattern to be matched.
-Optional argument TRIM, if non-nil, means to trim trailing fonts that do not
-contribute new characters to the union repertoire.
-
-#### Optional argument NOSUB, if non-nil, suppresses some of the usual
-property substitutions. DON'T USE THIS in production code, it is intended
-for exploring behavior of fontconfig and will be removed when this code is
-stable.
-
-#### DEVICE is unused, ignored, and may be removed if it's not needed to
-match other font-listing APIs. */
- (UNUSED (device), pattern, trim, nosub))
-{
- CHECK_FCPATTERN (pattern);
-
- {
- FcConfig *fcc = FcConfigGetCurrent();
- FcFontSet *fontset;
- FcPattern *p = XFCPATTERN_PTR (pattern);
- FcResult fcresult;
-
- if (NILP(nosub)) /* #### temporary debug hack */
- FcDefaultSubstitute (p);
- FcConfigSubstitute (fcc, p, FcMatchPattern);
- fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult);
-
- return fontset_to_list (fontset);
- }
-}
-
-/* #### this actually is an Xft function, should split those out
- or get rid of them entirely? */
-/* #### be consistent about argument order. */
-DEFUN("fc-font-real-pattern", Ffc_font_real_pattern, 2, 2, 0, /*
-Temporarily open FONTNAME (a string) and return the actual
-fc pattern matched by the Fc library. */
- (fontname, xdevice))
-{
- FcPattern *copy;
- Display *dpy;
- XftFont *font;
- struct fc_pattern *fcpat =
- ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
-
- CHECK_STRING (fontname); /* #### MEMORY LEAK?! maybe not ... */
- if (NILP(xdevice))
- return Qnil;
- CHECK_X_DEVICE (xdevice);
- if (!DEVICE_LIVE_P(XDEVICE(xdevice)))
- return Qnil;
-
- /* #### these gymnastics should be unnecessary, just use FcFontMatch */
- dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice));
- font = XftFontOpenName (dpy, DefaultScreen(dpy),
- extract_fcapi_string (fontname));
- if (font == NULL)
- return Qnil;
- copy = FcPatternDuplicate(font->pattern);
- XftFontClose(dpy, font);
- if (copy == NULL)
- return Qnil;
- fcpat->fcpatPtr = copy;
- return wrap_fcpattern(fcpat);
-}
-
-DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
-Check whether the string FONTNAME is a XLFD font name. */
- (fontname))
-{
- CHECK_STRING(fontname);
- /* #### should bind `case-fold-search' here? */
- return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil);
-}
-
-/* FcPatternPrint: there is no point in having wrappers fc-pattern-print,
- Ffc_pattern_print since this function prints to stdout. */
-
-/* Initialization of xft-fonts */
-
-#define XE_XLFD_SEPARATOR "-"
- /* XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII
- in Mule when this function is called. So use HPC. */
-#if 0
-#define XE_XLFD_PREFIX "\\(\\+[\040-\176\240-\377]*\\)?-"
-#define XE_XLFD_OPT_TEXT "\\([\040-\044\046-\176\240-\377]*\\)"
-#define XE_XLFD_TEXT "\\([\040-\044\046-\176\240-\377]+\\)"
-#else
-#define XE_XLFD_PREFIX "\\(\\+[\040-\176]*\\)?-"
-#define XE_XLFD_OPT_TEXT "\\([^-]*\\)"
-#define XE_XLFD_TEXT "\\([^-]+\\)"
-#endif
-
-#define XE_XLFD_SLANT "\\([0-9ior?*][iot]?\\)"
-#define XE_XLFD_SPACING "\\([cmp?*]\\)"
- /* Hyphen as minus conflicts with use as separator. */
-#define XE_XLFD_OPT_NEGATE "~?"
-#define XE_XLFD_NUMBER "\\([0-9?*]+\\)"
-#define XE_XLFD_PSIZE "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)"
-
-/* Call this only from the init code
- #### This is really horrible, let's get rid of it, please. */
-static Lisp_Object
-make_xlfd_font_regexp (void)
-{
- struct gcpro gcpro1;
- unsigned i;
- Lisp_Object reg = Qnil;
- const Extbyte *re[] = /* #### This could just be catenated by
- cpp and passed to build_ext_string. */
- {
- /* Regular expression matching XLFDs as defined by XLFD v. 1.5.
- Matches must be case-insensitive.
- PSIZE is a pixel or point size, which may be a "matrix". The
- syntax of a matrix is not checked, just some lexical properties.
- AFAICT none of the TEXT fields except adstyle is optional.
-
- NB. It should not be a problem if this matches "too much", since
- an "old" server will simply not be able to find a matching font. */
- "\\`",
- XE_XLFD_PREFIX, /* prefix */
- XE_XLFD_TEXT, /* foundry */
- XE_XLFD_SEPARATOR,
- XE_XLFD_TEXT, /* family */
- XE_XLFD_SEPARATOR,
- XE_XLFD_TEXT, /* weight */
- XE_XLFD_SEPARATOR,
- XE_XLFD_SLANT, /* slant */
- XE_XLFD_SEPARATOR,
- XE_XLFD_TEXT, /* swidth */
- XE_XLFD_SEPARATOR,
- XE_XLFD_OPT_TEXT, /* adstyle */
- XE_XLFD_SEPARATOR,
- XE_XLFD_PSIZE, /* pixelsize */
- XE_XLFD_SEPARATOR,
- XE_XLFD_PSIZE, /* pointsize */
- XE_XLFD_SEPARATOR,
- XE_XLFD_NUMBER, /* resx */
- XE_XLFD_SEPARATOR,
- XE_XLFD_NUMBER, /* resy */
- XE_XLFD_SEPARATOR,
- XE_XLFD_SPACING, /* spacing */
- XE_XLFD_SEPARATOR,
- XE_XLFD_OPT_NEGATE, /* avgwidth */
- XE_XLFD_NUMBER,
- XE_XLFD_SEPARATOR,
- XE_XLFD_TEXT, /* registry */
- XE_XLFD_SEPARATOR,
- XE_XLFD_TEXT, /* encoding */
- "\\'"
- };
-
- GCPRO1 (reg);
- for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++)
- {
- /* #### Currently this is Host Portable Coding, not ISO 8859-1. */
- reg = concat2(reg, build_ext_string (re[i], Qx_font_name_encoding));
- }
-
- RETURN_UNGCPRO (reg);
-}
-#undef XE_XLFD_SEPARATOR
-#undef XE_XLFD_PREFIX
-#undef XE_XLFD_OPT_TEXT
-#undef XE_XLFD_TEXT
-#undef XE_XLFD_OPT_SLANT
-#undef XE_XLFD_OPT_SPACING
-#undef XE_XLFD_OPT_NEGATE
-#undef XE_XLFD_NUMBER
-#undef XE_XLFD_PSIZE
-
-#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
- ? ((unsigned long) (x)) : ((unsigned long) (y)))
-
-static void
-string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os)
-{
- EXTERNAL_LIST_LOOP_2 (elt, list)
- {
- FcChar8 *s;
-
- CHECK_STRING (elt);
- s = fc_intern (elt);
- fprintf (stderr, "%s\n", s);
- FcObjectSetAdd (os, s);
- }
-}
-
-void
-syms_of_xft_fonts (void)
-{
- INIT_LRECORD_IMPLEMENTATION(fc_pattern);
-
- DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp);
-
- DEFSYMBOL(Qfc_result_type_mismatch);
- DEFSYMBOL(Qfc_result_no_match);
- DEFSYMBOL(Qfc_result_no_id);
- DEFSYMBOL(Qfc_internal_error);
- DEFSYMBOL(Qxft_font);
-
- DEFSUBR(Ffc_pattern_p);
- DEFSUBR(Ffc_pattern_create);
- DEFSUBR(Ffc_name_parse);
- DEFSUBR(Ffc_name_unparse);
-#if 0
- DEFSUBR(Fxft_name_unparse); /* URK! */
-#endif
- DEFSUBR(Ffc_pattern_duplicate);
- DEFSUBR(Ffc_pattern_add);
- DEFSUBR(Ffc_pattern_del);
- DEFSUBR(Ffc_pattern_get);
- DEFSUBR(Ffc_list_fonts_pattern_objects);
- DEFSUBR(Ffc_font_sort);
- DEFSUBR(Ffc_font_match);
- DEFSUBR(Ffc_font_real_pattern);
- DEFSUBR(Fxlfd_font_name_p);
-}
-
-void
-vars_of_xft_fonts (void)
-{
- /* #### I know, but the right fix is use the generic debug facility. */
- DEFVAR_INT ("xft-debug-level", &debug_xft /*
-Level of debugging messages to issue to stderr for Xft.
-A nonnegative integer. Set to 0 to suppress all warnings.
-Default is 1 to ensure a minimum of debugging output at initialization.
-Higher levels give even more information.
-*/ );
- debug_xft = 1;
-
- DEFVAR_LISP("xft-version", &Vxft_version /*
-The major version number of the Xft library being used.
-*/ );
- Vxft_version = make_int(XFT_VERSION);
-
- Fprovide (intern ("xft"));
-}
-
-void
-complex_vars_of_xft_fonts (void)
-{
- DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /*
-The regular expression used to match XLFD font names. */
- );
- Vxlfd_font_name_regexp = make_xlfd_font_regexp();
-}
-
-void
-reinit_vars_of_xft_fonts (void)
-{
- int i, size = (int) countof (fc_standard_properties);
-
- FcInit ();
-
- fc_property_name_hash_table = make_string_hash_table (size);
- for (i = 0; i < size; ++i)
- puthash (fc_standard_properties[i], NULL, fc_property_name_hash_table);
-}
-
Index: src/xft-fonts.h
===================================================================
RCS file: src/xft-fonts.h
diff -N src/xft-fonts.h
--- src/xft-fonts.h 26 Nov 2005 11:46:11 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
＠＠ -1,71 +0,0 ＠＠
-/* Lisp font data structures for X and Xft.
-
-Copyright (C) 2003 Eric Knauel and Matthias Neubauer
-Copyright (C) 2005 Eric Knauel
-Copyright (C) 2004, 2005 Free Software Foundation, Inc.
-
-Authors: Eric Knauel <knauel(a)informatik.uni-tuebingen.de>
- Matthias Neubauer <neubauer(a)informatik.uni-freiburg.de>
- Stephen J. Turnbull <stephen(a)xemacs.org>
-Created: 27 Oct 2003
-Updated: 05 Mar 2005 by Stephen J. Turnbull
-
-This file is part of XEmacs.
-
-XEmacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-XEmacs is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License
-along with XEmacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Synched up with: Not in GNU Emacs. */
-
-/* This module provides the Lisp interface to fonts in X11, including Xft,
- but (at least at first) not GTK+ or Qt.
-
- It should be renamed to fonts-x.h.
-
- Sealevel code should be in ../lwlib/lwlib-fonts.h or
- ../lwlib/lwlib-colors.h.
-*/
-
-
-#ifndef INCLUDED_xft_fonts_h_
-#define INCLUDED_xft_fonts_h_
-
-#include "../lwlib/lwlib-fonts.h"
-#include "../lwlib/lwlib-colors.h"
-
-extern Fixnum debug_xft;
-
-/* Standard for fontconfig. Use a macro to show we're not guessing. */
-#define Qxft_font_name_encoding Qutf_8
-
-#define XE_XLFD_MAKE_LISP_STRING(s) (make_string(s, strlen(s)))
-
-struct fc_pattern
-{
- struct LCRECORD_HEADER header;
- FcPattern *fcpatPtr;
-};
-
-typedef struct fc_pattern fc_pattern;
-
-DECLARE_LRECORD(fc_pattern, struct fc_pattern);
-#define XFCPATTERN(x) XRECORD (x, fc_pattern, struct fc_pattern)
-#define wrap_fcpattern(p) wrap_record (p, fc_pattern)
-#define FCPATTERNP(x) RECORDP (x, fc_pattern)
-#define CHECK_FCPATTERN(x) CHECK_RECORD (x, fc_pattern)
-#define CONCHECK_FCPATTERN(x) CONCHECK_RECORD (x, fc_pattern)
-#define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr)
-
-#endif /* INCLUDED_xft_fonts_h_ */
--
School of Systems and Information Engineering http://turnbull.sk.tsukuba.ac.jp
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Ask not how you can "do" free software business;
ask what your business can "do for" free software.
- 1 participants
- 0 comments
[AC21.5] small comment patch
18 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT 21.5
Not for 21.4.
Index: src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.944
diff -u -r1.944 ChangeLog
--- src/ChangeLog 18 Apr 2006 17:28:30 -0000 1.944
+++ src/ChangeLog 22 Apr 2006 14:47:11 -0000
＠＠ -0,0 +1,4 ＠＠
+2006-04-17 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * unicode.c: Improve comment on to/from_unicode table design.
+
Index: src/unicode.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/unicode.c,v
retrieving revision 1.31
diff -u -r1.31 unicode.c
--- src/unicode.c 25 Oct 2005 11:16:29 -0000 1.31
+++ src/unicode.c 22 Apr 2006 14:47:11 -0000
＠＠ -202,12 +202,11 ＠＠
#ifdef MULE
-/* #### Using ints for to_unicode is OK (as long as they are >= 32 bits).
- However, shouldn't the shorts below be unsigned?
-
- Answer: Doesn't matter because the values being converted to are only
- 96x96. */
+/* Using ints for to_unicode is OK (as long as they are >= 32 bits).
+ In from_unicode, we're converting from Mule characters, which means
+ that the values being converted to are only 96x96, and we can save
+ space by using shorts (signedness doesn't matter). */
static int *to_unicode_blank_1;
static int **to_unicode_blank_2;
--
Graduate School of Systems and Information Engineering University of Tsukuba
http://turnbull.sk.tsukuba.ac.jp/ Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Economics of Information Communication and Computation Systems
Experimental Economics, Microeconomic Theory, Game Theory
- 1 participants
- 0 comments
[AC21.5] ALSA version check fix
18 years, 8 months
Jerry James
Jerry James
APPROVE COMMIT 21.5
This falls under the "obviously correct" rule. As reported by Ilya
Golubev, older versions of the ALSA library do not pull alsa/version.h
in from the headers we already include in alsaplay.h.
src/ChangeLog addition:
2006-04-18 Jerry James <james(a)xemacs.org>
* alsaplay.c: Explicitly include ALSA's version.h for older
versions of the library. Thanks to Ilya Golubev.
xemacs-21.5 source patch:
Diff command: cvs -q diff -uN
Files affected: src/alsaplay.c
Index: src/alsaplay.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alsaplay.c,v
retrieving revision 1.2
diff -d -u -r1.2 alsaplay.c
--- src/alsaplay.c 2006/04/10 15:16:47 1.2
+++ src/alsaplay.c 2006/04/18 17:25:15
＠＠ -30,6 +30,7 ＠＠
/* We can't just include <alsa/asoundlib.h> because it tries to redefine
* several symbols defined by the previous header files.
*/
+#include <alsa/version.h>
#include <alsa/input.h>
#include <alsa/output.h>
#include <alsa/conf.h>
--
Jerry James, Assistant Professor james(a)xemacs.org
Computer Science Department http://www.cs.usu.edu/~jerry/
Utah State University
- 1 participants
- 0 comments
[PATCH (pkgs)] VHDL update
18 years, 8 months
Jerry James
Jerry James
PATCH packages
The recent message about VHDL mode reminded me that I was the last one
to sync it with upstream. So here's one more sync. Since I have never
yet gotten around to learning VHDL, and it doesn't appear that I will
soon, it would be good if someone with an actual interest in the
language would take over making these syncs.
xemacs-packages/vhdl/ChangeLog addition:
2006-04-07 Jerry James <james(a)xemacs.org>
* vhdl-mode.el: Sync with version 3.33.8.
* Makefile (AUTHOR_VERSION): Change to 3.33.8.
packages source patch:
Diff command: cvs -q diff -uN
Files affected: xemacs-packages/vhdl/vhdl-mode.el xemacs-packages/vhdl/Makefile
Index: xemacs-packages/vhdl/Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/vhdl/Makefile,v
retrieving revision 1.30
diff -d -u -r1.30 Makefile
--- xemacs-packages/vhdl/Makefile 2005/02/14 21:54:25 1.30
+++ xemacs-packages/vhdl/Makefile 2006/04/07 16:22:05
＠＠ -18,7 +18,7 ＠＠
# Boston, MA 02111-1307, USA.
VERSION = 1.20
-AUTHOR_VERSION = 3.33.2
+AUTHOR_VERSION = 3.33.8
MAINTAINER = XEmacs Development Team <xemacs-beta(a)xemacs.org>
PACKAGE = vhdl
PKG_TYPE = regular
Index: xemacs-packages/vhdl/vhdl-mode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/vhdl/vhdl-mode.el,v
retrieving revision 1.8
diff -d -u -r1.8 vhdl-mode.el
--- xemacs-packages/vhdl/vhdl-mode.el 2005/02/14 17:27:50 1.8
+++ xemacs-packages/vhdl/vhdl-mode.el 2006/04/07 16:22:06
＠＠ -5,14 +5,14 ＠＠
;; Authors: Reto Zimmermann <reto(a)gnu.org>
;; Rodney J. Whitby <software.vhdl-mode(a)rwhitby.net>
;; Maintainer: Reto Zimmermann <reto(a)gnu.org>
-;; RCS: $Id: vhdl-mode.el,v 1.8 2005/02/14 17:27:50 james Exp $
+;; RCS: $Id: vhdl-mode.el,v 33.15 2005/12/09 12:30:12 reto Exp reto $
;; Keywords: languages vhdl
;; WWW: http://opensource.ethz.ch/emacs/vhdl-mode.html
-(defconst vhdl-version "3.33.2"
+(defconst vhdl-version "3.33.8"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2005-01-11"
+(defconst vhdl-time-stamp "2005-12-09"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
＠＠ -29,8 +29,8 ＠＠
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Commentary:
＠＠ -70,13 +70,13 ＠＠
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Versions
-;; supported: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X
+;; supported: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X
;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X.
+;; Prerequisites: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X.
;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
;; or into an arbitrary directory that is added to the load path by the
＠＠ -128,10 +128,18 ＠＠
;; XEmacs handling
(defconst vhdl-xemacs (string-match "XEmacs" emacs-version)
"Non-nil if XEmacs is used.")
-;; Emacs 21 handling
-(defconst vhdl-emacs-21 (and (= emacs-major-version 21) (not vhdl-xemacs))
- "Non-nil if GNU Emacs 21 is used.")
+;; Emacs 21+ handling
+(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not vhdl-xemacs))
+ "Non-nil if GNU Emacs 21, 22, ... is used.")
+(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not vhdl-xemacs))
+ "Non-nil if GNU Emacs 22, ... is used.")
+(defvar compilation-file-regexp-alist)
+(defvar itimer-version)
+(defvar lazy-lock-defer-contextually)
+(defvar lazy-lock-defer-on-scrolling)
+(defvar lazy-lock-defer-on-the-fly)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Variables
＠＠ -324,6 +332,12 ＠＠
("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
+ ;; Xilinx XST:
+ ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
+ ("Xilinx XST" "xflow" "" "make" "-f \\1"
+ nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
+ ("^ERROR:HDLParsers:[0-9]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0)
+ nil)
)
"*List of available VHDL compilers and their properties.
Each list entry specifies the following items for a compiler:
＠＠ -342,7 +356,7 ＠＠
Makefile name : name of Makefile (default is \"Makefile\")
ID string : compiler identification string (see `vhdl-project-alist')
Error message:
- Regexp : regular expression to match error messages
+ Regexp : regular expression to match error messages (*)
File subexp index: index of subexpression that matches the file name
Line subexp index: index of subexpression that matches the line number
Column subexp idx: index of subexpression that matches the column number
＠＠ -355,6 +369,9 ＠＠
\"\\2\" inserts the entity name for architectures)
Case adjustment : adjust case of inserted unit names
+\(*) The regular expression must match the error message starting from the
+ beginning of the line (but not necessarily to the end of the line).
+
Compile options allows insertion of the library name (see `vhdl-project-alist')
in order to set the compilers library option (e.g. \"vcom -work my_lib\").
＠＠ -384,8 +401,8 ＠＠
Please send any missing or erroneous compiler properties to the maintainer for
updating.
-NOTE: Reflect the new setting in the choice list of option `vhdl-compiler'
- by restarting Emacs."
+NOTE: Activate new error and file message regexps and reflect the new setting
+ in the choice list of option `vhdl-compiler' by restarting Emacs."
:type '(repeat
(list :tag "Compiler" :indent 2
(string :tag "Compiler name ")
＠＠ -1245,7 +1262,7 ＠＠
(defgroup vhdl-testbench nil
- "Customizations for testbench generation ."
+ "Customizations for testbench generation."
:group 'vhdl-port)
(defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
＠＠ -2128,7 +2145,7 ＠＠
(defun vhdl-run-when-idle (secs repeat function)
"Wait until idle, then run FUNCTION."
- (if vhdl-xemacs
+ (if (fboundp 'start-itimer)
(start-itimer "vhdl-mode" function secs repeat t)
; (run-with-idle-timer secs repeat function)))
;; explicitely activate timer (necessary when Emacs is already idle)
＠＠ -2394,7 +2411,7 ＠＠
(progn
(when file-opened (kill-buffer (current-buffer)))
(set-buffer source-buffer)
- (error (format "ERROR: File cannot be opened: \"%s\"" ,file-name)))
+ (error "ERROR: File cannot be opened: \"%s\"" ,file-name))
(vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t)
nil))))
(condition-case info
＠＠ -2671,7 +2688,7 ＠＠
(define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent)
(define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent)
(unless vhdl-xemacs ; would override `M-backspace' in XEmacs
- (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
+ (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
(define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
(define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
;; backspace/delete key bindings
＠＠ -2767,9 +2784,8 ＠＠
(define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
;; electric key bindings
(define-key vhdl-mode-map " " 'vhdl-electric-space)
- (if vhdl-intelligent-tab
- (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)
- (define-key vhdl-mode-map "\t" 'indent-according-to-mode))
+ (when vhdl-intelligent-tab
+ (define-key vhdl-mode-map "\t" 'vhdl-electric-tab))
(define-key vhdl-mode-map "\r" 'vhdl-electric-return)
(define-key vhdl-mode-map "-" 'vhdl-electric-dash)
(define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket)
＠＠ -2786,12 +2802,14 ＠＠
;; define special minibuffer keymap for enabling word completion in minibuffer
;; (useful in template generator prompts)
-(defvar vhdl-minibuffer-local-map (copy-keymap minibuffer-local-map)
+(defvar vhdl-minibuffer-local-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (when vhdl-word-completion-in-minibuffer
+ (define-key map "\t" 'vhdl-minibuffer-tab))
+ map)
"Keymap for minibuffer used in VHDL Mode.")
-(when vhdl-word-completion-in-minibuffer
- (define-key vhdl-minibuffer-local-map "\t" 'vhdl-minibuffer-tab))
-
;; set up electric character functions to work with
;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
(mapcar
＠＠ -2838,7 +2856,7 ＠＠
(modify-syntax-entry ?\< "." vhdl-mode-syntax-table)
(modify-syntax-entry ?\= "." vhdl-mode-syntax-table)
(modify-syntax-entry ?\> "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\\ "." vhdl-mode-syntax-table)
+ (modify-syntax-entry ?\\ "w" vhdl-mode-syntax-table)
(modify-syntax-entry ?\| "." vhdl-mode-syntax-table)
;; define string
(modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table)
＠＠ -3175,6 +3193,7 ＠＠
(vhdl-menu-split menu-list "Project"))
'("--" "--"
["Select Project..." vhdl-set-project t]
+ ["Set As Default Project" vhdl-set-default-project t]
"--"
["Duplicate Project" vhdl-duplicate-project vhdl-project]
["Import Project..." vhdl-import-project
＠＠ -3799,7 +3818,7 ＠＠
(not vhdl-use-components-package))
:style toggle :selected vhdl-use-components-package]
["Include Header"
- (customize-set-variable 'vhdl-compose-include-headera
+ (customize-set-variable 'vhdl-compose-include-header
(not vhdl-compose-include-header))
:style toggle :selected vhdl-compose-include-header]
("Create Entity/Architecture Files"
＠＠ -3858,7 +3877,8 ＠＠
("Highlight"
["Highlighting On/Off..."
(customize-option
- (if vhdl-xemacs 'font-lock-auto-fontify 'global-font-lock-mode)) t]
+ (if (fboundp 'global-font-lock-mode)
+ 'global-font-lock-mode 'font-lock-auto-fontify)) t]
["Highlight Keywords"
(progn (customize-set-variable 'vhdl-highlight-keywords
(not vhdl-highlight-keywords))
＠＠ -4275,7 +4295,7 ＠＠
CODE FILLING:
- Code filling allows to condens code (e.g. sensitivity lists or port
+ Code filling allows to condense code (e.g. sensitivity lists or port
maps) by removing comments and newlines and re-wrapping so that all
lines are maximally filled (block filling). `C-c C-f C-f' fills a list
enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
＠＠ -4685,7 +4705,8 ＠＠
"\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'require-final-newline) t)
+ (set (make-local-variable 'require-final-newline)
+ (if vhdl-emacs-22 mode-require-final-newline t))
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
(set (make-local-variable 'comment-start) "--")
＠＠ -4744,7 +4765,9 ＠＠
(if noninteractive "" " See menu for documentation and release notes."))
;; run hooks
- (run-hooks 'vhdl-mode-hook))
+ (if vhdl-emacs-22
+ (run-mode-hooks 'vhdl-mode-hook)
+ (run-hooks 'vhdl-mode-hook)))
(defun vhdl-activate-customizations ()
"Activate all customizations on local variables."
＠＠ -5192,7 +5215,7 ＠＠
(defun vhdl-read-offset (langelem)
"Read new offset value for LANGELEM from minibuffer.
-Return a legal value only."
+Return a valid value only."
(let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
(errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
(prompt "Offset: ")
＠＠ -5204,7 +5227,7 ＠＠
((string-equal "++" input) '++)
((string-equal "--" input) '--)
((string-match "^-?[0-9]+$" input)
- (string-to-int input))
+ (string-to-number input))
((fboundp (setq interned (intern input)))
interned)
((boundp interned) interned)
＠＠ -5737,7 +5760,8 ＠＠
(save-excursion
(re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
(or (eq (following-char) ?\;)
- (eq (point) lim)))))
+ (eq (point) lim)
+ (vhdl-in-literal)))))
(defun vhdl-corresponding-begin (&optional lim)
"If the word at the current position corresponds to an \"end\"
＠＠ -6166,8 +6190,8 ＠＠
stops due to beginning or end of buffer.
Note that if point is between the \"libunit\" keyword and the
corresponding \"begin\" keyword, then that libunit will not be
-recognised, and the search will continue backwards. If point is
-at the \"begin\" keyword, then the defun will be recognised. The
+recognized, and the search will continue backwards. If point is
+at the \"begin\" keyword, then the defun will be recognized. The
returned point is at the first character of the \"libunit\" keyword."
(let ((last-forward (point))
(last-backward
＠＠ -6210,8 +6234,8 ＠＠
stops due to beginning or end of buffer."
;; Note that if point is between the "defun" keyword and the
;; corresponding "begin" keyword, then that defun will not be
- ;; recognised, and the search will continue backwards. If point is
- ;; at the "begin" keyword, then the defun will be recognised. The
+ ;; recognized, and the search will continue backwards. If point is
+ ;; at the "begin" keyword, then the defun will be recognized. The
;; returned point is at the first character of the "defun" keyword.
(interactive "p")
(let ((count (or count 1))
＠＠ -6264,17 +6288,17 ＠＠
(vhdl-keep-region-active)
foundp))
-(defun vhdl-beginning-of-statement (&optional count lim)
+(defun vhdl-beginning-of-statement (&optional count lim interactive)
"Go to the beginning of the innermost VHDL statement.
With prefix arg, go back N - 1 statements. If already at the
beginning of a statement then go to the beginning of the preceding
one. If within a string or comment, or next to a comment (only
whitespace between), move by sentences instead of statements.
-When called from a program, this function takes 2 optional args: the
-prefix arg, and a buffer position limit which is the farthest back to
-search."
- (interactive "p")
+When called from a program, this function takes 3 optional args: the
+prefix arg, a buffer position limit which is the farthest back to
+search, and an argument indicating an interactive call."
+ (interactive "p\np")
(let ((count (or count 1))
(case-fold-search t)
(lim (or lim (point-min)))
＠＠ -6283,7 +6307,7 ＠＠
(save-excursion
(goto-char lim)
(setq state (parse-partial-sexp (point) here nil nil)))
- (if (and (interactive-p)
+ (if (and interactive
(or (nth 3 state)
(nth 4 state)
(looking-at (concat "[ \t]*" comment-start-skip))))
＠＠ -7678,10 +7702,10 ＠＠
(defun vhdl-fill-region (beg end &optional arg)
"Fill lines for a region of code."
- (interactive "r")
+ (interactive "r\np")
(save-excursion
(goto-char beg)
- (let ((margin (if (interactive-p) (current-indentation) (current-column))))
+ (let ((margin (if arg (current-indentation) (current-column))))
(goto-char end)
(setq end (point-marker))
;; remove inline comments, newlines and whitespace
＠＠ -7804,7 +7828,8 ＠＠
;; parameter list of procedure call
((and (re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t)
(1- (point)))
- (progn (forward-sexp) (point)))))
+ (progn (backward-char) (forward-sexp)
+ (while (looking-at "(") (forward-sexp)) (point)))))
name read-list sens-list signal-list
sens-beg sens-end beg end margin)
;; scan for signals in old sensitivity list
＠＠ -8036,7 +8061,7 ＠＠
;; correct different behavior of function `unread-command-events' in XEmacs
(defun vhdl-character-to-event (arg))
(defalias 'vhdl-character-to-event
- (if vhdl-xemacs 'character-to-event 'identity))
+ (if (fboundp 'character-to-event) 'character-to-event 'identity))
(defun vhdl-work-library ()
"Return the working library name of the current project or \"work\" if no
＠＠ -8347,7 +8372,8 ＠＠
(let ((margin (current-indentation))
(start (point))
label)
- (unless kind (setq kind (if (vhdl-sequential-statement-p) 'is 'use)))
+ (unless kind (setq kind (if (or (vhdl-sequential-statement-p)
+ (not (vhdl-standard-p 'ams))) 'is 'use)))
(if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
(vhdl-insert-keyword "CASE ")
(vhdl-insert-keyword ": CASE ")
＠＠ -8935,7 +8961,7 ＠＠
(vhdl-insert-keyword
(concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
(indent-to margin)
- (vhdl-insert-keyword "END IF")
+ (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE")))
(when label (insert " " label))
(insert ";")
(forward-line -1)
＠＠ -10587,7 +10613,7 ＠＠
(when (stringp caught) (message caught)))
(when (= invoke-char ?-) (setq abbrev-start-location (point)))
;; delete CR which is still in event queue
- (if vhdl-xemacs
+ (if (fboundp 'enqueue-eval-event)
(enqueue-eval-event 'delete-char -1)
(setq unread-command-events ; push back a delete char
(list (vhdl-character-to-event ?\177))))))))
＠＠ -10983,8 +11009,8 ＠＠
(setq group-comment (vhdl-parse-group-comment))
(setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
(while (not end-of-list)
- ;; parse names
- (vhdl-parse-string "\\(\\w+\\)[ \t\n]*")
+ ;; parse names (accept extended identifiers)
+ (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
(setq names (list (match-string-no-properties 1)))
(while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)
(setq names
＠＠ -10992,6 +11018,9 ＠＠
;; parse type
(vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")
(setq type (match-string-no-properties 1))
+ (when (vhdl-in-comment-p) ; if stuck in comment
+ (setq type (concat type (and (vhdl-parse-string ".*")
+ (match-string-no-properties 0)))))
(setq comment nil)
(while (looking-at "(")
(setq type
＠＠ -11065,6 +11094,9 ＠＠
;; parse type
(vhdl-parse-string "\\([^();\n]+\\)")
(setq type (match-string-no-properties 1))
+ (when (vhdl-in-comment-p) ; if stuck in comment
+ (setq type (concat type (and (vhdl-parse-string ".*")
+ (match-string-no-properties 0)))))
(setq comment nil)
(while (looking-at "(")
(setq type (concat type
＠＠ -12302,6 +12334,12 ＠＠
(vhdl-warning (format "Unknown VHDL project: \"%s\"" name))))
(vhdl-speedbar-update-current-project))
+(defun vhdl-set-default-project ()
+ "Set current project as default on startup."
+ (interactive)
+ (customize-set-variable 'vhdl-project vhdl-project)
+ (customize-save-customized))
+
(defun vhdl-toggle-project (name token indent)
"Set current project to NAME or unset if NAME is current project."
(vhdl-set-project (if (equal name vhdl-project) "" name)))
＠＠ -12799,7 +12837,9 ＠＠
'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
(defface vhdl-font-lock-prompt-face
- '((((class color) (background light)) (:foreground "Red" :bold t))
+ '(;(((min-colors 88) (class color) (background light)) ; Emacs 22
+ ; (:foreground "Red1" :bold t))
+ (((class color) (background light)) (:foreground "Red" :bold t))
(((class color) (background dark)) (:foreground "Pink" :bold t))
(t (:inverse-video t)))
"Font lock mode face used to highlight prompts."
＠＠ -12840,6 +12880,8 ＠＠
(defface vhdl-font-lock-reserved-words-face
'((((class color) (background light)) (:foreground "Orange" :bold t))
+ ;(((min-colors 88) (class color) (background dark)) ; Emacs 22
+ ; (:foreground "Yellow1" :bold t))
(((class color) (background dark)) (:foreground "Yellow" :bold t))
(t ()))
"Font lock mode face used to highlight additional reserved words."
＠＠ -13920,10 +13962,10 ＠＠
(condition-case ()
(progn (load-file file-dir-name)
(string< (mapconcat
- (lambda (a) (format "%3d" (string-to-int a)))
+ (lambda (a) (format "%3d" (string-to-number a)))
(split-string "3.33" "\\.") "")
(mapconcat
- (lambda (a) (format "%3d" (string-to-int a)))
+ (lambda (a) (format "%3d" (string-to-number a)))
(split-string vhdl-cache-version "\\.") "")))
(error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name))
nil))))))
＠＠ -14297,7 +14339,7 ＠＠
(beginning-of-line) (looking-at "^\\([0-9]+\\):"))
(re-search-backward
(format "^[0-%d]:\\s-*[[{<]-"
- (max (1- (string-to-int (match-string 1))) 0)) nil t)))
+ (max (1- (string-to-number (match-string 1))) 0)) nil t)))
(goto-char (match-end 0))
(speedbar-do-function-pointer)
(speedbar-center-buffer-smartly)))
＠＠ -15045,7 +15087,7 ＠＠
(save-excursion
(beginning-of-line)
(looking-at "^\\([0-9]+\\):")
- (setq depth (string-to-int (match-string 1)))
+ (setq depth (string-to-number (match-string 1)))
(when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t)
(setq string (match-string 1))
(set-text-properties 0 (length string) nil string)
＠＠ -15167,7 +15209,7 ＠＠
"Place the entity/component under the cursor as component."
(interactive)
(if (not (vhdl-speedbar-check-unit 'entity))
- (error "ERROR: No entity/component under cursor.")
+ (error "ERROR: No entity/component under cursor")
(vhdl-speedbar-port-copy)
(if (fboundp 'speedbar-select-attached-frame)
(speedbar-select-attached-frame)
＠＠ -15179,7 +15221,7 ＠＠
"Generate configuration for the architecture under the cursor."
(interactive)
(if (not (vhdl-speedbar-check-unit 'architecture))
- (error "ERROR: No architecture under cursor.")
+ (error "ERROR: No architecture under cursor")
(let ((arch-name (vhdl-speedbar-line-text))
(ent-name (vhdl-speedbar-higher-text)))
(if (fboundp 'speedbar-select-attached-frame)
＠＠ -15191,7 +15233,7 ＠＠
"Select the architecture under the cursor as MRA."
(interactive)
(if (not (vhdl-speedbar-check-unit 'architecture))
- (error "ERROR: No architecture under cursor.")
+ (error "ERROR: No architecture under cursor")
(let* ((arch-key (downcase (vhdl-speedbar-line-text)))
(ent-key (downcase (vhdl-speedbar-higher-text)))
(ent-alist (aget vhdl-entity-alist
＠＠ -15258,7 +15300,8 ＠＠
:group 'speedbar-faces)
(defface vhdl-speedbar-architecture-face
- '((((class color) (background light)) (:foreground "Blue"))
+ '(;(((min-colors 88) (class color) (background light)) (:foreground "Blue1")) ; Emacs 22
+ (((class color) (background light)) (:foreground "Blue"))
(((class color) (background dark)) (:foreground "LightSkyBlue")))
"Face used for displaying architecture names."
:group 'speedbar-faces)
＠＠ -15283,6 +15326,7 ＠＠
(defface vhdl-speedbar-instantiation-face
'((((class color) (background light)) (:foreground "Brown"))
+ ;(((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) ; Emacs 22
(((class color) (background dark)) (:foreground "Yellow")))
"Face used for displaying instantiation names."
:group 'speedbar-faces)
＠＠ -15300,7 +15344,9 ＠＠
:group 'speedbar-faces)
(defface vhdl-speedbar-architecture-selected-face
- '((((class color) (background light)) (:foreground "Blue" :underline t))
+ '(;(((min-colors 88) (class color) (background light)) ; Emacs 22
+ ; (:foreground "Blue1" :underline t))
+ (((class color) (background light)) (:foreground "Blue" :underline t))
(((class color) (background dark)) (:foreground "LightSkyBlue" :underline t)))
"Face used for displaying architecture names."
:group 'speedbar-faces)
＠＠ -15598,7 +15644,7 ＠＠
(cons constant-name
(if (match-string 1)
(or (aget generic-alist (match-string 2) t)
- (error (format "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)))
+ (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar generic-alist))))
(setq constant-alist (cons constant-entry constant-alist))
(setq constant-name (downcase constant-name))
＠＠ -15618,7 +15664,7 ＠＠
(setq signal-entry (cons signal-name
(if (match-string 1)
(or (aget port-alist (match-string 2) t)
- (error (format "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)))
+ (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar port-alist))))
(setq signal-alist (cons signal-entry signal-alist))
(setq signal-name (downcase signal-name))
＠＠ -16266,11 +16312,17 ＠＠
(compile (concat command " " options " " file-name)))
(vhdl-warning "Your project settings tell me not to compile this file"))))
+(defvar vhdl-make-target "all"
+ "Default target for `vhdl-make' command.")
+
(defun vhdl-make (&optional target)
"Call make command for compilation of all updated source files (requires
`Makefile'). Optional argument TARGET allows to compile the design
specified by a target."
(interactive)
+ (setq vhdl-make-target
+ (or target (read-from-minibuffer "Target: " vhdl-make-target
+ vhdl-minibuffer-local-map)))
(vhdl-compile-init)
(let* ((project (aget vhdl-project-alist vhdl-project))
(compiler (or (aget vhdl-compiler-alist vhdl-compiler)
＠＠ -16282,7 +16334,7 ＠＠
(error "ERROR: Compile directory does not exist: \"%s\"" default-directory))
;; run make
(compile (concat (if (equal command "") "make" command)
- " " options " " target))))
+ " " options " " vhdl-make-target))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Makefile generation
＠＠ -16946,26 +16998,26 ＠＠
(defun vhdl-doc-variable (variable)
"Display VARIABLE's documentation in *Help* buffer."
(interactive)
- (with-output-to-temp-buffer "*Help*"
+ (unless vhdl-xemacs
+ (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
+ (with-output-to-temp-buffer
+ (if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ (documentation-property variable 'variable-documentation))
- (unless vhdl-xemacs
- (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
- (save-excursion
- (set-buffer standard-output)
+ (with-current-buffer standard-output
(help-mode))
(print-help-return-message)))
(defun vhdl-doc-mode ()
"Display VHDL Mode documentation in *Help* buffer."
(interactive)
- (with-output-to-temp-buffer "*Help*"
+ (unless vhdl-xemacs
+ (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
+ (with-output-to-temp-buffer
+ (if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ mode-name)
(princ " mode:\n")
(princ (documentation 'vhdl-mode))
- (unless vhdl-xemacs
- (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
- (save-excursion
- (set-buffer standard-output)
+ (with-current-buffer standard-output
(help-mode))
(print-help-return-message)))
--
Jerry James, Assistant Professor james(a)xemacs.org
Computer Science Department http://www.cs.usu.edu/~jerry/
Utah State University
- 1 participants
- 1 comments