xemacs-cvs November 2005

xemacs-cvs@xemacs.org

1 participants
163 discussions

CVS update by stephent packages/unsupported/stephen/curl ... 19 years, 1 month

CVS Monitor

User: stephent Date: 05/11/26 17:43:54 Modified: packages/unsupported/stephen/curl curl-tests.el Log: Improve curl-tests.el. Revision Changes Path 1.2 +3 -0 XEmacs/packages/unsupported/stephen/curl/curl-tests.el Index: curl-tests.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/unsupported/stephen/curl/curl-tests.el,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- curl-tests.el 2005/11/26 16:01:10 1.1 +++ curl-tests.el 2005/11/26 16:43:54 1.2 ＠＠ -1,6 +1,9 ＠＠ ;; this file expects to be run from $blddir +;; it inserts the contents of the resources in the current buffer at point (require 'curl (expand-file-name "modules/curl/curl")) (setq handle (curl-make-url-handle "http://turnbull.sk.tsukuba.ac.jp/index.html")) +(curl-easy-perform handle) +;; reuse the handle (curl-easy-setopt "URL" "http://curl.haxx.se/doc/copyright.html" handle) (curl-easy-perform handle)

1 participants
0 comments

CVS update by stephent packages/unsupported/stephen/curl build.patch 19 years, 1 month

CVS Monitor

User: stephent Date: 05/11/26 17:33:19 Added: packages/unsupported/stephen/curl build.patch Log: Build infrastructure patch. Revision Changes Path 1.1 XEmacs/packages/unsupported/stephen/curl/build.patch Index: build.patch =================================================================== --- xft-integration/configure.ac Sun Nov 20 16:47:00 2005 +++ xemacs-git/configure.ac Thu Nov 24 00:09:47 2005 ＠＠ -833,6 +830,9 ＠＠ XE_MERGED_ARG([postgresql], AC_HELP_STRING([--with-postgresql],[Support the PostgreSQL RDBMS.]), [], []) +XE_MERGED_ARG([curl], + AC_HELP_STRING([--with-curl],[Support the libcurl API.]), + [], []) dnl XE_HELP_SUBSECTION([Mail options]) XE_KEYWORD_ARG([mail-locking], ＠＠ -3851,6 +3855,29 ＠＠ fi AC_SUBST(postgresql_libs) +dnl Configure libcurl +curl_libs='' +if test "$with_curl" = "yes"; then + AC_CHECKING([for cURL]) + AC_CHECK_PROG (have_curl_config, curl-config, yes, no) + if test "$have_curl_config" = "no"; then + with_curl=no + else + AC_DEFINE(HAVE_CURL) + XE_APPEND(`curl-config --cflags`, c_switch_site) + curl_libs=`curl-config --libs` + XE_APPEND(modules/curl, MAKE_SUBDIR) + need_modules_common=yes + if test "$enable_modules" = "yes"; then + XE_APPEND(modules/curl, INSTALL_ARCH_DEP_SUBDIR) + fi + fi + if test "$with_curl" != "yes"; then + XE_DIE([Cannot fulfil --with-curl, curl-config not found.]) + fi +fi +AC_SUBST(curl_libs) + dnl ---------------------- dnl Graphics libraries dnl ---------------------- ＠＠ -5376,7 +5386,7 ＠＠ if test "$enable_modules" = "yes"; then ld_libs_module= else - XE_SPACE(ld_libs_module, $ldap_libs $postgresql_libs $canna_libs) + XE_SPACE(ld_libs_module, $ldap_libs $postgresql_libs $canna_libs $curl_libs) fi XE_SPACE(CFLAGS, $CFLAGS) ＠＠ -5955,6 +5965,7 ＠＠ echo " - Using PostgreSQL header file: $libpq_fe_h_file" test "$with_postgresqlv7" = yes && echo " - Using PostgreSQL V7 bindings." fi +test "$with_curl" = yes && echo " Compiling in support for libcurl API." echo " Internationalization:" --- xft-integration/src/config.h.in Tue Nov 15 21:27:58 2005 +++ xemacs-git/src/config.h.in Mon Nov 21 00:55:33 2005 ＠＠ -539,6 +536,9 ＠＠ #undef HAVE_POSTGRESQLV7 /* main PostgreSQL header file */ #undef LIBPQ_FE_H_FILE + +/* Do we want libcurl support? */ +#undef HAVE_CURL /* Do you have the Xauth library present? This will add some extra functionality to gnuserv. */ --- xft-integration/src/Makefile.in.in Sun Nov 20 02:34:43 2005 +++ xemacs-git/src/Makefile.in.in Mon Nov 21 00:54:03 2005 ＠＠ -218,6 +218,10 ＠＠ postgresql_objs=$(BLDMODULES)/postgresql/postgresql.o #endif +#if defined(HAVE_CURL) && !defined(HAVE_SHLIB) +curl_objs=$(BLDMODULES)/curl/curl_api.o +#endif + #ifdef HAVE_WIN32_PROCESSES process_objs=process-nt.o #elif defined (HAVE_UNIX_PROCESSES) ＠＠ -269,7 +277,7 ＠＠ $(balloon_help_objs) blocktype.o buffer.o bytecode.o \ callint.o casefiddle.o casetab.o chartab.o \ $(clash_detection_objs) cmdloop.o cmds.o $(coding_system_objs) console.o \ - console-stream.o\ + console-stream.o $(curl_objs) \ data.o $(database_objs) $(debug_objs) device.o dired.o doc.o doprnt.o\ dynarr.o \ editfns.o elhash.o emacs.o emodules.o eval.o events.o\

1 participants
0 comments

CVS update by stephent packages/unsupported/stephen/curl README 19 years, 1 month

CVS Monitor

User: stephent Date: 05/11/26 17:04:25 Added: packages/unsupported/stephen/curl README Log: Project description. Revision Changes Path 1.1 XEmacs/packages/unsupported/stephen/curl/README Index: README =================================================================== XEmacs Lisp binding for libcurl =============================== libcurl is the library API for cURL. Documentation is available at http://curl.haxx.se/. This is primarily a C module, not a Lisp library. There is a Lisp library which initializes some data structures and requires the module; this structure will probably be changed in the future. The current version of the module exposes the libcurl "easy" interface via the following Lisp API. It adds one object type, "URL handle", and the functions and variables listed below. The naming scheme will seem a little odd. My intention is to unify a number of different URL handling implementations, probably including EFS, TRAMP and libneon, under the url-handle interface. The generic interface will use the url-handle-* namespace. The curl-* API provides low-level, library-specific functions. These functions are generally named after either a library API (eg, `curl-easy-perform' actually accesses the resource pointed to by the URL), or the generic API it implements (`curl-make-url-handle'). Currently there are no generic equivalents to the libcurl wrappers. This is intentional; I want to implement at least one more lowlevel API before starting to design the generic APIs. I do not have immediate plans to implement the libcurl "multi" and "shared" interfaces. It should be easy, and patches and suggestions are welcome. DEFUN ("url-handle-p", Furl_handle_p, 1, 1, 0, /* Return t if OBJECT is a URL_Handle connection. */ (object)) DEFUN ("url-handle-type", Furl_handle_type, 1, 1, 0, /* Return the type of URL-HANDLE, a symbol. */ (url_handle)) DEFUN ("url-handle-live-p", Furl_handle_live_p, 1, 1, 0, /* Return non-nil if URL_HANDLE is an active URL_HANDLE connection. */ (url_handle)) DEFUN ("url-handle-property-list", Furl_handle_host, 1, 1, 0, /* Return the property list of URL-HANDLE. */ (url_handle)) DEFUN ("curl-make-url-handle", Fcurl_make_url_handle, 1, 3, 0, /* Return a cURL handle for URL, wrapped in an url-handle. URL is a string, which must be a URI scheme known to cURL. URL is encoded according to optional argument CODESYS. (Of course cURL will URL-encode it before sending it off.) PLIST is a property list. These properties are set on the cURL handle. #### This interface may change to (&rest PLIST). */ (url, codesys, plist)) DEFUN ("curl-easy-setopt", Fcurl_easy_setopt, 3, 3, 0, /* Set OPTION to VALUE on curl url-handle HANDLE and return t. OPTION is a string denoting an option in `curl-option-hash-table'. VALUE must be of the appropriate type. HANDLE must be an url-handle object of type `curl'. A wrapper with some validation for libcurl's `curl_easy_setopt'. Errors without useful explanations probably mean `curl-option-hash-table' is corrupt. */ (option, value, handle)) DEFUN ("curl-easy-perform", Fcurl_easy_perform, 1, 2, 0, /* Read from the URL represented by HANDLE into BUFFER at point. Optional BUFFER defaults to the current buffer. Returns t. */ (handle, buffer)) DEFUN ("curl-easy-getinfo", Fcurl_easy_getinfo, 2, 2, 0, /* Return the value of ATTRIBUTE for HANDLE. ATTRIBUTE is a string denoting an attribute in `curl-info-hash-table'. HANDLE must be an url-handle object of type `curl'. A wrapper with some validation for libcurl's `curl_easy_getinfo'. Errors without useful explanations probably mean `curl-info-hash-table' is corrupt. */ (attribute, handle)) DEFVAR_LISP ("curl-option-hash-table", &Vcurl_option_hash_table /* Table of options available for `curl-easy-setopt'. Key are strings naming options. The option names are taken from enum CURLoption in <curl/curl.h>. They are all uppercase, and the "CURLOPT_" prefix is omitted. Values are lists containing a type symbol \(one of `long', `objectpoint', `functionpoint', and `off_t') and an integer, which is the option index. It is planned to add a list of Lisp types that can be converted to something that is useful for the option as the 3rd element of the value list. It is planned to add the leading comments as docstrings, to be the 4th element of the value list corresponding to each key. */ ); Vcurl_option_hash_table = Qnil; DEFVAR_LISP ("curl-info-hash-table", &Vcurl_info_hash_table /* Table of attributes accessible via `curl-easy-getinfo'. Keys are strings naming attributes. The attribute names are taken from enum CURLinfo in <curl/curl.h>. They are all uppercase, and the "CURLINFO_" prefix is omitted. Values are lists containing a type symbol (one of `long', `string', `double', and `list') and an integer, which is the attribute index. It is planned to add docstrings, to be the 3rd element of the value list corresponding to each key. */ ); Vcurl_info_hash_table = Qnil;

1 participants
0 comments

CVS update by stephent packages/unsupported/stephen/curl Makefile.in.in 19 years, 1 month

CVS Monitor

User: stephent Date: 05/11/26 17:01:13 Added: packages/unsupported/stephen/curl Makefile.in.in configure.ac curl-tests.el curl.el curl_api.c curl_api.h install-sh Log: Import curl module. Revision Changes Path 1.1 XEmacs/packages/unsupported/stephen/curl/Makefile.in.in Index: Makefile.in.in =================================================================== ## Makefile for the sample module in XEmacs. ## Copyright (C) 2002 Jerry James. ## 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 synched with FSF. ## This is more complicated than would normally be the case, as this makefile ## has been tailored to work both inside and independently of the XEmacs ## source tree, and to support both module and non-module building inside the ## source tree. ### Specialize this part for your module MODNAME=curl_api MODVER=0.0.1 MODTITLE="Interface to libcurl for XEmacs" LDFLAGS=＠LDFLAGS＠＠curl_libs＠ SRCS=$(MODNAME).c ### You should not need to modify anything below this line SHELL=/bin/sh RM=rm -f PROGNAME=＠PROGNAME＠ CFLAGS=＠CFLAGS＠ INSTALL=＠INSTALL＠ version=＠version＠ prefix=＠prefix＠ exec_prefix=＠exec_prefix＠ libdir=＠libdir＠ instvardir=＠instvardir＠ configuration=＠configuration＠ moduledir=＠moduledir＠ with_modules=＠with_modules＠ srcdir=＠srcdir＠ VPATH=＠srcdir＠ SRC_SRCS=$(SRCS:%=$(srcdir)/%) OBJS=$(SRCS:.c=.o) CC=＠MOD_CC＠ MODARCHDIR=＠MODARCHDIR＠ MAKE_DOCFILE=＠MAKE_DOCFILE＠ MODCFLAGS=＠MODCFLAGS＠ INSTALLPATH=＠INSTALLPATH＠ INSTALL_PROGRAM=＠MOD_INSTALL_PROGRAM＠ OBJECT_TO_BUILD=＠OBJECT_TO_BUILD＠ .PHONY: clean distclean install all: $(OBJECT_TO_BUILD) .c.o: $(CC) $(MODCFLAGS) -c $< $(MODNAME).ell: $(OBJS) $(MODNAME)_i.o $(CC) --mode=link --mod-output=$＠ $(OBJS) $(MODNAME)_i.o $(LDFLAGS) $(MODNAME)_i.c: $(SRCS) ELLMAKEDOC=$(MAKE_DOCFILE) $(CC) --mode=init --mod-output=$＠ \ --mod-name=$(MODNAME) --mod-version=$(MODVER) \ --mod-title=$(MODTITLE) $(SRC_SRCS) clean: $(RM) $(MODNAME).ell $(OBJS) $(MODNAME)_i.* *~ distclean: clean $(RM) Makefile config.* configure install: $(OBJECT_TO_BUILD) $(INSTALL_PROGRAM) $< $(INSTALLPATH) 1.1 XEmacs/packages/unsupported/stephen/curl/configure.ac Index: configure.ac =================================================================== # Process this file with autoconf to produce a configure script. # This is only used for independent module building. AC_INIT([libcurl API module], [1.0], [xemacs-beta(a)xemacs.org]) AC_PREREQ(2.53) AC_REVISION($Revision: 1.1 $) AC_COPYRIGHT([Configuration script for the curl_api module. Copyright (C) 2002 Jerry James. Copyright (C) 2005 Free Software Foundation, Inc. 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.]) AC_CONFIG_SRCDIR([curl_api.c]) AC_PROG_CC AC_PROG_INSTALL AC_SUBST(CFLAGS) AC_SUBST(LDFLAGS) # Find ELLCC AC_ARG_VAR([ELLCC], [The path to the ellcc module compiler]) AC_PATH_PROG([ELLCC], [ellcc], ["FAIL"]) AS_IF([test "$ELLCC" = "FAIL"], [AS_ERROR([Cannot find ellcc])]) # Insert autoconf macros here to find the headers, libraries, other # programs, etc. needed by your module. If other libraries will be linked # with your module, then after detecting them, use a line of this form last: AC_SUBST(sample_libs, "$LIBS") # This part should appear unchanged in every module configure.ac AC_SUBST(PROGNAME, "module") AC_SUBST(MOD_CC, "＠ELLCC＠") AC_SUBST(MODARCHDIR, "\$(shell ＠ELLCC＠ --mod-archdir)") AC_SUBST(MAKE_DOCFILE, "\$(MODARCHDIR)/make-docfile") AC_SUBST(MODCFLAGS, "\$(CFLAGS) --mode=compile --mod-output=\$＠ -I\$(MODARCHDIR)/include") AC_SUBST(INSTALLPATH, "\$(shell ＠ELLCC＠ --mod-site-location)") AC_SUBST(MOD_INSTALL_PROGRAM, "＠INSTALL_PROGRAM＠") AC_SUBST(OBJECT_TO_BUILD, "\$(MODNAME).ell") AC_CONFIG_FILES([Makefile.in Makefile]) AC_OUTPUT 1.1 XEmacs/packages/unsupported/stephen/curl/curl-tests.el Index: curl-tests.el =================================================================== ;; this file expects to be run from $blddir (require 'curl (expand-file-name "modules/curl/curl")) (setq handle (curl-make-url-handle "http://turnbull.sk.tsukuba.ac.jp/index.html")) (curl-easy-setopt "URL" "http://curl.haxx.se/doc/copyright.html" handle) (curl-easy-perform handle) 1.1 XEmacs/packages/unsupported/stephen/curl/curl.el Index: curl.el =================================================================== ;;; curl.el --- utilities for use with the curl_api module ;; Copyright (C) 2005 Stephen J. Turnbull <stephen(a)xemacs.org> ;; Copyright (C) 1998 - 2005, Daniel Stenberg, <daniel(a)haxx.se>, et al. ;; All rights reserved, except as expressly indicated below. ;; This program is not considered part of XEmacs. ;; You may use, copy, modify, and distribute this software under the terms ;; of the GNU General Public License, version 2 or later at your option. ;; Author: Stephen J. Turnbull <stephen(a)xemacs.org> ;; Creation-Date: 2005-11-24 (require 'curl-api "curl/curl_api") ;; Version information from the cURL I built the first version from. ;; This should be fixed to get the information at build time. (put 'curl-api 'libcurl-version "7.15.0") (put 'curl-api 'libcurl_version_major 7) (put 'curl-api 'libcurl_version_minor 15) (put 'curl-api 'libcurl_version_patch 0) ;; This is the numeric version of the libcurl version number, meant for easier ;; parsing and comparions by programs. The LIBCURL_VERSION_NUM define will ;; always follow this syntax: ;; 0xXXYYZZ ;; Where XX, YY and ZZ are the main version, release and patch numbers in ;; hexadecimal (using 8 bits each). All three numbers are always represented ;; using two digits. 1.2 would appear as "0x010200" while version 9.11.7 ;; appears as "0x090b07". ;; This 6-digit (24 bits) hexadecimal number does not show pre-release number, ;; and it is always a greater number in a more recent release. It makes ;; comparisons with greater than and less than work. ;; #define LIBCURL_VERSION_NUM ((LIBCURL_VERSION_MAJOR << 16) | \ ;; (LIBCURL_VERSION_MINOR << 8) | \ ;; LIBCURL_VERSION_PATCH) ;; **** various includes and system-specific conditional code omitted **** ;; struct curl_httppost { ;; struct curl_httppost *next; /* next entry in the list */ ;; char *name; /* pointer to allocated name */ ;; long namelength; /* length of name length */ ;; char *contents; /* pointer to allocated data contents */ ;; long contentslength; /* length of contents field */ ;; char *buffer; /* pointer to allocated buffer contents */ ;; long bufferlength; /* length of buffer field */ ;; char *contenttype; /* Content-Type */ ;; struct curl_slist* contentheader; /* list of extra headers for this form */ ;; struct curl_httppost *more; /* if one field name has more than one ;; file, this link should link to following ;; files */ ;; long flags; /* as defined below */ ;; #define HTTPPOST_FILENAME (1<<0) /* specified content is a file name */ ;; #define HTTPPOST_READFILE (1<<1) /* specified content is a file name */ ;; #define HTTPPOST_PTRNAME (1<<2) /* name is only stored pointer ;; do not free in formfree */ ;; #define HTTPPOST_PTRCONTENTS (1<<3) /* contents is only stored pointer ;; do not free in formfree */ ;; #define HTTPPOST_BUFFER (1<<4) /* upload file from buffer */ ;; #define HTTPPOST_PTRBUFFER (1<<5) /* upload file from pointer contents */ ;; ;; char *showfilename; /* The file name to show. If not set, the ;; actual file name will be used (if this ;; is a file part) */ ;; }; ;; ;; typedef int (*curl_progress_callback)(void *clientp, ;; double dltotal, ;; double dlnow, ;; double ultotal, ;; double ulnow); ;; ;; /* Tests have proven that 20K is a very bad buffer size for uploads on ;; Windows, while 16K for some odd reason performed a lot better. */ ;; #define CURL_MAX_WRITE_SIZE 16384 ;; ;; typedef size_t (*curl_write_callback)(char *buffer, ;; size_t size, ;; size_t nitems, ;; void *outstream); ;; ;; /* This is a return code for the read callback that, when returned, will ;; signal libcurl to immediately abort the current transfer. */ ;; #define CURL_READFUNC_ABORT 0x10000000 ;; typedef size_t (*curl_read_callback)(char *buffer, ;; size_t size, ;; size_t nitems, ;; void *instream); ;; ;; ;; #ifndef CURL_NO_OLDIES ;; /* not used since 7.10.8, will be removed in a future release */ ;; typedef int (*curl_passwd_callback)(void *clientp, ;; const char *prompt, ;; char *buffer, ;; int buflen); ;; #endif ;; ;; typedef enum { ;; CURLIOE_OK, /* I/O operation successful */ ;; CURLIOE_UNKNOWNCMD, /* command was unknown to callback */ ;; CURLIOE_FAILRESTART, /* failed to restart the read */ ;; CURLIOE_LAST /* never use */ ;; } curlioerr; ;; ;; typedef enum { ;; CURLIOCMD_NOP, /* no operation */ ;; CURLIOCMD_RESTARTREAD, /* restart the read stream from start */ ;; CURLIOCMD_LAST /* never use */ ;; } curliocmd; ;; ;; typedef curlioerr (*curl_ioctl_callback)(CURL *handle, ;; int cmd, ;; void *clientp); ;; ;; /* ;; * The following typedef's are signatures of malloc, free, realloc, strdup and ;; * calloc respectively. Function pointers of these types can be passed to the ;; * curl_global_init_mem() function to set user defined memory management ;; * callback routines. ;; */ ;; typedef void *(*curl_malloc_callback)(size_t size); ;; typedef void (*curl_free_callback)(void *ptr); ;; typedef void *(*curl_realloc_callback)(void *ptr, size_t size); ;; typedef char *(*curl_strdup_callback)(const char *str); ;; typedef void *(*curl_calloc_callback)(size_t nmemb, size_t size); ;; ;; /* the kind of data that is passed to information_callback*/ ;; typedef enum { ;; CURLINFO_TEXT = 0, ;; CURLINFO_HEADER_IN, /* 1 */ ;; CURLINFO_HEADER_OUT, /* 2 */ ;; CURLINFO_DATA_IN, /* 3 */ ;; CURLINFO_DATA_OUT, /* 4 */ ;; CURLINFO_SSL_DATA_IN, /* 5 */ ;; CURLINFO_SSL_DATA_OUT, /* 6 */ ;; CURLINFO_END ;; } curl_infotype; ;; ;; typedef int (*curl_debug_callback) ;; (CURL *handle, /* the handle/transfer this concerns */ ;; curl_infotype type, /* what kind of data */ ;; char *data, /* points to the data */ ;; size_t size, /* size of the data pointed to */ ;; void *userptr); /* whatever the user please */ ;; ;; /* All possible error codes from all sorts of curl functions. Future versions ;; may return other values, stay prepared. ;; ;; Always add new return codes last. Never *EVER* remove any. The return ;; codes must remain the same! ;; */ ;; ;; typedef enum { ;; CURLE_OK = 0, ;; CURLE_UNSUPPORTED_PROTOCOL, /* 1 */ ;; CURLE_FAILED_INIT, /* 2 */ ;; CURLE_URL_MALFORMAT, /* 3 */ ;; CURLE_URL_MALFORMAT_USER, /* 4 (NOT USED) */ ;; CURLE_COULDNT_RESOLVE_PROXY, /* 5 */ ;; CURLE_COULDNT_RESOLVE_HOST, /* 6 */ ;; CURLE_COULDNT_CONNECT, /* 7 */ ;; CURLE_FTP_WEIRD_SERVER_REPLY, /* 8 */ ;; CURLE_FTP_ACCESS_DENIED, /* 9 a service was denied by the FTP server ;; due to lack of access - when login fails ;; this is not returned. */ ;; CURLE_FTP_USER_PASSWORD_INCORRECT, /* 10 */ ;; CURLE_FTP_WEIRD_PASS_REPLY, /* 11 */ ;; CURLE_FTP_WEIRD_USER_REPLY, /* 12 */ ;; CURLE_FTP_WEIRD_PASV_REPLY, /* 13 */ ;; CURLE_FTP_WEIRD_227_FORMAT, /* 14 */ ;; CURLE_FTP_CANT_GET_HOST, /* 15 */ ;; CURLE_FTP_CANT_RECONNECT, /* 16 */ ;; CURLE_FTP_COULDNT_SET_BINARY, /* 17 */ ;; CURLE_PARTIAL_FILE, /* 18 */ ;; CURLE_FTP_COULDNT_RETR_FILE, /* 19 */ ;; CURLE_FTP_WRITE_ERROR, /* 20 */ ;; CURLE_FTP_QUOTE_ERROR, /* 21 */ ;; CURLE_HTTP_RETURNED_ERROR, /* 22 */ ;; CURLE_WRITE_ERROR, /* 23 */ ;; CURLE_MALFORMAT_USER, /* 24 - NOT USED */ ;; CURLE_FTP_COULDNT_STOR_FILE, /* 25 - failed FTP upload */ ;; CURLE_READ_ERROR, /* 26 - could open/read from file */ ;; CURLE_OUT_OF_MEMORY, /* 27 */ ;; CURLE_OPERATION_TIMEOUTED, /* 28 - the timeout time was reached */ ;; CURLE_FTP_COULDNT_SET_ASCII, /* 29 - TYPE A failed */ ;; CURLE_FTP_PORT_FAILED, /* 30 - FTP PORT operation failed */ ;; CURLE_FTP_COULDNT_USE_REST, /* 31 - the REST command failed */ ;; CURLE_FTP_COULDNT_GET_SIZE, /* 32 - the SIZE command failed */ ;; CURLE_HTTP_RANGE_ERROR, /* 33 - RANGE "command" didn't work */ ;; CURLE_HTTP_POST_ERROR, /* 34 */ ;; CURLE_SSL_CONNECT_ERROR, /* 35 - wrong when connecting with SSL */ ;; CURLE_BAD_DOWNLOAD_RESUME, /* 36 - couldn't resume download */ ;; CURLE_FILE_COULDNT_READ_FILE, /* 37 */ ;; CURLE_LDAP_CANNOT_BIND, /* 38 */ ;; CURLE_LDAP_SEARCH_FAILED, /* 39 */ ;; CURLE_LIBRARY_NOT_FOUND, /* 40 */ ;; CURLE_FUNCTION_NOT_FOUND, /* 41 */ ;; CURLE_ABORTED_BY_CALLBACK, /* 42 */ ;; CURLE_BAD_FUNCTION_ARGUMENT, /* 43 */ ;; CURLE_BAD_CALLING_ORDER, /* 44 - NOT USED */ ;; CURLE_INTERFACE_FAILED, /* 45 - CURLOPT_INTERFACE failed */ ;; CURLE_BAD_PASSWORD_ENTERED, /* 46 - NOT USED */ ;; CURLE_TOO_MANY_REDIRECTS , /* 47 - catch endless re-direct loops */ ;; CURLE_UNKNOWN_TELNET_OPTION, /* 48 - User specified an unknown option */ ;; CURLE_TELNET_OPTION_SYNTAX , /* 49 - Malformed telnet option */ ;; CURLE_OBSOLETE, /* 50 - NOT USED */ ;; CURLE_SSL_PEER_CERTIFICATE, /* 51 - peer's certificate wasn't ok */ ;; CURLE_GOT_NOTHING, /* 52 - when this is a specific error */ ;; CURLE_SSL_ENGINE_NOTFOUND, /* 53 - SSL crypto engine not found */ ;; CURLE_SSL_ENGINE_SETFAILED, /* 54 - can not set SSL crypto engine as ;; default */ ;; CURLE_SEND_ERROR, /* 55 - failed sending network data */ ;; CURLE_RECV_ERROR, /* 56 - failure in receiving network data */ ;; CURLE_SHARE_IN_USE, /* 57 - share is in use */ ;; CURLE_SSL_CERTPROBLEM, /* 58 - problem with the local certificate */ ;; CURLE_SSL_CIPHER, /* 59 - couldn't use specified cipher */ ;; CURLE_SSL_CACERT, /* 60 - problem with the CA cert (path?) */ ;; CURLE_BAD_CONTENT_ENCODING, /* 61 - Unrecognized transfer encoding */ ;; CURLE_LDAP_INVALID_URL, /* 62 - Invalid LDAP URL */ ;; CURLE_FILESIZE_EXCEEDED, /* 63 - Maximum file size exceeded */ ;; CURLE_FTP_SSL_FAILED, /* 64 - Requested FTP SSL level failed */ ;; CURLE_SEND_FAIL_REWIND, /* 65 - Sending the data requires a rewind ;; that failed */ ;; CURLE_SSL_ENGINE_INITFAILED, /* 66 - failed to initialise ENGINE */ ;; CURLE_LOGIN_DENIED, /* 67 - user, password or similar was not ;; accepted and we failed to login */ ;; CURLE_TFTP_NOTFOUND, /* 68 - file not found on server */ ;; CURLE_TFTP_PERM, /* 69 - permission problem on server */ ;; CURLE_TFTP_DISKFULL, /* 70 - out of disk space on server */ ;; CURLE_TFTP_ILLEGAL, /* 71 - Illegal TFTP operation */ ;; CURLE_TFTP_UNKNOWNID, /* 72 - Unknown transfer ID */ ;; CURLE_TFTP_EXISTS, /* 73 - File already exists */ ;; CURLE_TFTP_NOSUCHUSER, /* 74 - No such user */ ;; CURL_LAST /* never use! */ ;; } CURLcode; ;; ;; typedef CURLcode (*curl_ssl_ctx_callback)(CURL *curl, /* easy handle */ ;; void *ssl_ctx, /* actually an ;; OpenSSL SSL_CTX */ ;; void *userptr); ;; ;; /* Make a spelling correction for the operation timed-out define */ ;; #define CURLE_OPERATION_TIMEDOUT CURLE_OPERATION_TIMEOUTED ;; ;; #ifndef CURL_NO_OLDIES /* define this to test if your app builds with all ;; the obsolete stuff removed! */ ;; /* backwards compatibility with older names */ ;; #define CURLE_HTTP_NOT_FOUND CURLE_HTTP_RETURNED_ERROR ;; #define CURLE_HTTP_PORT_FAILED CURLE_INTERFACE_FAILED ;; #endif ;; ;; typedef enum { ;; CURLPROXY_HTTP = 0, ;; CURLPROXY_SOCKS4 = 4, ;; CURLPROXY_SOCKS5 = 5 ;; } curl_proxytype; ;; ;; #define CURLAUTH_NONE 0 /* nothing */ ;; #define CURLAUTH_BASIC (1<<0) /* Basic (default) */ ;; #define CURLAUTH_DIGEST (1<<1) /* Digest */ ;; #define CURLAUTH_GSSNEGOTIATE (1<<2) /* GSS-Negotiate */ ;; #define CURLAUTH_NTLM (1<<3) /* NTLM */ ;; #define CURLAUTH_ANY ~0 /* all types set */ ;; #define CURLAUTH_ANYSAFE (~CURLAUTH_BASIC) ;; ;; #ifndef CURL_NO_OLDIES /* define this to test if your app builds with all ;; the obsolete stuff removed! */ ;; /* this was the error code 50 in 7.7.3 and a few earlier versions, this ;; is no longer used by libcurl but is instead #defined here only to not ;; make programs break */ ;; #define CURLE_ALREADY_COMPLETE 99999 ;; ;; /* These are just to make older programs not break: */ ;; #define CURLE_FTP_PARTIAL_FILE CURLE_PARTIAL_FILE ;; #define CURLE_FTP_BAD_DOWNLOAD_RESUME CURLE_BAD_DOWNLOAD_RESUME ;; #endif ;; ;; #define CURL_ERROR_SIZE 256 ;; ;; /* parameter for the CURLOPT_FTP_SSL option */ ;; typedef enum { ;; CURLFTPSSL_NONE, /* do not attempt to use SSL */ ;; CURLFTPSSL_TRY, /* try using SSL, proceed anyway otherwise */ ;; CURLFTPSSL_CONTROL, /* SSL for the control connection or fail */ ;; CURLFTPSSL_ALL, /* SSL for all communication or fail */ ;; CURLFTPSSL_LAST /* not an option, never use */ ;; } curl_ftpssl; ;; ;; /* parameter for the CURLOPT_FTPSSLAUTH option */ ;; typedef enum { ;; CURLFTPAUTH_DEFAULT, /* let libcurl decide */ ;; CURLFTPAUTH_SSL, /* use "AUTH SSL" */ ;; CURLFTPAUTH_TLS, /* use "AUTH TLS" */ ;; CURLFTPAUTH_LAST /* not an option, never use */ ;; } curl_ftpauth; ;; ;; /* long may be 32 or 64 bits, but we should never depend on anything else ;; but 32 */ ;; #define CURLOPTTYPE_LONG 0 ;; #define CURLOPTTYPE_OBJECTPOINT 10000 ;; #define CURLOPTTYPE_FUNCTIONPOINT 20000 ;; #define CURLOPTTYPE_OFF_T 30000 ;; ;; /* name is uppercase CURLOPT_<name>, ;; type is one of the defined CURLOPTTYPE_<type> ;; number is unique identifier */ ;; #ifdef CINIT ;; #undef CINIT ;; #endif ;; /* ;; * Figure out if we can use the ## operator, which is supported by ISO/ANSI C ;; * and C++. Some compilers support it without setting __STDC__ or __cplusplus ;; * so we need to carefully check for them too. We don't use configure-checks ;; * for these since we want these headers to remain generic and working for all ;; * platforms. ;; */ ;; #if defined(__STDC__) || defined(_MSC_VER) || defined(__cplusplus) || \ ;; defined(__HP_aCC) || defined(__BORLANDC__) || defined(__LCC__) ;; /* This compiler is believed to have an ISO compatible preprocessor */ ;; #define CURL_ISOCPP ;; #else ;; /* This compiler is believed NOT to have an ISO compatible preprocessor */ ;; #undef CURL_ISOCPP ;; #endif ;; ;; #ifdef CURL_ISOCPP ;; #define CINIT(name,type,number) CURLOPT_ ## name = CURLOPTTYPE_ ## type + number ;; #else ;; /* The macro "##" is ISO C, we assume pre-ISO C doesn't support it. */ ;; #define LONG CURLOPTTYPE_LONG ;; #define OBJECTPOINT CURLOPTTYPE_OBJECTPOINT ;; #define FUNCTIONPOINT CURLOPTTYPE_FUNCTIONPOINT ;; #define OFF_T CURLOPTTYPE_OFF_T ;; #define CINIT(name,type,number) CURLOPT_/**/name = type + number ;; #endif ;; ;; These are the options that can be used in curl-easy-setopt. ;; #### Probably should adapt this to the method below for ;; `curl-info-hash-table'. ;; Actually, probably should make the names symbols and put them in C, ;; but that's another story. (unless (and (boundp 'curl-option-hash-table) (hash-table-p curl-option-hash-table)) (setq curl-option-hash-table (make-hash-table :test #'equal :size 150)) ;; typedef enum { ;; This is the FILE * or void * the regular output should be written to. (puthash "FILE" '(objectpoint 1) curl-option-hash-table) ;; The full URL to get/put (puthash "URL" '(objectpoint 2) curl-option-hash-table) ;; Port number to connect to, if other than default. (puthash "PORT" '(long 3) curl-option-hash-table) ;; Name of proxy to use. (puthash "PROXY" '(objectpoint 4) curl-option-hash-table) ;; "name:password" to use when fetching. (puthash "USERPWD" '(objectpoint 5) curl-option-hash-table) ;; "name:password" to use with proxy. (puthash "PROXYUSERPWD" '(objectpoint 6) curl-option-hash-table) ;; Range to get, specified as an ASCII string. (puthash "RANGE" '(objectpoint 7) curl-option-hash-table) ;; not used ;; Specified file stream to upload from (use as input): (puthash "INFILE" '(objectpoint 9) curl-option-hash-table) ;; Buffer to receive error messages in, must be at least CURL_ERROR_SIZE ;; bytes big. If this is not used, error messages go to stderr instead: (puthash "ERRORBUFFER" '(objectpoint 10) curl-option-hash-table) ;; Function that will be called to store the output (instead of fwrite). The ;; parameters will use fwrite() syntax, make sure to follow them. (puthash "WRITEFUNCTION" '(functionpoint 11) curl-option-hash-table) ;; Function that will be called to read the input (instead of fread). The ;; parameters will use fread() syntax, make sure to follow them. (puthash "READFUNCTION" '(functionpoint 12) curl-option-hash-table) ;; Time-out the read operation after this amount of seconds (puthash "TIMEOUT" '(long 13) curl-option-hash-table) ;; If the CURLOPT_INFILE is used, this can be used to inform libcurl about ;; how large the file being sent really is. That allows better error ;; checking and better verifies that the upload was succcessful. -1 means ;; unknown size. ;; ;; For large file support, there is also a _LARGE version of the key ;; which takes an off_t type, allowing platforms with larger off_t ;; sizes to handle larger files. See below for INFILESIZE_LARGE. (puthash "INFILESIZE" '(long 14) curl-option-hash-table) ;; POST input fields. (puthash "POSTFIELDS" '(objectpoint 15) curl-option-hash-table) ;; Set the referer page (needed by some CGIs) (puthash "REFERER" '(objectpoint 16) curl-option-hash-table) ;; Set the FTP PORT string (interface name, named or numerical IP address) ;; Use i.e '-' to use default address. (puthash "FTPPORT" '(objectpoint 17) curl-option-hash-table) ;; Set the User-Agent string (examined by some CGIs) (puthash "USERAGENT" '(objectpoint 18) curl-option-hash-table) ;; If the download receives less than "low speed limit" bytes/second ;; during "low speed time" seconds, the operations is aborted. ;; You could i.e if you have a pretty high speed connection, abort if ;; it is less than 2000 bytes/sec during 20 seconds. ;; ;; Set the "low speed limit" (puthash "LOW_SPEED_LIMIT" '(long 19) curl-option-hash-table) ;; Set the "low speed time" (puthash "LOW_SPEED_TIME" '(long 20) curl-option-hash-table) ;; Set the continuation offset. ;; ;; Note there is also a _LARGE version of this key which uses ;; off_t types, allowing for large file offsets on platforms which ;; use larger-than-32-bit off_t's. Look below for RESUME_FROM_LARGE. (puthash "RESUME_FROM" '(long 21) curl-option-hash-table) ;; Set cookie in request: (puthash "COOKIE" '(objectpoint 22) curl-option-hash-table) ;; This points to a linked list of headers, struct curl_slist kind (puthash "HTTPHEADER" '(objectpoint 23) curl-option-hash-table) ;; This points to a linked list of post entries, struct HttpPost (puthash "HTTPPOST" '(objectpoint 24) curl-option-hash-table) ;; name of the file keeping your private SSL-certificate (puthash "SSLCERT" '(objectpoint 25) curl-option-hash-table) ;; password for the SSL-private key, keep this for compatibility (puthash "SSLCERTPASSWD" '(objectpoint 26) curl-option-hash-table) ;; password for the SSL private key (puthash "SSLKEYPASSWD" '(objectpoint 26) curl-option-hash-table) ;; send TYPE parameter? (puthash "CRLF" '(long 27) curl-option-hash-table) ;; send linked-list of QUOTE commands (puthash "QUOTE" '(objectpoint 28) curl-option-hash-table) ;; send FILE * or void * to store headers to, if you use a callback it ;; is simply passed to the callback unmodified (puthash "WRITEHEADER" '(objectpoint 29) curl-option-hash-table) ;; point to a file to read the initial cookies from, also enables ;; "cookie awareness" (puthash "COOKIEFILE" '(objectpoint 31) curl-option-hash-table) ;; What version to specifly try to use. ;; See CURL_SSLVERSION defines below. (puthash "SSLVERSION" '(long 32) curl-option-hash-table) ;; What kind of HTTP time condition to use, see defines (puthash "TIMECONDITION" '(long 33) curl-option-hash-table) ;; Time to use with the above condition. Specified in number of seconds ;; since 1 Jan 1970 (puthash "TIMEVALUE" '(long 34) curl-option-hash-table) ;; 35 = OBSOLETE ;; Custom request, for customizing the get command like ;; HTTP: DELETE, TRACE and others ;; FTP: to use a different list command (puthash "CUSTOMREQUEST" '(objectpoint 36) curl-option-hash-table) ;; HTTP request, for odd commands like DELETE, TRACE and others (puthash "STDERR" '(objectpoint 37) curl-option-hash-table) ;; 38 is not used ;; send linked-list of post-transfer QUOTE commands (puthash "POSTQUOTE" '(objectpoint 39) curl-option-hash-table) ;; Pass a pointer to string of the output using full variable-replacement ;; as described elsewhere. (puthash "WRITEINFO" '(objectpoint 40) curl-option-hash-table) ;; talk a lot (puthash "VERBOSE" '(long 41) curl-option-hash-table) ;; throw the header out too (puthash "HEADER" '(long 42) curl-option-hash-table) ;; shut off the progress meter (puthash "NOPROGRESS" '(long 43) curl-option-hash-table) ;; use HEAD to get http document (puthash "NOBODY" '(long 44) curl-option-hash-table) ;; no output on http error codes >= 300 (puthash "FAILONERROR" '(long 45) curl-option-hash-table) ;; this is an upload (puthash "UPLOAD" '(long 46) curl-option-hash-table) ;; HTTP POST method (puthash "POST" '(long 47) curl-option-hash-table) ;; Use NLST when listing ftp dir (puthash "FTPLISTONLY" '(long 48) curl-option-hash-table) ;; Append instead of overwrite on upload! (puthash "FTPAPPEND" '(long 50) curl-option-hash-table) ;; Specify whether to read the user+password from the .netrc or the URL. ;; This must be one of the CURL_NETRC_* enums below. (puthash "NETRC" '(long 51) curl-option-hash-table) ;; use Location: Luke! (puthash "FOLLOWLOCATION" '(LONG 52) curl-option-hash-table) ;;transfer data in text/ASCII format (puthash "TRANSFERTEXT" '(LONG 53) curl-option-hash-table) ;; HTTP PUT (puthash "PUT" '(LONG 54) curl-option-hash-table) ;; 55 = OBSOLETE ;; Function that will be called instead of the internal progress display ;; function. This function should be defined as the curl_progress_callback ;; prototype defines. (puthash "PROGRESSFUNCTION" '(functionpoint 56) curl-option-hash-table) ;; Data passed to the progress callback (puthash "PROGRESSDATA" '(objectpoint 57) curl-option-hash-table) ;; We want the referer field set automatically when following locations (puthash "AUTOREFERER" '(long 58) curl-option-hash-table) ;; Port of the proxy, can be set in the proxy string as well with: ;; "[host]:[port]" (puthash "PROXYPORT" '(long 59) curl-option-hash-table) ;; size of the POST input data, if strlen() is not good to use (puthash "POSTFIELDSIZE" '(long 60) curl-option-hash-table) ;; tunnel non-http operations through a HTTP proxy (puthash "HTTPPROXYTUNNEL" '(long 61) curl-option-hash-table) ;; Set the interface string to use as outgoing network interface (puthash "INTERFACE" '(objectpoint 62) curl-option-hash-table) ;; Set the krb4 security level, this also enables krb4 awareness. This is a ;; string, 'clear', 'safe', 'confidential' or 'private'. If the string is ;; set but doesn't match one of these, 'private' will be used. (puthash "KRB4LEVEL" '(objectpoint 63) curl-option-hash-table) ;; Set if we should verify the peer in ssl handshake, set 1 to verify. (puthash "SSL_VERIFYPEER" '(long 64) curl-option-hash-table) ;; The CApath or CAfile used to validate the peer certificate ;; this option is used only if SSL_VERIFYPEER is true (puthash "CAINFO" '(objectpoint 65) curl-option-hash-table) ;; 66 = OBSOLETE ;; 67 = OBSOLETE ;; Maximum number of http redirects to follow (puthash "MAXREDIRS" '(long 68) curl-option-hash-table) ;; Pass a long set to 1 to get the date of the requested document (if ;; possible)! Pass a zero to shut it off. (puthash "FILETIME" '(long 69) curl-option-hash-table) ;; This points to a linked list of telnet options (puthash "TELNETOPTIONS" '(objectpoint 70) curl-option-hash-table) ;; Max amount of cached alive connections (puthash "MAXCONNECTS" '(long 71) curl-option-hash-table) ;; What policy to use when closing connections when the cache is filled ;; up (puthash "CLOSEPOLICY" '(long 72) curl-option-hash-table) ;; 73 = OBSOLETE ;; Set to explicitly use a new connection for the upcoming transfer. ;; Do not use this unless you're absolutely sure of this, as it makes the ;; operation slower and is less friendly for the network. (puthash "FRESH_CONNECT" '(long 74) curl-option-hash-table) ;; Set to explicitly forbid the upcoming transfer's connection to be re-used ;; when done. Do not use this unless you're absolutely sure of this, as it ;; makes the operation slower and is less friendly for the network. (puthash "FORBID_REUSE" '(long 75) curl-option-hash-table) ;; Set to a file name that contains random data for libcurl to use to ;; seed the random engine when doing SSL connects. (puthash "RANDOM_FILE" '(objectpoint 76) curl-option-hash-table) ;; Set to the Entropy Gathering Daemon socket pathname (puthash "EGDSOCKET" '(objectpoint 77) curl-option-hash-table) ;; Time-out connect operations after this amount of seconds, if connects ;; are OK within this time, then fine... This only aborts the connect ;; phase. [Only works on unix-style/SIGALRM operating systems] (puthash "CONNECTTIMEOUT" '(long 78) curl-option-hash-table) ;; Function that will be called to store headers (instead of fwrite). The ;; parameters will use fwrite() syntax, make sure to follow them. (puthash "HEADERFUNCTION" '(functionpoint 79) curl-option-hash-table) ;; Set this to force the HTTP request to get back to GET. Only really usable ;; if POST, PUT or a custom request have been used first. (puthash "HTTPGET" '(long 80) curl-option-hash-table) ;; Set if we should verify the Common name from the peer certificate in ssl ;; handshake, set 1 to check existence, 2 to ensure that it matches the ;; provided hostname. (puthash "SSL_VERIFYHOST" '(long 81) curl-option-hash-table) ;; Specify which file name to write all known cookies in after completed ;; operation. Set file name to "-" (dash) to make it go to stdout. (puthash "COOKIEJAR" '(objectpoint 82) curl-option-hash-table) ;; Specify which SSL ciphers to use (puthash "SSL_CIPHER_LIST" '(objectpoint 83) curl-option-hash-table) ;; Specify which HTTP version to use! This must be set to one of the ;; CURL_HTTP_VERSION* enums set below. (puthash "HTTP_VERSION" '(long 84) curl-option-hash-table) ;; Specificly switch on or off the FTP engine's use of the EPSV command. By ;; default, that one will always be attempted before the more traditional ;; PASV command. (puthash "FTP_USE_EPSV" '(long 85) curl-option-hash-table) ;; type of the file keeping your SSL-certificate ("DER", "PEM", "ENG") (puthash "SSLCERTTYPE" '(objectpoint 86) curl-option-hash-table) ;; name of the file keeping your private SSL-key (puthash "SSLKEY" '(objectpoint 87) curl-option-hash-table) ;; type of the file keeping your private SSL-key ("DER", "PEM", "ENG") (puthash "SSLKEYTYPE" '(objectpoint 88) curl-option-hash-table) ;; crypto engine for the SSL-sub system (puthash "SSLENGINE" '(objectpoint 89) curl-option-hash-table) ;; set the crypto engine for the SSL-sub system as default ;; the param has no meaning... (puthash "SSLENGINE_DEFAULT" '(long 90) curl-option-hash-table) ;; Non-zero value means to use the global dns cache (puthash "DNS_USE_GLOBAL_CACHE" '(long 91) curl-option-hash-table) ;; DNS cache timeout (puthash "DNS_CACHE_TIMEOUT" '(long 92) curl-option-hash-table) ;; send linked-list of pre-transfer QUOTE commands (Wesley Laxton)*/ (puthash "PREQUOTE" '(objectpoint 93) curl-option-hash-table) ;; set the debug function (puthash "DEBUGFUNCTION" '(functionpoint 94) curl-option-hash-table) ;; set the data for the debug function (puthash "DEBUGDATA" '(objectpoint 95) curl-option-hash-table) ;; mark this as start of a cookie session (puthash "COOKIESESSION" '(long 96) curl-option-hash-table) ;; The CApath directory used to validate the peer certificate ;; this option is used only if SSL_VERIFYPEER is true (puthash "CAPATH" '(objectpoint 97) curl-option-hash-table) ;; Instruct libcurl to use a smaller receive buffer (puthash "BUFFERSIZE" '(long 98) curl-option-hash-table) ;; Instruct libcurl to not use any signal/alarm handlers, even when using ;; timeouts. This option is useful for multi-threaded applications. ;; See libcurl-the-guide for more background information. (puthash "NOSIGNAL" '(long 99) curl-option-hash-table) ;; Provide a CURLShare for mutexing non-ts data (puthash "SHARE" '(objectpoint 100) curl-option-hash-table) ;; indicates type of proxy. accepted values are CURLPROXY_HTTP (default), ;; CURLPROXY_SOCKS4 and CURLPROXY_SOCKS5. (puthash "PROXYTYPE" '(long 101) curl-option-hash-table) ;; Set the Accept-Encoding string. Use this to tell a server you would like ;; the response to be compressed. (puthash "ENCODING" '(objectpoint 102) curl-option-hash-table) ;; Set pointer to private data (puthash "PRIVATE" '(objectpoint 103) curl-option-hash-table) ;; Set aliases for HTTP 200 in the HTTP Response header (puthash "HTTP200ALIASES" '(objectpoint 104) curl-option-hash-table) ;; Continue to send authentication (user+password) when following locations, ;; even when hostname changed. This can potentionally send off the name ;; and password to whatever host the server decides. (puthash "UNRESTRICTED_AUTH" '(long 105) curl-option-hash-table) ;; Specificly switch on or off the FTP engine's use of the EPRT command ( it ;; also disables the LPRT attempt). By default, those ones will always be ;; attempted before the good old traditional PORT command. (puthash "FTP_USE_EPRT" '(long 106) curl-option-hash-table) ;; Set this to a bitmask value to enable the particular authentications ;; methods you like. Use this in combination with CURLOPT_USERPWD. ;; Note that setting multiple bits may cause extra network round-trips. (puthash "HTTPAUTH" '(long 107) curl-option-hash-table) ;; Set the ssl context callback function, currently only for OpenSSL ssl_ctx ;; in second argument. The function must be matching the ;; curl_ssl_ctx_callback proto. (puthash "SSL_CTX_FUNCTION" '(functionpoint 108) curl-option-hash-table) ;; Set the userdata for the ssl context callback function's third ;; argument (puthash "SSL_CTX_DATA" '(objectpoint 109) curl-option-hash-table) ;; FTP Option that causes missing dirs to be created on the remote server (puthash "FTP_CREATE_MISSING_DIRS" '(long 110) curl-option-hash-table) ;; Set this to a bitmask value to enable the particular authentications ;; methods you like. Use this in combination with CURLOPT_PROXYUSERPWD. ;; Note that setting multiple bits may cause extra network round-trips. (puthash "PROXYAUTH" '(long 111) curl-option-hash-table) ;; FTP option that changes the timeout, in seconds, associated with ;; getting a response. This is different from transfer timeout time and ;; essentially places a demand on the FTP server to acknowledge commands ;; in a timely manner. (puthash "FTP_RESPONSE_TIMEOUT" '(long 112) curl-option-hash-table) ;; Set this option to one of the CURL_IPRESOLVE_* defines (see below) to ;; tell libcurl to resolve names to those IP versions only. This only has ;; affect on systems with support for more than one, i.e IPv4 _and_ IPv6. (puthash "IPRESOLVE" '(long 113) curl-option-hash-table) ;; Set this option to limit the size of a file that will be downloaded from ;; an HTTP or FTP server. ;; Note there is also _LARGE version which adds large file support for ;; platforms which have larger off_t sizes. See MAXFILESIZE_LARGE below. (puthash "MAXFILESIZE" '(long 114) curl-option-hash-table) ;; See the comment for INFILESIZE above, but in short, specifies ;; the size of the file being uploaded. -1 means unknown. (puthash "INFILESIZE_LARGE" '(off_t 115) curl-option-hash-table) ;; Sets the continuation offset. There is also a LONG version of this; ;; look above for RESUME_FROM. (puthash "RESUME_FROM_LARGE" '(off_t 116) curl-option-hash-table) ;; Sets the maximum size of data that will be downloaded from ;; an HTTP or FTP server. See MAXFILESIZE above for the LONG version. (puthash "MAXFILESIZE_LARGE" '(off_t 117) curl-option-hash-table) ;; Set this option to the file name of your .netrc file you want libcurl ;; to parse (using the CURLOPT_NETRC option). If not set, libcurl will do ;; a poor attempt to find the user's home directory and check for a .netrc ;; file in there. (puthash "NETRC_FILE" '(objectpoint 118) curl-option-hash-table) ;; Enable SSL/TLS for FTP, pick one of: ;; CURLFTPSSL_TRY - try using SSL, proceed anyway otherwise ;; CURLFTPSSL_CONTROL - SSL for the control connection or fail ;; CURLFTPSSL_ALL - SSL for all communication or fail (puthash "FTP_SSL" '(long 119) curl-option-hash-table) ;; The _LARGE version of the standard POSTFIELDSIZE option (puthash "POSTFIELDSIZE_LARGE" '(off_t 120) curl-option-hash-table) ;; Enable/disable the TCP Nagle algorithm (puthash "TCP_NODELAY" '(long 121) curl-option-hash-table) ;; 122 OBSOLETE, used in 7.12.3. Gone in 7.13.0 ;; When doing 3rd party transfer, set the source user and password with ;; this (puthash "SOURCE_USERPWD" '(objectpoint 123) curl-option-hash-table) ;; 124 OBSOLETE, used in 7.12.3. Gone in 7.13.0 ;; 125 OBSOLETE, used in 7.12.3. Gone in 7.13.0 ;; 126 OBSOLETE, used in 7.12.3. Gone in 7.13.0 ;; When doing 3rd party transfer, set the source pre-quote linked list ;; of commands with this (puthash "SOURCE_PREQUOTE" '(objectpoint 127) curl-option-hash-table) ;; When doing 3rd party transfer, set the source post-quote linked list ;; of commands with this (puthash "SOURCE_POSTQUOTE" '(objectpoint 128) curl-option-hash-table) ;; When FTP over SSL/TLS is selected (with CURLOPT_FTP_SSL), this option ;; can be used to change libcurl's default action which is to first try ;; "AUTH SSL" and then "AUTH TLS" in this order, and proceed when a OK ;; response has been received. ;; Available parameters are: ;; CURLFTPAUTH_DEFAULT - let libcurl decide ;; CURLFTPAUTH_SSL - try "AUTH SSL" first, then TLS ;; CURLFTPAUTH_TLS - try "AUTH TLS" first, then SSL (puthash "FTPSSLAUTH" '(long 129) curl-option-hash-table) (puthash "IOCTLFUNCTION" '(functionpoint 130) curl-option-hash-table) (puthash "IOCTLDATA" '(objectpoint 131) curl-option-hash-table) ;; To make a 3rd party transfer, set the source URL with this (puthash "SOURCE_URL" '(objectpoint 132) curl-option-hash-table) ;; When doing 3rd party transfer, set the source quote linked list of ;; commands with this (puthash "SOURCE_QUOTE" '(objectpoint 133) curl-option-hash-table) ;; zero terminated string for pass on to the FTP server when asked for ;; "account" info (puthash "FTP_ACCOUNT" '(objectpoint 134) curl-option-hash-table) ;; feed cookies into cookie engine (puthash "COOKIELIST" '(objectpoint 135) curl-option-hash-table) ;; ignore Content-Length (puthash "IGNORE_CONTENT_LENGTH" '(long 136) curl-option-hash-table) ;; Set to non-zero to skip the IP address received in a 227 PASV FTP server ;; response. Typically used for FTP-SSL purposes but is not restricted to ;; that. libcurl will then instead use the same IP address it used for the ;; control connection. (puthash "FTP_SKIP_PASV_IP" '(long 137) curl-option-hash-table) ;; CURLOPT_LASTENTRY ; the last unused ;; } CURLoption; ) ;; /* Below here follows defines for the CURLOPT_IPRESOLVE option. If a host ;; name resolves addresses using more than one IP protocol version, this ;; option might be handy to force libcurl to use a specific IP version. */ ;; #define CURL_IPRESOLVE_WHATEVER 0 /* default, resolves addresses to all IP ;; versions that your system allows */ ;; #define CURL_IPRESOLVE_V4 1 /* resolve to ipv4 addresses */ ;; #define CURL_IPRESOLVE_V6 2 /* resolve to ipv6 addresses */ ;; ;; /* three convenient "aliases" that follow the name scheme better */ ;; #define CURLOPT_WRITEDATA CURLOPT_FILE ;; #define CURLOPT_READDATA CURLOPT_INFILE ;; #define CURLOPT_HEADERDATA CURLOPT_WRITEHEADER ;; ;; #ifndef CURL_NO_OLDIES /* define this to test if your app builds with all ;; the obsolete stuff removed! */ ;; #define CURLOPT_HTTPREQUEST -1 ;; #define CURLOPT_FTPASCII CURLOPT_TRANSFERTEXT ;; #define CURLOPT_MUTE -2 ;; #define CURLOPT_PASSWDFUNCTION -3 ;; #define CURLOPT_PASSWDDATA -4 ;; #define CURLOPT_CLOSEFUNCTION -5 ;; ;; #define CURLOPT_SOURCE_HOST -6 ;; #define CURLOPT_SOURCE_PATH -7 ;; #define CURLOPT_SOURCE_PORT -8 ;; #define CURLOPT_PASV_HOST -9 ;; ;; #else ;; /* This is set if CURL_NO_OLDIES is defined at compile-time */ ;; #undef CURLOPT_DNS_USE_GLOBAL_CACHE /* soon obsolete */ ;; #endif ;; ;; ;; /* These enums are for use with the CURLOPT_HTTP_VERSION option. */ ;; enum { ;; CURL_HTTP_VERSION_NONE, /* setting this means we don't care, and that we'd ;; like the library to choose the best possible ;; for us! */ ;; CURL_HTTP_VERSION_1_0, /* please use HTTP 1.0 in the request */ ;; CURL_HTTP_VERSION_1_1, /* please use HTTP 1.1 in the request */ ;; ;; CURL_HTTP_VERSION_LAST /* *ILLEGAL* http version */ ;; }; ;; ;; /* These enums are for use with the CURLOPT_NETRC option. */ ;; enum CURL_NETRC_OPTION { ;; CURL_NETRC_IGNORED, /* The .netrc will never be read. ;; * This is the default. */ ;; CURL_NETRC_OPTIONAL, /* A user:password in the URL will be preferred ;; * to one in the .netrc. */ ;; CURL_NETRC_REQUIRED, /* A user:password in the URL will be ignored. ;; * Unless one is set programmatically, the .netrc ;; * will be queried. */ ;; CURL_NETRC_LAST ;; }; ;; ;; enum { ;; CURL_SSLVERSION_DEFAULT, ;; CURL_SSLVERSION_TLSv1, ;; CURL_SSLVERSION_SSLv2, ;; CURL_SSLVERSION_SSLv3, ;; ;; CURL_SSLVERSION_LAST /* never use, keep last */ ;; }; ;; ;; ;; typedef enum { ;; CURL_TIMECOND_NONE, ;; ;; CURL_TIMECOND_IFMODSINCE, ;; CURL_TIMECOND_IFUNMODSINCE, ;; CURL_TIMECOND_LASTMOD, ;; ;; CURL_TIMECOND_LAST ;; } curl_TimeCond; ;; ;; #ifdef __BEOS__ ;; #include <support/SupportDefs.h> ;; #endif ;; ;; ;; /* curl_strequal() and curl_strnequal() are subject for removal in a future ;; libcurl, see lib/README.curlx for details */ ;; CURL_EXTERN int (curl_strequal)(const char *s1, const char *s2); ;; CURL_EXTERN int (curl_strnequal)(const char *s1, const char *s2, size_t n); ;; ;; /* name is uppercase CURLFORM_<name> */ ;; #ifdef CFINIT ;; #undef CFINIT ;; #endif ;; ;; #ifdef CURL_ISOCPP ;; #define CFINIT(name) CURLFORM_ ## name ;; #else ;; /* The macro "##" is ISO C, we assume pre-ISO C doesn't support it. */ ;; #define CFINIT(name) CURLFORM_/**/name ;; #endif ;; ;; typedef enum { ;; CFINIT(NOTHING), /********* the first one is unused ************/ ;; ;; /* */ ;; CFINIT(COPYNAME), ;; CFINIT(PTRNAME), ;; CFINIT(NAMELENGTH), ;; CFINIT(COPYCONTENTS), ;; CFINIT(PTRCONTENTS), ;; CFINIT(CONTENTSLENGTH), ;; CFINIT(FILECONTENT), ;; CFINIT(ARRAY), ;; CFINIT(OBSOLETE), ;; CFINIT(FILE), ;; ;; CFINIT(BUFFER), ;; CFINIT(BUFFERPTR), ;; CFINIT(BUFFERLENGTH), ;; ;; CFINIT(CONTENTTYPE), ;; CFINIT(CONTENTHEADER), ;; CFINIT(FILENAME), ;; CFINIT(END), ;; CFINIT(OBSOLETE2), ;; ;; CURLFORM_LASTENTRY /* the last unusued */ ;; } CURLformoption; ;; ;; #undef CFINIT /* done */ ;; ;; /* structure to be used as parameter for CURLFORM_ARRAY */ ;; struct curl_forms { ;; CURLformoption option; ;; const char *value; ;; }; ;; ;; /* use this for multipart formpost building */ ;; /* Returns code for curl_formadd() ;; * ;; * Returns: ;; * CURL_FORMADD_OK on success ;; * CURL_FORMADD_MEMORY if the FormInfo allocation fails ;; * CURL_FORMADD_OPTION_TWICE if one option is given twice for one Form ;; * CURL_FORMADD_NULL if a null pointer was given for a char ;; * CURL_FORMADD_MEMORY if the allocation of a FormInfo struct failed ;; * CURL_FORMADD_UNKNOWN_OPTION if an unknown option was used ;; * CURL_FORMADD_INCOMPLETE if the some FormInfo is not complete (or error) ;; * CURL_FORMADD_MEMORY if a HttpPost struct cannot be allocated ;; * CURL_FORMADD_MEMORY if some allocation for string copying failed. ;; * CURL_FORMADD_ILLEGAL_ARRAY if an illegal option is used in an array ;; * ;; ***************************************************************************/ ;; typedef enum { ;; CURL_FORMADD_OK, /* first, no error */ ;; ;; CURL_FORMADD_MEMORY, ;; CURL_FORMADD_OPTION_TWICE, ;; CURL_FORMADD_NULL, ;; CURL_FORMADD_UNKNOWN_OPTION, ;; CURL_FORMADD_INCOMPLETE, ;; CURL_FORMADD_ILLEGAL_ARRAY, ;; CURL_FORMADD_DISABLED, /* libcurl was built with this disabled */ ;; ;; CURL_FORMADD_LAST /* last */ ;; } CURLFORMcode; ;; ;; /* ;; * NAME curl_formadd() ;; * ;; * DESCRIPTION ;; * ;; * Pretty advanved function for building multi-part formposts. Each invoke ;; * adds one part that together construct a full post. Then use ;; * CURLOPT_HTTPPOST to send it off to libcurl. ;; */ ;; CURL_EXTERN CURLFORMcode curl_formadd(struct curl_httppost **httppost, ;; struct curl_httppost **last_post, ;; ...); ;; ;; /* ;; * NAME curl_formfree() ;; * ;; * DESCRIPTION ;; * ;; * Free a multipart formpost previously built with curl_formadd(). ;; */ ;; CURL_EXTERN void curl_formfree(struct curl_httppost *form); ;; ;; /* ;; * NAME curl_getenv() ;; * ;; * DESCRIPTION ;; * ;; * Returns a malloc()'ed string that MUST be curl_free()ed after usage is ;; * complete. DEPRECATED - see lib/README.curlx ;; */ ;; CURL_EXTERN char *curl_getenv(const char *variable); ;; ;; /* ;; * NAME curl_version() ;; * ;; * DESCRIPTION ;; * ;; * Returns a static ascii string of the libcurl version. ;; */ ;; CURL_EXTERN char *curl_version(void); ;; ;; /* ;; * NAME curl_escape() ;; * ;; * DESCRIPTION ;; * ;; * Escapes URL strings (converts all letters consider illegal in URLs to their ;; * %XX versions). This function returns a new allocated string or NULL if an ;; * error occurred. ;; */ ;; CURL_EXTERN char *curl_escape(const char *string, int length); ;; ;; /* ;; * NAME curl_unescape() ;; * ;; * DESCRIPTION ;; * ;; * Unescapes URL encoding in strings (converts all %XX codes to their 8bit ;; * versions). This function returns a new allocated string or NULL if an error ;; * occurred. ;; */ ;; CURL_EXTERN char *curl_unescape(const char *string, int length); ;; ;; /* ;; * NAME curl_free() ;; * ;; * DESCRIPTION ;; * ;; * Provided for de-allocation in the same translation unit that did the ;; * allocation. Added in libcurl 7.10 ;; */ ;; CURL_EXTERN void curl_free(void *p); ;; ;; /* ;; * NAME curl_global_init() ;; * ;; * DESCRIPTION ;; * ;; * curl_global_init() should be invoked exactly once for each application that ;; * uses libcurl ;; */ ;; CURL_EXTERN CURLcode curl_global_init(long flags); ;; ;; /* ;; * NAME curl_global_init_mem() ;; * ;; * DESCRIPTION ;; * ;; * curl_global_init() or curl_global_init_mem() should be invoked exactly once ;; * for each application that uses libcurl. This function can be used to ;; * initialize libcurl and set user defined memory management callback ;; * functions. Users can implement memory management routines to check for ;; * memory leaks, check for mis-use of the curl library etc. User registered ;; * callback routines with be invoked by this library instead of the system ;; * memory management routines like malloc, free etc. ;; */ ;; CURL_EXTERN CURLcode curl_global_init_mem(long flags, ;; curl_malloc_callback m, ;; curl_free_callback f, ;; curl_realloc_callback r, ;; curl_strdup_callback s, ;; curl_calloc_callback c); ;; ;; /* ;; * NAME curl_global_cleanup() ;; * ;; * DESCRIPTION ;; * ;; * curl_global_cleanup() should be invoked exactly once for each application ;; * that uses libcurl ;; */ ;; CURL_EXTERN void curl_global_cleanup(void); ;; ;; /* linked-list structure for the CURLOPT_QUOTE option (and other) */ ;; struct curl_slist { ;; char *data; ;; struct curl_slist *next; ;; }; ;; ;; /* ;; * NAME curl_slist_append() ;; * ;; * DESCRIPTION ;; * ;; * Appends a string to a linked list. If no list exists, it will be created ;; * first. Returns the new list, after appending. ;; */ ;; CURL_EXTERN struct curl_slist *curl_slist_append(struct curl_slist *, ;; const char *); ;; ;; /* ;; * NAME curl_slist_free_all() ;; * ;; * DESCRIPTION ;; * ;; * free a previously built curl_slist. ;; */ ;; CURL_EXTERN void curl_slist_free_all(struct curl_slist *); ;; ;; /* ;; * NAME curl_getdate() ;; * ;; * DESCRIPTION ;; * ;; * Returns the time, in seconds since 1 Jan 1970 of the time string given in ;; * the first argument. The time argument in the second parameter is unused ;; * and should be set to NULL. ;; */ ;; CURL_EXTERN time_t curl_getdate(const char *p, const time_t *unused); ;; (unless (and (boundp 'curl-info-hash-table) (hash-table-p curl-info-hash-table)) (setq curl-info-hash-table (make-hash-table :test #'equal :size 30)) (let ((curlinfo-string #x100000) (curlinfo-long #x200000) (curlinfo-double #x300000) (curlinfo-slist #x400000)) ;; #define CURLINFO_MASK 0x0fffff ;; #define CURLINFO_TYPEMASK 0xf00000 ;; typedef enum { (puthash "NONE" '(nil nil) curl-info-hash-table) ; first, never use this (puthash "EFFECTIVE_URL" `(string ,(+ curlinfo-string 1)) curl-info-hash-table) (puthash "RESPONSE_CODE" `(long ,(+ curlinfo-long + 2)) curl-info-hash-table) (puthash "TOTAL_TIME" `(double ,(+ curlinfo-double 3)) curl-info-hash-table) (puthash "NAMELOOKUP_TIME" `(double ,(+ curlinfo-double 4)) curl-info-hash-table) (puthash "CONNECT_TIME" `(double ,(+ curlinfo-double 5)) curl-info-hash-table) (puthash "PRETRANSFER_TIME" `(double ,(+ curlinfo-double 6)) curl-info-hash-table) (puthash "SIZE_UPLOAD" `(double ,(+ curlinfo-double 7)) curl-info-hash-table) (puthash "SIZE_DOWNLOAD" `(double ,(+ curlinfo-double 8)) curl-info-hash-table) (puthash "SPEED_DOWNLOAD" `(double ,(+ curlinfo-double 9)) curl-info-hash-table) (puthash "SPEED_UPLOAD" `(double ,(+ curlinfo-double 10)) curl-info-hash-table) (puthash "HEADER_SIZE" `(long ,(+ curlinfo-long + 11)) curl-info-hash-table) (puthash "REQUEST_SIZE" `(long ,(+ curlinfo-long + 12)) curl-info-hash-table) (puthash "SSL_VERIFYRESULT" `(long ,(+ curlinfo-long + 13)) curl-info-hash-table) (puthash "FILETIME" `(long ,(+ curlinfo-long + 14)) curl-info-hash-table) (puthash "CONTENT_LENGTH_DOWNLOAD" `(double ,(+ curlinfo-double 15)) curl-info-hash-table) (puthash "CONTENT_LENGTH_UPLOAD" `(double ,(+ curlinfo-double 16)) curl-info-hash-table) (puthash "STARTTRANSFER_TIME" `(double ,(+ curlinfo-double 17)) curl-info-hash-table) (puthash "CONTENT_TYPE" `(string ,(+ curlinfo-string 18)) curl-info-hash-table) (puthash "REDIRECT_TIME" `(double ,(+ curlinfo-double 19)) curl-info-hash-table) (puthash "REDIRECT_COUNT" `(long ,(+ curlinfo-long + 20)) curl-info-hash-table) (puthash "PRIVATE" `(string ,(+ curlinfo-string 21)) curl-info-hash-table) (puthash "HTTP_CONNECTCODE" `(long ,(+ curlinfo-long + 22)) curl-info-hash-table) (puthash "HTTPAUTH_AVAIL" `(long ,(+ curlinfo-long + 23)) curl-info-hash-table) (puthash "PROXYAUTH_AVAIL" `(long ,(+ curlinfo-long + 24)) curl-info-hash-table) (puthash "OS_ERRNO" `(long ,(+ curlinfo-long + 25)) curl-info-hash-table) (puthash "NUM_CONNECTS" `(long ,(+ curlinfo-long + 26)) curl-info-hash-table) (puthash "SSL_ENGINES" `(list ,(+ curlinfo-slist+ 27)) curl-info-hash-table) (puthash "COOKIELIST" `(list ,(+ curlinfo-slist+ 28)) curl-info-hash-table) ;; Fill in new entries below here! (puthash "LASTONE" '(nil 28) curl-info-hash-table) ;; } CURLINFO; )) ;; /* CURLINFO_RESPONSE_CODE is the new name for the option previously known as ;; CURLINFO_HTTP_CODE */ ;; #define CURLINFO_HTTP_CODE CURLINFO_RESPONSE_CODE ;; ;; typedef enum { ;; CURLCLOSEPOLICY_NONE, /* first, never use this */ ;; ;; CURLCLOSEPOLICY_OLDEST, ;; CURLCLOSEPOLICY_LEAST_RECENTLY_USED, ;; CURLCLOSEPOLICY_LEAST_TRAFFIC, ;; CURLCLOSEPOLICY_SLOWEST, ;; CURLCLOSEPOLICY_CALLBACK, ;; ;; CURLCLOSEPOLICY_LAST /* last, never use this */ ;; } curl_closepolicy; ;; ;; #define CURL_GLOBAL_SSL (1<<0) ;; #define CURL_GLOBAL_WIN32 (1<<1) ;; #define CURL_GLOBAL_ALL (CURL_GLOBAL_SSL|CURL_GLOBAL_WIN32) ;; #define CURL_GLOBAL_NOTHING 0 ;; #define CURL_GLOBAL_DEFAULT CURL_GLOBAL_ALL ;; ;; ;; /***************************************************************************** ;; * Setup defines, protos etc for the sharing stuff. ;; */ ;; ;; /* Different data locks for a single share */ ;; typedef enum { ;; CURL_LOCK_DATA_NONE = 0, ;; /* CURL_LOCK_DATA_SHARE is used internaly to say that ;; * the locking is just made to change the internal state of the share ;; * itself. ;; */ ;; CURL_LOCK_DATA_SHARE, ;; CURL_LOCK_DATA_COOKIE, ;; CURL_LOCK_DATA_DNS, ;; CURL_LOCK_DATA_SSL_SESSION, ;; CURL_LOCK_DATA_CONNECT, ;; CURL_LOCK_DATA_LAST ;; } curl_lock_data; ;; ;; /* Different lock access types */ ;; typedef enum { ;; CURL_LOCK_ACCESS_NONE = 0, /* unspecified action */ ;; CURL_LOCK_ACCESS_SHARED = 1, /* for read perhaps */ ;; CURL_LOCK_ACCESS_SINGLE = 2, /* for write perhaps */ ;; CURL_LOCK_ACCESS_LAST /* never use */ ;; } curl_lock_access; ;; ;; typedef void (*curl_lock_function)(CURL *handle, ;; curl_lock_data data, ;; curl_lock_access locktype, ;; void *userptr); ;; typedef void (*curl_unlock_function)(CURL *handle, ;; curl_lock_data data, ;; void *userptr); ;; ;; typedef void CURLSH; ;; ;; typedef enum { ;; CURLSHE_OK, /* all is fine */ ;; CURLSHE_BAD_OPTION, /* 1 */ ;; CURLSHE_IN_USE, /* 2 */ ;; CURLSHE_INVALID, /* 3 */ ;; CURLSHE_NOMEM, /* out of memory */ ;; CURLSHE_LAST /* never use */ ;; } CURLSHcode; ;; ;; typedef enum { ;; CURLSHOPT_NONE, /* don't use */ ;; CURLSHOPT_SHARE, /* specify a data type to share */ ;; CURLSHOPT_UNSHARE, /* specify shich data type to stop sharing */ ;; CURLSHOPT_LOCKFUNC, /* pass in a 'curl_lock_function' pointer */ ;; CURLSHOPT_UNLOCKFUNC, /* pass in a 'curl_unlock_function' pointer */ ;; CURLSHOPT_USERDATA, /* pass in a user data pointer used in the lock/unlock ;; callback functions */ ;; CURLSHOPT_LAST /* never use */ ;; } CURLSHoption; ;; ;; CURL_EXTERN CURLSH *curl_share_init(void); ;; CURL_EXTERN CURLSHcode curl_share_setopt(CURLSH *, CURLSHoption option, ...); ;; CURL_EXTERN CURLSHcode curl_share_cleanup(CURLSH *); ;; ;; /**************************************************************************** ;; * Structures for querying information about the curl library at runtime. ;; */ ;; ;; typedef enum { ;; CURLVERSION_FIRST, ;; CURLVERSION_SECOND, ;; CURLVERSION_THIRD, ;; CURLVERSION_LAST /* never actually use this */ ;; } CURLversion; ;; ;; /* The 'CURLVERSION_NOW' is the symbolic name meant to be used by ;; basicly all programs ever, that want to get version information. It is ;; meant to be a built-in version number for what kind of struct the caller ;; expects. If the struct ever changes, we redefine the NOW to another enum ;; from above. */ ;; #define CURLVERSION_NOW CURLVERSION_THIRD ;; ;; typedef struct { ;; CURLversion age; /* age of the returned struct */ ;; const char *version; /* LIBCURL_VERSION */ ;; unsigned int version_num; /* LIBCURL_VERSION_NUM */ ;; const char *host; /* OS/host/cpu/machine when configured */ ;; int features; /* bitmask, see defines below */ ;; const char *ssl_version; /* human readable string */ ;; long ssl_version_num; /* not used anymore, always 0 */ ;; const char *libz_version; /* human readable string */ ;; /* protocols is terminated by an entry with a NULL protoname */ ;; const char * const *protocols; ;; ;; /* The fields below this were added in CURLVERSION_SECOND */ ;; const char *ares; ;; int ares_num; ;; ;; /* This field was aded in CURLVERSION_THIRD */ ;; const char *libidn; ;; } curl_version_info_data; ;; ;; #define CURL_VERSION_IPV6 (1<<0) /* IPv6-enabled */ ;; #define CURL_VERSION_KERBEROS4 (1<<1) /* kerberos auth is supported */ ;; #define CURL_VERSION_SSL (1<<2) /* SSL options are present */ ;; #define CURL_VERSION_LIBZ (1<<3) /* libz features are present */ ;; #define CURL_VERSION_NTLM (1<<4) /* NTLM auth is supported */ ;; #define CURL_VERSION_GSSNEGOTIATE (1<<5) /* Negotiate auth support */ ;; #define CURL_VERSION_DEBUG (1<<6) /* built with debug capabilities */ ;; #define CURL_VERSION_ASYNCHDNS (1<<7) /* asynchronous dns resolves */ ;; #define CURL_VERSION_SPNEGO (1<<8) /* SPNEGO auth */ ;; #define CURL_VERSION_LARGEFILE (1<<9) /* supports files bigger than 2GB */ ;; #define CURL_VERSION_IDN (1<<10) /* International Domain Names support */ ;; #define CURL_VERSION_SSPI (1<<11) /* SSPI is supported */ ;; ;; /* ;; * NAME curl_version_info() ;; * ;; * DESCRIPTION ;; * ;; * This function returns a pointer to a static copy of the version info ;; * struct. See above. ;; */ ;; CURL_EXTERN curl_version_info_data *curl_version_info(CURLversion); ;; ;; /* ;; * NAME curl_easy_strerror() ;; * ;; * DESCRIPTION ;; * ;; * The curl_easy_strerror function may be used to turn a CURLcode value ;; * into the equivalent human readable error string. This is useful ;; * for printing meaningful error messages. ;; */ ;; CURL_EXTERN const char *curl_easy_strerror(CURLcode); ;; ;; /* ;; * NAME curl_share_strerror() ;; * ;; * DESCRIPTION ;; * ;; * The curl_share_strerror function may be used to turn a CURLSHcode value ;; * into the equivalent human readable error string. This is useful ;; * for printing meaningful error messages. ;; */ ;; CURL_EXTERN const char *curl_share_strerror(CURLSHcode); (provide 'curl) ;;; curl.el ends here 1.1 XEmacs/packages/unsupported/stephen/curl/curl_api.c Index: curl_api.c =================================================================== /* * Lisp interface to libcurl for XEmacs. * * Copyright (C) 1998, 1999 J. Kean Johnston. All rights reserved. * Copyright (C) 2002 Jerry James. * Copyright (C) 2005 Stephen J. Turnbull <stephen(a)xemacs.org> * * All rights reserved, except as expressly indicated below. * * This program is not considered part of XEmacs. * * You may use, copy, modify, and distribute this software under the terms * of the GNU General Public License, version 2 or later at your option. * * Author: Stephen J. Turnbull <stephen(a)xemacs.org> * Creation-Date: 2005-11-20 */ #include <config.h> #include "lisp.h" #ifdef HAVE_SHLIB # include "emodules.h" #endif #include "lstream.h" #include "elhash.h" #include "curl_api.h" /* include <curl/curl.h> */ /************************************************************************/ /* Module-specific stuff */ /************************************************************************/ /* Local references to Lisp symbols */ static Lisp_Object Qcurl_api, Qcurl, Qurl_handlep, Qlong, Qfunctionpoint, Qobjectpoint, Qoff_t; static Lisp_Object Vcurl_option_hash_table, Vcurl_info_hash_table; /************************************************************************/ /* url_handle lrecord basic functions */ /************************************************************************/ static const struct memory_description url_handle_description [] = { { XD_LISP_OBJECT, offsetof (struct Lisp_URL_Handle, type) }, { XD_LISP_OBJECT, offsetof (struct Lisp_URL_Handle, property_list) }, { XD_LISP_OBJECT, offsetof (struct Lisp_URL_Handle, coding_system) }, { XD_END } }; static Lisp_Object mark_url_handle (Lisp_Object obj) { if (NILP (XURL_HANDLE (obj)->property_list)) return XURL_HANDLE (obj)->type; mark_object (XURL_HANDLE (obj)->coding_system); mark_object (XURL_HANDLE (obj)->type); return XURL_HANDLE (obj)->property_list; } static void print_url_handle (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { Lisp_URL_Handle *url_handle = XURL_HANDLE (obj); if (print_readably) printing_unreadable_object ("#<url_handle %s>", url_handle->url); write_c_string (printcharfun, "#<url_handle "); if (NILP(url_handle->type)) write_c_string (printcharfun, "(dead) "); else write_fmt_string_lisp (printcharfun, "%S ", 1, url_handle->type); if (url_handle->url) write_c_string (printcharfun, url_handle->url); write_fmt_string (printcharfun, " 0x%lx>", (unsigned long) url_handle); } static Lisp_URL_Handle * allocate_url_handle (void) { Lisp_URL_Handle *url_handle = ALLOC_LCRECORD_TYPE (Lisp_URL_Handle, &lrecord_url_handle); url_handle->type = Qnil; url_handle->property_list = Qnil; url_handle->coding_system = Qnil; url_handle->url = NULL; url_handle->curl_handle = NULL; /* #### UNIMPLEMENTED we need to initialize the big_ball_of_strings here. */ return url_handle; } static void finalize_url_handle (void *header, int for_disksave) { Lisp_URL_Handle *url_handle = (Lisp_URL_Handle *) header; if (for_disksave) invalid_operation ("Can't dump an emacs containing URL_HANDLE objects", wrap_url_handle (url_handle)); /* #### UNIMPLEMENTED we need to free the big_ball_of_strings here. */ if (url_handle->curl_handle) curl_easy_cleanup (url_handle->curl_handle); url_handle->curl_handle = NULL; if (url_handle->url) xfree (url_handle->url, Extbyte *); url_handle->url = NULL; } DEFINE_LRECORD_IMPLEMENTATION ("url_handle", url_handle, 0, mark_url_handle, print_url_handle, finalize_url_handle, NULL, NULL, url_handle_description, Lisp_URL_Handle); /************************************************************************/ /* Basic url_handle accessors */ /************************************************************************/ /* ###autoload */ DEFUN ("url-handle-p", Furl_handle_p, 1, 1, 0, /* Return t if OBJECT is a URL_HANDLE connection. */ (object)) { return URL_HANDLEP (object) ? Qt : Qnil; } DEFUN ("url-handle-type", Furl_handle_type, 1, 1, 0, /* Return the type of URL-HANDLE, a symbol. */ (url_handle)) { CHECK_URL_HANDLE (url_handle); return XURL_HANDLE (url_handle)->type; } DEFUN ("url-handle-live-p", Furl_handle_live_p, 1, 1, 0, /* Return non-nil if URL_HANDLE is an active URL_HANDLE connection. */ (url_handle)) { CHECK_URL_HANDLE (url_handle); return Furl_handle_type (url_handle); } DEFUN ("url-handle-property-list", Furl_handle_host, 1, 1, 0, /* Return the property list of URL-HANDLE. */ (url_handle)) { Lisp_Object retval; CHECK_URL_HANDLE (url_handle); retval = XURL_HANDLE (url_handle)->property_list; /* #### extract properties from the curl_handle and add to retval here */ return retval; } #if 0 DEFUN ("url-handle-host", Furl_handle_host, 1, 1, 0, /* Return the server host of the connection URL-HANDLE, as a string. */ (url_handle)) { CHECK_URL_HANDLE (url_handle); return WHAT? } #endif /************************************************************************/ /* Lisp API functions */ /************************************************************************/ /* error macros */ #define UNIMPLEMENTED(reason) signal_error (Qunimplemented, reason, Qunbound) /* #### Do something more useful with the error codes! */ #define CHECK_CURL_ERROR(code, index, handle) \ do { if (code) \ Fsignal (Qio_error, \ list3 (build_ext_string (curl_easy_strerror (code), \ Qbinary), \ index, \ handle)); } while (0) DEFUN ("curl-make-url-handle", Fcurl_make_url_handle, 1, 3, 0, /* Return a cURL handle for URL, wrapped in an url-handle. URL is a string, which must be a URI scheme known to cURL. URL is encoded according to optional argument CODESYS. (Of course cURL will URL-encode it before sending it off.) PLIST is a property list. These properties are set on the cURL handle. #### This interface may change to (&rest PLIST). #### This is not called "make-curl-handle" because a more general module, which will call this function, is planned. That will call this function from a function `make-url-handle'. */ (url, codesys, plist)) { Lisp_URL_Handle *url_handle = allocate_url_handle (); url_handle->type = Qcurl; if (NILP (codesys)) /* #### Quick hack, should be Qnative? */ codesys = Ffind_coding_system (Qutf_8); CHECK_CODING_SYSTEM (codesys); url_handle->coding_system = codesys; /* Do this *before* the plist because later we will be initializing curl_handle options from the plist. */ CHECK_STRING (url); url_handle->url = NEW_LISP_STRING_TO_EXTERNAL_MALLOC(url, codesys); url_handle->curl_handle = curl_easy_init (); curl_easy_setopt (url_handle->curl_handle, CURLOPT_URL, url_handle->url); /* skeleton - currently simply copies the plist This has the effect of checking well-formedness, and we may want to handle some properties specially. */ url_handle->property_list = Qnil; { EXTERNAL_PROPERTY_LIST_LOOP_3(key, value, plist) { url_handle->property_list = Fcons (key, Fcons (value, url_handle->property_list)); } } return wrap_url_handle (url_handle); } DEFUN ("curl-easy-setopt", Fcurl_easy_setopt, 3, 3, 0, /* Set OPTION to VALUE on curl url-handle HANDLE and return t. OPTION is a string denoting an option in `curl-option-hash-table'. VALUE must be of the appropriate type. HANDLE must be an url-handle object of type `curl'. A wrapper with some validation for libcurl's `curl_easy_setopt'. Errors without useful explanations probably mean `curl-option-hash-table' is corrupt. */ (option, value, handle)) { Lisp_Object optdata = Fgethash (option, Vcurl_option_hash_table, Qnil); Lisp_Object opttype = Fcar (optdata); Lisp_Object optindex = Fcar (Fcdr (optdata)); CURLoption index; CURL *curl; CURLcode code; Lisp_URL_Handle *h; if (NILP (optdata)) invalid_argument ("unrecognized cURL option", option); CHECK_URL_HANDLE (handle); h = XURL_HANDLE (handle); if (!EQ (h->type, Qcurl)) wtaerror ("handle is not a curl handle", handle); curl = h->curl_handle; CHECK_INT (optindex); index = XINT (optindex); if (EQ (opttype, Qlong)) { CHECK_INT (value); index += CURLOPTTYPE_LONG; /* CURLoptions encode type */ code = curl_easy_setopt (curl, (CURLoption) index, XINT (value)); CHECK_CURL_ERROR (code, option, handle); } else if (EQ (opttype, Qobjectpoint)) { Extbyte *s; /* HA-A-ACK! Currently we only support strings here, and we don't check a string is a sane value for the option. */ CHECK_STRING (value); index += CURLOPTTYPE_OBJECTPOINT; /* CURLoptions encode type */ /* #### MEMORY LEAK! We need to add a pointer to the converted data here to a Dynarr which is part of the handle. That will be freed when the handle is collected. */ /* #### Is this the right coding system? */ s = NEW_LISP_STRING_TO_EXTERNAL_MALLOC (value, h->coding_system); code = curl_easy_setopt (curl, (CURLoption) index, s); CHECK_CURL_ERROR (code, option, handle); if (index == CURLOPT_URL) { h->url = s; } } else if (EQ (opttype, Qfunctionpoint)) { index += CURLOPTTYPE_FUNCTIONPOINT; /* CURLoptions encode type */ UNIMPLEMENTED ("curl_api function pointer options"); } else if (EQ (opttype, Qoff_t)) { index += CURLOPTTYPE_OFF_T; /* CURLoptions encode type */ UNIMPLEMENTED ("curl_api large file offset options"); } else { invalid_state ("invalid option type in `curl-option-hash-table'", opttype); } return Qt; } static size_t curl_write_function (void *data, size_t size, size_t nmemb, void *stream) { size_t count = size * nmemb; Lstream *s = XLSTREAM ((Lisp_Object) stream); /* #### the return code should be checked */ return (Lstream_write (s, data, count)) ? --count : count; } DEFUN ("curl-easy-perform", Fcurl_easy_perform, 1, 2, 0, /* Read from the URL represented by HANDLE into BUFFER at point. Optional BUFFER defaults to the current buffer. Returns t. */ (handle, buffer)) { CHECK_URL_HANDLE (handle); if (NILP (buffer)) buffer = Fcurrent_buffer (); CHECK_BUFFER (buffer); if (EQ (XURL_HANDLE (handle)->type, Qcurl)) { CURL *curl = XURL_HANDLE (handle)->curl_handle; if (curl) { CURLcode code; struct buffer *buf = XBUFFER(buffer); /* #### I don't see how to generalize this. We'd like to be able to the Lstream in from Lisp, and somehow figure out what the type is so as to use the proper CURLOPT_WRITEFUNCTION. Ditto for CURLOPT_READFUNCTION and CURLOPT_READDATA. */ Lisp_Object s = make_lisp_buffer_output_stream (buf, buf->bufpt, LSTR_ALLOW_QUIT); curl_easy_setopt (curl, CURLOPT_WRITEFUNCTION, &curl_write_function); curl_easy_setopt (curl, CURLOPT_WRITEDATA, s); code = curl_easy_perform (curl); Lstream_close (XLSTREAM (s)); CHECK_CURL_ERROR (code, intern ("perform"), handle); } else { invalid_state ("URL handle is uninitialized", handle); } } else { wtaerror ("URL handle is not a cURL handle", handle); } return Qt; } DEFUN ("curl-easy-getinfo", Fcurl_easy_getinfo, 2, 2, 0, /* Return the value of ATTRIBUTE for HANDLE. ATTRIBUTE is a string denoting an attribute in `curl-info-hash-table'. HANDLE must be an url-handle object of type `curl'. A wrapper with some validation for libcurl's `curl_easy_getinfo'. Errors without useful explanations probably mean `curl-info-hash-table' is corrupt. */ (attribute, handle)) { Lisp_Object attdata = Fgethash (attribute, Vcurl_info_hash_table, Qnil); Lisp_Object atttype = Fcar (attdata); Lisp_Object attindex = Fcar (Fcdr (attdata)); CURL *curl; CURLcode code; Lisp_URL_Handle *h; if (NILP (attdata)) invalid_argument ("unrecognized cURL attribute", attribute); CHECK_URL_HANDLE (handle); h = XURL_HANDLE (handle); if (!EQ (h->type, Qcurl)) wtaerror ("handle is not a curl handle", handle); curl = h->curl_handle; CHECK_INT (attindex); index = XINT (attindex); if (EQ (atttype, Qlong)) { long retval; code = curl_easy_getinfo (curl, (CURLoption) index, &retval); CHECK_CURL_ERROR (code, attribute, handle); /* #### can this overflow? */ value = make_int (retval); } else if (EQ (atttype, Qstring)) { Extbyte *retval; code = curl_easy_getinfo (curl, (CURLoption) index, &retval); CHECK_CURL_ERROR (code, attribute, handle); value = build_ext_string (s); } else if (EQ (atttype, Qdouble)) { double retval; code = curl_easy_getinfo (curl, (CURLoption) index, &retval); CHECK_CURL_ERROR (code, attribute, handle); value = make_float (retval); } else if (EQ (atttype, Qlist)) { UNIMPLEMENTED ("curl_api slist attributes"); } else { invalid_state ("invalid attribute type in `curl-info-hash-table'", atttype); } return value; } /* * Each dynamically loaded Emacs module is given a name at compile * time. This is a short name, and must be a valid part of a C * identifier. This name is used to construct the name of several * functions which must appear in the module source code. * The first such function, modules_of_XXXX, should load in any dependent * modules. This function is optional, and the module will still load if * it is not present in the module. * * The second function, which is NOT optional, is syms_of_XXXX, in which * all functions that the module will be provided are declared. This * function will contain calls to DEFSUBR(). * * The third function, which is also NOT optional, is vars_of_XXXX, in * which you declare all variables that the module provides. This * function will contain calls to DEFVAR_LISP(), DEFVAR_BOOL() etc. * * When declaring functions and variables in the syms_of_XXXX and * vars_of_XXXX functions, you use the exact same syntax that you * would as if this module were being compiled into the pure Emacs. * * The fourth function, which is optional, is unload_XXXX, in which actions * that must be taken to unload the module are listed. XEmacs will unbind * functions and variables for you. Anything else that must be done should * appear in this function. * * All four of these functions are declared as void functions, * taking no parameters. */ #if 0 void modules_of_curl_api () { /* * This function isn't actually required as we will not be loading * in any dependent modules, but if we were, we would do something like: * emodules_load ("dependent.ell", "sample2", "1.0.0"); */ /* MAYBE: emodules_load ("earl.ell", "earl", "0.0.1"); */ } #endif void syms_of_curl_api () { INIT_LRECORD_IMPLEMENTATION (url_handle); /* #### These functions will move to the earl module. */ DEFSUBR (Furl_handle_p); DEFSUBR (Furl_handle_live_p); DEFSUBR (Furl_handle_host); DEFSUBR (Furl_handle_type); /* cURL-specific functions. */ DEFSUBR (Fcurl_make_url_handle); DEFSUBR (Fcurl_easy_perform); DEFSUBR (Fcurl_easy_setopt); /* #### These symbols will move to the earl module. */ DEFSYMBOL_MULTIWORD_PREDICATE (Qurl_handlep); /* cURL-specific symbols. */ DEFSYMBOL (Qcurl_api); /* feature symbol */ DEFSYMBOL (Qcurl); DEFSYMBOL (Qlong); DEFSYMBOL (Qfunctionpoint); DEFSYMBOL (Qobjectpoint); defsymbol (&Qoff_t, "off_t"); /* Yes, it IS worth conforming to cURL's spelling of this symbol. */ } void vars_of_curl_api () { Fprovide (Qcurl_api); DEFVAR_LISP ("curl-option-hash-table", &Vcurl_option_hash_table /* Table of options available for `curl-easy-setopt'. Key are strings naming options. The option names are taken from enum CURLoption in <curl/curl.h>. They are all uppercase, and the "CURLOPT_" prefix is omitted. Values are lists containing a type symbol \(one of `long', `objectpoint', `functionpoint', and `off_t') and an integer, which is the option index. It is planned to add a list of Lisp types that can be converted to something that is useful for the option as the 3rd element of the value list. It is planned to add the leading comments as docstrings, to be the 4th element of the value list corresponding to each key. */ ); Vcurl_option_hash_table = Qnil; DEFVAR_LISP ("curl-info-hash-table", &Vcurl_info_hash_table /* Table of attributes accessible via `curl-easy-getinfo'. Keys are strings naming attributes. The attribute names are taken from enum CURLinfo in <curl/curl.h>. They are all uppercase, and the "CURLINFO_" prefix is omitted. Values are lists containing a type symbol (one of `long', `string', `double', and `list') and an integer, which is the attribute index. It is planned to add docstrings, to be the 3rd element of the value list corresponding to each key. */ ); Vcurl_info_hash_table = Qnil; #ifdef HAVE_SHLIB /* Need to initialize cURL if loaded as a module. Could do this lazily (when creating the first cURL handle), but since this is a module it probably got autoloaded in response to a call to `make-curl-handle'. */ if (curl_global_init (CURL_GLOBAL_XEMACS)) { /* unload_curl_api (); */ /* #### can we do this? */ signal_error (Qio_error, "libcurl initialization failed", Qunbound); } #endif } #ifdef HAVE_SHLIB void unload_curl_api () { /* If we create any new types by INIT_LRECORD_IMPLEMENTATION (sample_type), then UNDEF_LRECORD_IMPLEMENTATION (sample_type) must appear here. Also, any symbols declared with DEFSYMBOL (Qsample_var) or a variant, must have a corresponding unstaticpro_nodump (&Qsample_var) here. */ /* Shut down libcurl and free internal structures. #### Handle return code? Nothing interesting is documented. */ (void) curl_global_cleanup (); unstaticpro_nodump (&Qcurl_api); unstaticpro_nodump (&Qcurl); unstaticpro_nodump (&Qurl_handlep); unstaticpro_nodump (&Qlong); unstaticpro_nodump (&Qfunctionpoint); unstaticpro_nodump (&Qobjectpoint); unstaticpro_nodump (&Qoff_t); } #endif 1.1 XEmacs/packages/unsupported/stephen/curl/curl_api.h Index: curl_api.h =================================================================== /* * Lisp interface to libcurl for XEmacs. * * Copyright (C) 1998, 1999 J. Kean Johnston. All rights reserved. * Copyright (C) 2002 Jerry James. * Copyright (C) 2005 Stephen J. Turnbull <stephen(a)xemacs.org> * * All rights reserved, except as expressly indicated below. * * This program is not considered part of XEmacs. * * You may use, copy, modify, and distribute this software under the terms * of the GNU General Public License, version 2 or later at your option. * * Author: Stephen J. Turnbull <stephen(a)xemacs.org> * Creation-Date: 2005-11-23 */ #include <curl/curl.h> /************************************************************************/ /* XEmacs-specific cURL stuff */ /************************************************************************/ /* Presumably we initialize Windows socket stuff correctly. If not, I don't think it's a good idea to do it in a module. If you know better, feel free to allow CURL_GLOBAL_WIN32 in this macro. */ #define CURL_GLOBAL_XEMACS (CURL_GLOBAL_ALL & ~CURL_GLOBAL_WIN32) /************************************************************************/ /* Structures */ /************************************************************************/ /* This is URL_Handle, not Curl_Handle, because a generalization is planned. */ struct Lisp_URL_Handle { struct LCRECORD_HEADER header; /* type of the handle; READ-ONLY from Lisp */ Lisp_Object type; /* property list for properties not contained in the cURL handle; READ-ONLY from Lisp This could be used to maintain state for a handler based on url.el or an external process (eg, curl, wget). */ Lisp_Object property_list; /* the coding system used to convery url; READ-ONLY from Lisp */ Lisp_Object coding_system; /* the URL string in external format cURL expects the caller to allocate storage and clean it up. */ Extbyte *url; /* the cURL handle used by the libcurl API */ CURL *curl_handle; /* #### UNIMPLEMENTED array of pointers to string data we need to free */ Dynarr *big_ball_of_strings; }; typedef struct Lisp_URL_Handle Lisp_URL_Handle; DECLARE_LRECORD (url_handle, Lisp_URL_Handle); #define XURL_HANDLE(x) XRECORD (x, url_handle, Lisp_URL_Handle) #define wrap_url_handle(p) wrap_record (p, url_handle) #define URL_HANDLEP(x) RECORDP (x, url_handle) #define CHECK_URL_HANDLE(x) CHECK_RECORD (x, url_handle) #define CONCHECK_URL_HANDLE(x) CONCHECK_RECORD (x, url_handle) 1.1 XEmacs/packages/unsupported/stephen/curl/install-sh Index: install-sh =================================================================== #!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5 (mit/util/scripts/install.sh). # # Copyright 1991 by the Massachusetts Institute of Technology # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else : fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: chmodcmd="" else instcmd=$mkdirprog fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f "$src" ] || [ -d "$src" ] then : else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else : fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else : fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's＠/＠%＠g' -e 's＠^%＠/＠'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else : fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else : ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else : ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else : ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else : ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else : fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else :;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else :;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else :;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else :;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0

1 participants
0 comments

CVS update by stephent ( User: stephent Date: 05/11/26 16:26:37) XEmacs/packages/unsupported/stephen/curl 19 years, 1 month

CVS Monitor

XEmacs/packages/unsupported/stephen/curl - New directory

1 participants
0 comments

CVS update by stephent xemacs/src ... 19 years, 1 month

CVS Monitor

User: stephent Date: 05/11/26 14:20:25 Modified: xemacs/src ChangeLog keymap.c Log: Improve where-is internal docstring. <87y83b35z7.fsf(a)tleepslib.sk.tsukuba.ac.jp> Revision Changes Path 1.894 +4 -4 XEmacs/xemacs/src/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v retrieving revision 1.893 retrieving revision 1.894 diff -u -p -r1.893 -r1.894 --- ChangeLog 2005/11/26 11:46:05 1.893 +++ ChangeLog 2005/11/26 13:20:21 1.894 ＠＠ -1,3 +1,7 ＠＠ +2004-12-19 Stephen J. Turnbull <stephen(a)xemacs.org> + + * keymap.c (Fwhere_is_internal): Rewrite docstring. + 2005-11-26 Stephen J. Turnbull <stephen(a)xemacs.org> Merge Xft. ＠＠ -469,10 +473,6 ＠＠ * glyphs-x.c,objects-x.c: Deemphasize warnings (to debug or alert). * redisplay-x.c: Don't abort() when ichar_to_unicode returns error. - - 2004-12-19 Stephen J. Turnbull <stephen(a)xemacs.org> - - * keymap.c (Fwhere_is_internal): Rewrite docstring. 2004-12-17 Stephen J. Turnbull <stephen(a)xemacs.org> 1.61 +9 -6 XEmacs/xemacs/src/keymap.c Index: keymap.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/keymap.c,v retrieving revision 1.60 retrieving revision 1.61 diff -u -p -r1.60 -r1.61 --- keymap.c 2005/11/22 10:36:39 1.60 +++ keymap.c 2005/11/26 13:20:23 1.61 ＠＠ -3474,17 +3474,20 ＠＠ DEFUN ("where-is-internal", Fwhere_is_in Return list of keys that invoke DEFINITION in KEYMAPS. KEYMAPS can be either a keymap (meaning search in that keymap and the current global keymap) or a list of keymaps (meaning search in exactly -those keymaps and no others). If KEYMAPS is nil, search in the currently -applicable maps for EVENT-OR-KEYS (this is equivalent to specifying -`(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS). +those keymaps and no others). If optional 3rd arg FIRSTONLY is non-nil, return a vector representing the first key sequence found, rather than a list of all possible key sequences. -If optional 4th arg NOINDIRECT is non-nil, don't follow indirections - to other keymaps or slots. This makes it possible to search for an - indirect definition itself. +Optional 4th argument NOINDIRECT is ignored. (GNU Emacs uses it to allow +searching for an indirect keymap by inhibiting following of indirections to +keymaps or slots, but XEmacs doesn't need it because keymaps are a type.) + +If optional 5th argument EVENT-OR-KEYS is non-nil and KEYMAPS is nil, +search in the currently applicable maps for EVENT-OR-KEYS (this is +equivalent to specifying `(current-keymaps EVENT-OR-KEYS)' as the +argument to KEYMAPS). */ (definition, keymaps, firstonly, UNUSED (noindirect), event_or_keys)) {

1 participants
0 comments

CVS update by stephent xemacs/src ... 19 years, 1 month

CVS Monitor

User: stephent Date: 05/11/26 13:09:40 Modified: xemacs/src depend Log: Xft merge (generated files configure and src/depend. <87k6ev4p8q.fsf(a)tleepslib.sk.tsukuba.ac.jp>) Revision Changes Path 1.262 +693 -3 XEmacs/xemacs/configure Index: configure =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure,v retrieving revision 1.261 retrieving revision 1.262 diff -u -p -r1.261 -r1.262 --- configure 2005/11/25 01:41:32 1.261 +++ configure 2005/11/26 12:09:23 1.262 ＠＠ -991,6 +991,13 ＠＠ Run-time path-searching options Window-system options --------------------- + --with-xft Compile with support for Xft client-side font + rendering and anti-aliasing. Components that can use + Xft are `emacs' (buffers), `menubars', `tabs', and + `gauges'. Prefix component with `no' to disable its + use of Xft. Requires X11, Xft, Xrender, freetype, + and fontconfig support. Default is + `emacs,menubars,tabs,gauges'. --with-gtk Support GTK on the X Window System. (EXPERIMENTAL) --with-gnome Support GNOME on the X Window System. (EXPERIMENTAL) --with-msw Support MS Windows as a window system (only under ＠＠ -1092,9 +1099,9 ＠＠ Internationalization options --with-wnn6 Support the Wnn6 Asian language input method (proprietary). Requires Mule. --with-xfs Enable XFontSet support for internationalized - menubar. Incompatible with `--with-xim=motif'. - `--with-menubars=lucid' (the default) is - desirable. + menubar. Incompatible with `--with-xim=motif' and + `--with-xft'. `--with-menubars=lucid' (the + default) is desirable. File-related options -------------------- ＠＠ -2256,6 +2263,84 ＠＠ _ACEOF fi; +_xft_notfirst="" +with_xft_emacs=yes +enable_xft_emacs=yes +with_xft_menubars=yes +enable_xft_menubars=yes +with_xft_tabs=yes +enable_xft_tabs=yes +with_xft_gauges=yes +enable_xft_gauges=yes + +_xft_types="emacs menubars tabs gauges" +_xft_default="emacs,menubars,tabs,gauges" + + + +# If --with-xft or --without-xft were given then copy the value to the +# equivalent enable_xft variable. +if test "${with_xft+set}" = set; then + enable_xft="$with_xft" +fi; +# If -enable-xft or --disable-xft were given then copy the value to the +# equivalent with_xft variable. +if test "${enable_xft+set}" = set; then + with_xft="$enable_xft" +fi; +# Check whether --with-xft or --without-xft was given. +if test "${with_xft+set}" = set; then + enableval="$with_xft" + withval="$with_xft" + for y in $_xft_types; do + eval "with_xft_$y=no" + eval "enable_xft_$y=no" +done +for x in `echo "$with_xft" | sed -e 's/,/ /g'` ; do + _xft_all_default="" + _xft_found="" + case "$x" in + n | no | non | none ) _xft_all_default=no ;; + a | al | all | both ) _xft_all_default=yes ;; + esac + + if test -z "$_xft_all_default"; then + for y in $_xft_types; do + if test "$x" = "$y"; then + _xft_found=yes + eval "with_xft_$y=yes" + eval "enable_xft_$y=yes" + elif test "$x" = "no$y"; then + _xft_found=yes + eval "with_xft_$y=no" + eval "enable_xft_$y=no" + fi + done + test -z "$_xft_found" && _xft_bogus=yes + fi + if test "$_xft_bogus" = "yes" -o \ + $ -n "$_xft_all_default" -a -n "$_xft_notfirst" $ ; then + (echo "$progname: Usage error:" +echo " " "Valid values for the --with-xft option are: +$_xft_types. With prefix \"no\", switch it off. +Defaults may be overridden with \`all' or \`none' first in the list. +Hardcoded default is: $_xft_default." +echo " Use \`$progname --help' to show usage.") >&2 && exit 1 + elif test -n "$_xft_all_default" ; then + for y in $_xft_types; do + eval "with_xft_$y=$_xft_all_default" + eval "enable_xft_$y=$_xft_all_default" + done + fi + _xft_notfirst=yes +done +unset _xft_bogus _xft_found _xft_notfirst _xft_types +unset _xft_default _xft_all_default x y + + + +fi; + , ) # If --with-gtk or --without-gtk were given then copy the value to the # equivalent enable_gtk variable. if test "${with_gtk+set}" = set; then ＠＠ -3786,6 +3871,19 ＠＠ elif test "$with_cde" = "yes"; then with fi +if test $ "$with_xft_menubars" = "yes" -o "$with_xft_tabs" = "yes" \ + -o "$with_xft_gauges" = "yes" $ -a "$with_xft_emacs" = "no"; then + { echo "$as_me:$LINENO: WARNING: Forcing --with-xft=emacs because Xft is enabled" >&5 +echo "$as_me: WARNING: Forcing --with-xft=emacs because Xft is enabled" >&2;} + with_xft_emacs=yes +fi + +if test "$with_xfs" = "yes" -a "$with_xft_menubars" = "yes"; then + (echo "$progname: Usage error:" +echo " " "XFS and Xft in the menubars are incompatible!" +echo " Use \`$progname --help' to show usage.") >&2 && exit 1 +fi + test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. if test "x$exec_prefix" = xNONE ＠＠ -18995,6 +19093,548 ＠＠ fi fi fi + + if test "$with_xft_emacs" = "yes"; then + { echo "$as_me:$LINENO: checking for Xrender, fontconfig, and Xft..." >&5 +echo "$as_me: checking for Xrender, fontconfig, and Xft..." >&6;} + xft_includes_found=no + +for ac_header in freetype/config/ftheader.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------------- ## +## Report this to xemacs-beta(a)xemacs.org ## +## ------------------------------------- ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + xft_includes_found=yes +else + + for freetype_include_top in "/usr/X11R6/include/freetype2" \ + "/usr/include/freetype2" + do + if test -d $freetype_include_top; then + { echo "$as_me:$LINENO: checking in ${freetype_include_top}/freetype2..." >&5 +echo "$as_me: checking in ${freetype_include_top}/freetype2..." >&6;} + unset "$as_ac_Header" + save_c_switch_site="$c_switch_site" + c_switch_site="$c_switch_site -I${freetype_include_top}" + +for ac_header in freetype/config/ftheader.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------------- ## +## Report this to xemacs-beta(a)xemacs.org ## +## ------------------------------------- ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + xft_includes_found=yes +else + c_switch_site=$save_c_switch_site +fi + +done + + fi + done + if test "$xft_includes_found" != "yes"; then + { echo "Error:" "Unable to find headers for --with-xft" >&2; exit 1; } + else + echo "$as_me:$LINENO: checking for XRenderQueryExtension in -lXrender" >&5 +echo $ECHO_N "checking for XRenderQueryExtension in -lXrender... $ECHO_C" >&6 +if test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lXrender $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char XRenderQueryExtension (); +int +main () +{ +XRenderQueryExtension (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_Xrender_XRenderQueryExtension=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_Xrender_XRenderQueryExtension=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_Xrender_XRenderQueryExtension" >&5 +echo "${ECHO_T}$ac_cv_lib_Xrender_XRenderQueryExtension" >&6 +if test $ac_cv_lib_Xrender_XRenderQueryExtension = yes; then + libs_x="-lXrender $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXrender\" to \$libs_x"; fi +else + { echo "Error:" "Unable to find libXrender for --with-xft" >&2; exit 1; } +fi + + echo "$as_me:$LINENO: checking for FcPatternCreate in -lfontconfig" >&5 +echo $ECHO_N "checking for FcPatternCreate in -lfontconfig... $ECHO_C" >&6 +if test "${ac_cv_lib_fontconfig_FcPatternCreate+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lfontconfig $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char FcPatternCreate (); +int +main () +{ +FcPatternCreate (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_fontconfig_FcPatternCreate=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_fontconfig_FcPatternCreate=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_fontconfig_FcPatternCreate" >&5 +echo "${ECHO_T}$ac_cv_lib_fontconfig_FcPatternCreate" >&6 +if test $ac_cv_lib_fontconfig_FcPatternCreate = yes; then + libs_x="-lfontconfig $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lfontconfig\" to \$libs_x"; fi +else + { echo "Error:" "Unable to find libfontconfig for --with-xft" >&2; exit 1; } +fi + + echo "$as_me:$LINENO: checking for XftFontOpen in -lXft" >&5 +echo $ECHO_N "checking for XftFontOpen in -lXft... $ECHO_C" >&6 +if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lXft $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char XftFontOpen (); +int +main () +{ +XftFontOpen (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_Xft_XftFontOpen=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_Xft_XftFontOpen=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_Xft_XftFontOpen" >&5 +echo "${ECHO_T}$ac_cv_lib_Xft_XftFontOpen" >&6 +if test $ac_cv_lib_Xft_XftFontOpen = yes; then + libs_x="-lXft $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXft\" to \$libs_x"; fi +else + { echo "Error:" "Unable to find libXft for --with-xft" >&2; exit 1; } +fi + + cat >>confdefs.h <<\_ACEOF +#define USE_XFT 1 +_ACEOF + + unset xft_includes_found + fi + +fi + +done + + fi + fi if test "$with_msw" != "no"; then { echo "$as_me:$LINENO: checking for MS-Windows..." >&5 ＠＠ -26202,6 +26842,13 ＠＠ esac case "$enable_menubars" in "" | "yes" | "athena" ) enable_menubars="lucid" ;; esac +if test "$with_xft_menubars" != "no" ; then + if test "$with_xft_emacs" = "yes" -a "$with_menubars" != "no" ; then + with_xft_menubars="yes" + else + with_xft_menubars="no" + fi +fi case "$enable_dialogs" in "" | "yes" | "lucid" ) if test "$lucid_prefers_motif" = "yes"; then if test "$have_motif" = "yes"; then enable_dialogs="motif" ＠＠ -26235,6 +26882,20 ＠＠ case "$enable_widgets" in "" | "yes" | " fi fi ;; esac +if test "$with_xft_tabs" != "no" ; then + if test "$with_xft_emacs" = "yes" -a "$enable_widgets" != "no" ; then + with_xft_tabs="yes" + else + with_xft_tabs="no" + fi +fi +if test "$with_xft_gauge" != "no" ; then + if test "$with_xft_emacs" = "yes" -a "$enable_widgets" != "no" ; then + with_xft_gauge="yes" + else + with_xft_gauge="no" + fi +fi all_widgets="$enable_menubars $enable_scrollbars $enable_dialogs $enable_toolbars $enable_widgets" ＠＠ -26416,6 +27077,19 ＠＠ test "$enable_widgets" = "motif" && _ACEOF +test "$with_xft_menubars" = "yes" && cat >>confdefs.h <<\_ACEOF +#define USE_XFT_MENUBARS 1 +_ACEOF + +test "$with_xft_tabs" = "yes" && cat >>confdefs.h <<\_ACEOF +#define USE_XFT_TABS 1 +_ACEOF + +test "$with_xft_gauge" = "yes" && cat >>confdefs.h <<\_ACEOF +#define USE_XFT_GAUGE 1 +_ACEOF + + test -z "$enable_mule" && enable_mule=no ＠＠ -38466,6 +39140,9 ＠＠ if test "$with_x11" = "yes"; then if test "$with_wmcommand" != no; then echo " - Handling WM_COMMAND properly." fi + if test "$with_xft" = "yes"; then + echo " - Compiling in support for Xft antialiased fonts (EXPERIMENTAL)." + fi fi if test "$need_motif" = "yes" ; then echo " Compiling in support for Motif." ＠＠ -38491,6 +39168,10 ＠＠ case "$enable_menubars" in echo " Re-run configure with --enable-menubars='lucid'." ;; msw ) echo " Using MS-Windows menubars." ;; esac +if test "$with_xft_menubars" = "yes"; then + echo " - Using Xft to render antialiased fonts in menubars." + echo " WARNING: This feature will be replaced with a face." +fi case "$enable_scrollbars" in gtk ) echo " Using GTK scrollbars." ;; lucid ) echo " Using Lucid scrollbars." ;; ＠＠ -38516,6 +39197,15 ＠＠ case "$enable_widgets" in athena ) echo " Using Athena native widgets." ;; msw ) echo " Using MS-Windows native widgets." ;; esac +if test "$with_xft_tabs" = "yes"; then + echo " - Using Xft to render antialiased fonts in tab controls." + echo " WARNING: This feature will be replaced with a face." +fi +if test "$with_xft_gauge" = "yes"; then + echo " - Using Xft to render antialiased fonts in progress bars." + echo " WARNING: This feature will be replaced with a face." + echo " WARNING: This feature not yet implemented; setting ignored." +fi if test "$with_dragndrop" = yes; then echo " Compiling in support for Drag'n'Drop (EXPERIMENTAL)." echo " - Drag'n'Drop prototype: $dragndrop_proto." 1.60 +3 -2 XEmacs/xemacs/src/depend Index: depend =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/depend,v retrieving revision 1.59 retrieving revision 1.60 diff -u -p -r1.59 -r1.60 --- depend 2005/11/25 01:41:58 1.59 +++ depend 2005/11/26 12:09:39 1.60 ＠＠ -48,7 +48,7 ＠＠ glyphs-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lw gui-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h events.h frame.h glyphs.h gui.h menubar.h opaque.h redisplay.h scrollbar.h specifier.h systime.h window-impl.h window.h winslots.h xintrinsic.h xmotif.h intl-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h console-x.h console.h xintrinsic.h menubar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h gui.h keymap.h menubar.h opaque.h redisplay.h scrollbar.h systime.h window-impl.h window.h winslots.h xintrinsic.h -objects-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h insdel.h objects-impl.h objects-x-impl.h objects-x.h objects.h specifier.h xintrinsic.h +objects-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h insdel.h objects-impl.h objects-x-impl.h objects-x.h objects.h specifier.h xft-fonts.h xintrinsic.h redisplay-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-x-impl.h console-x.h console.h debug.h device-impl.h device.h devslots.h faces.h file-coding.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h gutter.h mule-ccl.h objects-impl.h objects-x-impl.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h sysdep.h sysproc.h syssignal.h systime.h window-impl.h window.h winslots.h xgccache.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h scrollbar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h redisplay.h scrollbar-x.h scrollbar.h specifier.h window-impl.h window.h winslots.h xintrinsic.h select-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h objects-x.h objects.h opaque.h redisplay.h select-common.h select.h systime.h xintrinsic.h xmotif.h ＠＠ -169,7 +169,7 ＠＠ hftctl.o: $(LISP_H) sysfile.h hpplay.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h sound.h imgproc.o: $(LISP_H) imgproc.h indent.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console.h device.h extents.h faces.h frame.h glyphs.h insdel.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h -inline.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk.h console-impl.h console-msw.h console.h database.h device-impl.h device.h devslots.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h intl-auto-encap-win32.h keymap.h lstream.h objects-impl.h objects.h opaque.h process.h rangetab.h redisplay.h scrollbar.h specifier.h syntax.h sysdll.h sysfile.h systime.h syswindows.h toolbar.h tooltalk.h ui-gtk.h window-impl.h window.h winslots.h xintrinsic.h +inline.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk.h console-impl.h console-msw.h console.h database.h device-impl.h device.h devslots.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h intl-auto-encap-win32.h keymap.h lstream.h objects-impl.h objects.h opaque.h process.h rangetab.h redisplay.h scrollbar.h specifier.h syntax.h sysdll.h sysfile.h systime.h syswindows.h toolbar.h tooltalk.h ui-gtk.h window-impl.h window.h winslots.h xft-fonts.h xintrinsic.h input-method-motif.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device.h frame-impl.h frame.h frameslots.h redisplay.h xintrinsic.h xmotif.h input-method-xlib.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h redisplay.h scrollbar.h systime.h window-impl.h window.h winslots.h xintrinsic.h insdel.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console.h device.h extents.h frame.h insdel.h line-number.h lstream.h redisplay.h ＠＠ -271,4 +271,5 ＠＠ vm-limit.o: $(LISP_H) mem-limits.h widget.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h win32.o: $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h console-msw.h console.h hash.h intl-auto-encap-win32.h profile.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h window.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h faces.h frame-impl.h frame.h frameslots.h glyphs.h gutter.h objects.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +xft-fonts.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h hash.h objects-impl.h objects-x-impl.h objects-x.h objects.h specifier.h xft-fonts.h xintrinsic.h xmu.o: $(CONFIG_H)

1 participants
0 comments

CVS update by stephent xemacs/tests/autoconf ... 19 years, 1 month

CVS Monitor

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

1 participants
0 comments

CVS update by vins xemacs/src ... 19 years, 1 month

CVS Monitor

User: vins Date: 05/11/26 04:47:49 Branch: xemacs/lisp release-21-4 xemacs/lwlib release-21-4 xemacs/man release-21-4 xemacs/man/lispref release-21-4 xemacs/src release-21-4 Modified: xemacs/src ChangeLog callproc.c depend unexelf.c Log: More (old) patches for 21.4.18. Revision Changes Path 1.266.2.84 +18 -0 XEmacs/xemacs/lisp/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v retrieving revision 1.266.2.83 retrieving revision 1.266.2.84 diff -u -p -r1.266.2.83 -r1.266.2.84 --- ChangeLog 2005/11/25 02:01:48 1.266.2.83 +++ ChangeLog 2005/11/26 03:47:23 1.266.2.84 ＠＠ -1,3 +1,21 ＠＠ +2002-05-13 Adrian Aichner <adrian(a)xemacs.org> + + * code-process.el (call-process): Process-related docstring + improvements spurred by Norbert Koch. + * code-process.el (call-process-region): Ditto. + * code-process.el (start-process): Ditto. + +2005-10-09 Adrian Aichner <adrian(a)xemacs.org> + + * finder.el (finder-find-library): Return filename actually + searched for. + +2005-10-10 Steve Youngs <steve(a)sxemacs.org> + + * help.el (view-emacs-news): Use `expand-file-name' instead of + `locate-data-file' as the latter will find any "NEWS" files that + might exist in packages _before_ the one in core. + 2005-06-06 Adrian Aichner <adrian(a)xemacs.org> * package-get.el (package-get-init-package): 1.6.2.2 +8 -4 XEmacs/xemacs/lisp/code-process.el Index: code-process.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/code-process.el,v retrieving revision 1.6.2.1 retrieving revision 1.6.2.2 diff -u -p -r1.6.2.1 -r1.6.2.2 --- code-process.el 2003/08/14 23:42:50 1.6.2.1 +++ code-process.el 2005/11/26 03:47:25 1.6.2.2 ＠＠ -50,6 +50,8 ＠＠ or a cons of coding systems which are us The program's input comes from file INFILE (nil means `/dev/null'). Insert output in BUFFER before point; t means current buffer; nil for BUFFER means discard it; 0 means discard and don't wait. +If BUFFER is a string, then find or create a buffer with that name, +then insert the output in that buffer, before point. BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, REAL-BUFFER says what to do with standard output, as above, while STDERR-FILE says what to do with standard error in the child. ＠＠ -100,6 +102,8 ＠＠ Delete the text if fourth arg DELETEP is Insert output in BUFFER before point; t means current buffer; nil for BUFFER means discard it; 0 means discard and don't wait. +If BUFFER is a string, then find or create a buffer with that name, +then insert the output in that buffer, before point. BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, REAL-BUFFER says what to do with standard output, as above, while STDERR-FILE says what to do with standard error in the child. ＠＠ -158,10 +162,10 ＠＠ found, they default to `nil' for both in Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer or (buffer-name) to associate with the process. - Process output goes at end of that buffer, unless you specify - an output stream or filter function to handle the output. - BUFFER may be also nil, meaning that this process is not associated - with any buffer +Process output goes at end of that buffer, unless you specify +an output stream or filter function to handle the output. +BUFFER may also be nil, meaning that this process is not associated +with any buffer. Third arg is program file name. It is searched for as in the shell. Remaining arguments are strings to give program as arguments. 1.5.2.1 +1 -1 XEmacs/xemacs/lisp/finder.el Index: finder.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/finder.el,v retrieving revision 1.5 retrieving revision 1.5.2.1 diff -u -p -r1.5 -r1.5.2.1 --- finder.el 2001/04/12 18:21:19 1.5 +++ finder.el 2005/11/26 03:47:25 1.5.2.1 ＠＠ -287,7 +287,7 ＠＠ arguments compiles from `load-path'." found) (while (and dirs (not found)) (if (file-exists-p (expand-file-name (concat file ".el") (car dirs))) - (setq found (expand-file-name file (car dirs))) + (setq found (expand-file-name (concat file ".el") (car dirs))) (if (file-exists-p (expand-file-name file (car dirs))) (setq found (expand-file-name file (car dirs))))) (setq dirs (cdr dirs))) 1.30.2.5 +1 -1 XEmacs/xemacs/lisp/help.el Index: help.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/help.el,v retrieving revision 1.30.2.4 retrieving revision 1.30.2.5 diff -u -p -r1.30.2.4 -r1.30.2.5 --- help.el 2004/09/23 03:02:31 1.30.2.4 +++ help.el 2005/11/26 03:47:25 1.30.2.5 ＠＠ -736,7 +736,7 ＠＠ of the key sequence that ran this comman (defun view-emacs-news () "Display info on recent changes to XEmacs." (interactive) - (Help-find-file (locate-data-file "NEWS"))) + (Help-find-file (expand-file-name "NEWS" data-directory))) (defun xemacs-www-page () "Go to the XEmacs World Wide Web page." 1.23.2.27 +6 -0 XEmacs/xemacs/lwlib/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/ChangeLog,v retrieving revision 1.23.2.26 retrieving revision 1.23.2.27 diff -u -p -r1.23.2.26 -r1.23.2.27 --- ChangeLog 2005/02/06 19:23:40 1.23.2.26 +++ ChangeLog 2005/11/26 03:47:33 1.23.2.27 ＠＠ -1,3 +1,9 ＠＠ +2005-03-07 Stephen J. Turnbull <stephen(a)xemacs.org> + + * lwlib-Xlw.c (build_tabs_in_widget): Correctly disable geometry + negotiation for tab children. + (xlw_create_tab_control): Don't set nonexistent resizable resource. + 2005-02-06 Vin Shelton <acs(a)xemacs.org> * XEmacs 21.4.17 is released 1.8.2.2 +20 -6 XEmacs/xemacs/lwlib/lwlib-Xlw.c Index: lwlib-Xlw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-Xlw.c,v retrieving revision 1.8.2.1 retrieving revision 1.8.2.2 diff -u -p -r1.8.2.1 -r1.8.2.2 --- lwlib-Xlw.c 2001/10/23 08:35:22 1.8.2.1 +++ lwlib-Xlw.c 2005/11/26 03:47:33 1.8.2.2 ＠＠ -324,13 +324,21 ＠＠ xlw_update_scrollbar (widget_instance *i #ifdef LWLIB_TABS_LUCID /* tab control - lwlib is such an incredible hairy crock. I just cannot believe + [[ lwlib is such an incredible hairy crock. I just cannot believe it! There are random dependencies between functions, there is a total lack of genericity, even though it initially appears to be generic. It should all be junked and begun again. Building tabs are an example - in theory we should be able to reuse a lot of the general stuff because we want to put labels of whatever toolkit we - are using in the tab. Instead we have to hack it by hand. */ + are using in the tab. Instead we have to hack it by hand. ]] + While lwlib is a hairy crock, whoever wrote that seems to misunderstand + Falk's tab control widget. The tab control widget has *two* kinds of + children: *widgets*, which all occupy a *single* pane below the row of + tabs---this is where the labels created in build_tabs_in_widget go, and + *gadgets*, the tabs themselves, which do *not* draw themselves, but + rather are drawn by the control. In fact, in XEmacs the true widget + children are *never* visible! So this case is not a problem in the + design of lwlib, but rather of Falk's widget. -- sjt */ static void xlw_tab_control_callback (Widget w, XtPointer client_data, XtPointer call_data) { ＠＠ -380,9 +388,8 ＠＠ xlw_create_tab_control (widget_instance widget_value* val = instance->info->val; XtSetArg (al [ac], XtNsensitive, val->enabled); ac++; - XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XtNmappedWhenManaged, False); ac++; XtSetArg (al [ac], XtNorientation, XtorientHorizontal); ac++; - XtSetArg (al [ac], XtNresizable, False); ac++; /* add any args the user supplied for creation time */ lw_add_value_args_to_args (val, al, &ac); ＠＠ -401,15 +408,22 ＠＠ static void build_tabs_in_widget (widget widget_value* val) { widget_value* cur = val; + Arg al[1]; + + /* Children are always invisible, don't permit resizing. */ + XtSetArg (al[0], XtNresizable, False); + for (cur = val; cur; cur = cur->next) { if (cur->value) { + Widget w; #ifdef LWLIB_WIDGETS_MOTIF - xm_create_label (widget, cur); + w = xm_create_label (widget, cur); #else - xaw_create_label (widget, cur); + w = xaw_create_label (widget, cur); #endif + XtSetValues (w, al, 1); } cur->change = NO_CHANGE; } 1.116.2.58 +5 -0 XEmacs/xemacs/man/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/man/ChangeLog,v retrieving revision 1.116.2.57 retrieving revision 1.116.2.58 diff -u -p -r1.116.2.57 -r1.116.2.58 --- ChangeLog 2005/02/24 03:06:17 1.116.2.57 +++ ChangeLog 2005/11/26 03:47:34 1.116.2.58 ＠＠ -1,3 +1,8 ＠＠ +2005-01-19 Aidan Kehoe <kehoea(a)parhasard.net> + + * lispref/mule.texi (CCL Example): Detail an implementation of the + web's URL encoding as a CCL coding system example. + 2005-02-23 Aidan Kehoe <kehoea(a)parhasard.net> * lispref/searching.texi (Syntax of Regexps): 1.4.2.3 +271 -5 XEmacs/xemacs/man/lispref/mule.texi Index: mule.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/man/lispref/mule.texi,v retrieving revision 1.4.2.2 retrieving revision 1.4.2.3 diff -u -p -r1.4.2.2 -r1.4.2.3 --- mule.texi 2002/08/20 11:35:49 1.4.2.2 +++ mule.texi 2005/11/26 03:47:36 1.4.2.3 ＠＠ -1723,7 +1723,7 ＠＠ depends on the keyword). * CCL Statements:: Semantics of CCL statements. * CCL Expressions:: Operators and expressions in CCL. * Calling CCL:: Running CCL programs. -* CCL Examples:: The encoding functions for Big5 and KOI-8. +* CCL Example:: A trivial program to transform the Web's URL encoding. ＠end menu ＠node CCL Syntax, CCL Statements, , CCL ＠＠ -1942,7 +1942,7 ＠＠ complicated transformation of the Japane Shift JIS. CCL_DECODE_SJIS is its inverse.) It is somewhat odd to represent the SJIS operations in infix form. -＠node Calling CCL, CCL Examples, CCL Expressions, CCL +＠node Calling CCL, CCL Example, CCL Expressions, CCL ＠comment Node, Next, Previous, Up ＠subsection Calling CCL ＠＠ -2008,11 +2008,277 ＠＠ value and 0. Resets the CCL interpreter's internal elapsed time registers. ＠end defun -＠node CCL Examples, , Calling CCL, CCL +＠node CCL Example, , Calling CCL, CCL ＠comment Node, Next, Previous, Up -＠subsection CCL Examples +＠subsection CCL Example - This section is not yet written. + In this section, we describe the implementation of a trivial coding +system to transform from the Web's URL encoding to XEmacs' internal +coding. Many people will have been first exposed to URL encoding when +they saw ``%20'' where they expected a space in a file's name on their +local hard disk; this can happen when a browser saves a file from the +web and doesn't encode the name, as passed from the server, properly. + + URL encoding itself is underspecified with regard to encodings beyond +ASCII. The relevant document, RFC 1738, explicitly doesn't give any +information on how to encode non-ASCII characters, and the ``obvious'' +way---use the %xx values for the octets of the eight bit MIME character +set in which the page was served---breaks when a user types a character +outside that character set. Best practice for web development is to +serve all pages as UTF-8 and treat incoming form data as using that +coding system. (Oh, and gamble that your clients won't ever want to +type anything outside Unicode. But that's not so much of a gamble with +today's client operating systems.) We don't treat non-ASCII in this +example, as dealing with ＠samp{(read-multibyte-character ...)} and +errors therewith would make it much harder to understand. + + Since CCL isn't a very rich language, we move much of the logic that +would ordinarily be computed from operations like ＠code{(member ..)}, +＠code{(and ...)} and ＠code{(or ...)} into tables, from which register +values are read and written, and on which ＠code{if} statements are +predicated. Much more of the implementation of this coding system is +occupied with constructing these tables---in normal Emacs Lisp---than it +is with actual CCL code. + + All the ＠code{defvar} statements we deal with in the next few sections +are surrounded by a ＠code{(eval-and-compile ...)}, which means that the +logic which initializes these variables executes at compile time, and if +XEmacs loads the compiled version of the file, these variables are +initialized as constants. + +＠menu +* Four bits to ASCII:: Two tables used for getting hex digits from ASCII. +* URI Encoding constants:: Useful predefined characters. +* Numeric to ASCII-hexadecimal conversion:: Trivial in Lisp, not so in CCL. +* Characters to be preserved:: No transformation needed for these characters. +* The program to decode to internal format:: . +* The program to encode from internal format:: . + +＠end menu + +＠node Four bits to ASCII, URI Encoding constants, , CCL Example +＠subsubsection Four bits to ASCII + + The first ＠code{defvar} is for +＠code{url-coding-high-order-nybble-as-ascii}, a 256-entry table that +maps from an octet's value to the ASCII encoding for the hex value of +its most significant four bits. That might sound complex, but it isn't; +for decimal 65, hex value ＠samp{#x41}, the entry in the table is the +ASCII encoding of `4'. For decimal 122, ASCII `z', hex value +＠code{#x7a}, ＠code{(elt url-coding-high-order-nybble-as-ascii #x7a)} +after this file is loaded gives the ASCII encoding of 7. + +＠example +(defvar url-coding-high-order-nybble-as-ascii + (let ((val (make-vector 256 0)) + (i 0)) + (while (< i (length val)) + (aset val i (char-int (aref (format "%02X" i) 0))) + (setq i (1+ i))) + val) + "Table to find an ASCII version of an octet's most significant 4 bits.") +＠end example + + The next table, ＠code{url-coding-low-order-nybble-as-ascii} is almost +the same thing, but this time it has a map for the hex encoding of the +low-order four bits. So the sixty-fifth entry (offset ＠samp{#x51}) is +the ASCII encoding of `1', the hundred-and-twenty-second (offset +＠samp{#x7a}) is the ASCII encoding of `A'. + +＠example +(defvar url-coding-low-order-nybble-as-ascii + (let ((val (make-vector 256 0)) + (i 0)) + (while (< i (length val)) + (aset val i (char-int (aref (format "%02X" i) 1))) + (setq i (1+ i))) + val) + "Table to find an ASCII version of an octet's least significant 4 bits.") +＠end example + +＠node URI Encoding constants, Numeric to ASCII-hexadecimal conversion, Four bits to ASCII, CCL Example +＠subsubsection URI Encoding constants + + Next, we have a couple of variables that make the CCL code more +readable. The first is the ASCII encoding of the percentage sign; this +character is used as an escape code, to start the encoding of a +non-printable character. For historical reasons, URL encoding allows +the space character to be encoded as a plus sign--it does make typing +URLs like ＠samp{http://google.com/search?q=XEmacs+home+page} easier--and +as such, we have to check when decoding for this value, and map it to +the space character. When doing this in CCL, we use the +＠code{url-coding-escaped-space-code} variable. + +＠example +(defvar url-coding-escape-character-code (char-int ?%) + "The code point for the percentage sign, in ASCII.") + +(defvar url-coding-escaped-space-code (char-int ?+) + "The URL-encoded value of the space character, that is, +.") +＠end example + +＠node Numeric to ASCII-hexadecimal conversion +＠subsubsection Numeric to ASCII-hexadecimal conversion + + Now, we have a couple of utility tables that wouldn't be necessary in +a more expressive programming language than is CCL. The first is sixteen +in length, and maps a hexadecimal number to the ASCII encoding of that +number; so zero maps to ASCII `0', ten maps to ASCII `A.' The second +does the reverse; that is, it maps an ASCII character to its value when +interpreted as a hexadecimal digit. ('A' => 10, 'c' => 12, '2' => 2, as +a few examples.) + +＠example +(defvar url-coding-hex-digit-table + (let ((i 0) + (val (make-vector 16 0))) + (while (< i 16) + (aset val i (char-int (aref (format "%X" i) 0))) + (setq i (1+ i))) + val) + "A map from a hexadecimal digit's numeric value to its encoding in ASCII.") + +(defvar url-coding-latin-1-as-hex-table + (let ((val (make-vector 256 0)) + (i 0)) + (while (< i (length val)) + ;; Get a hex val for this ASCII character. + (aset val i (string-to-int (format "%c" i) 16)) + (setq i (1+ i))) + val) + "A map from Latin 1 code points to their values as hexadecimal digits.") +＠end example + +＠node Characters to be preserved +＠subsubsection Characters to be preserved + + And finally, the last of these tables. URL encoding says that +alphanumeric characters, the underscore, hyphen and the full stop +＠footnote{That's what the standards call it, though my North American +readers will be more familiar with it as the period character.} retain +their ASCII encoding, and don't undergo transformation. +＠code{url-coding-should-preserve-table} is an array in which the entries +are one if the corresponding ASCII character should be left as-is, and +zero if they should be transformed. So the entries for all the control +and most of the punctuation charcters are zero. Lisp programmers will +observe that this initialization is particularly inefficient, but +they'll also be aware that this is a long way from an inner loop where +every nanosecond counts. + +＠example +(defvar url-coding-should-preserve-table + (let ((preserve + (list ?- ?_ ?. ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o + ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D ?E ?F ?G + ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y + ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (i 0) + (res (make-vector 256 0))) + (while (< i 256) + (when (member (int-char i) preserve) + (aset res i 1)) + (setq i (1+ i))) + res) + "A 256-entry array of flags, indicating whether or not to preserve an +octet as its ASCII encoding.") +＠end example + +＠node The program to decode to internal format +＠subsubsection The program to decode to internal format + + After the almost interminable tables, we get to the CCL. The first +CCL program, ＠code{ccl-decode-urlcoding} decodes from the URL coding to +our internal format; since this version of CCL doesn't have support for +error checking on the input, we don't do any verification on it. + +The buffer magnification--approximate ratio of the size of the output +buffer to the size of the input buffer--is declared as one, because +fractional values aren't allowed. (Since all those %20's will map to +` ', the length of the output text will be less than that of the input +text.) + +So, first we read an octet from the input buffer into register +＠samp{r0}, to set up the loop. Next, we start the loop, with a +＠code{(loop ...)} statement, and we check if the value in ＠samp{r0} is a +percentage sign. (Note the comma before +＠code{url-coding-escape-character-code}; since CCL is a Lisp macro +language, we can break out of the macro evaluation with a comman, and as +such, ``＠code{,url-coding-escape-character-code}'' will be evaluated as a +literal `37.') + +If it is a percentage sign, we read the next two octets into ＠samp{r2} +and ＠samp{r3}, and convert them into their hexadecimal numeric values, +using the ＠code{url-coding-latin-1-as-hex-table} array declared above. +(But again, it'll be interpreted as a literal array.) We then left +shift the first by four bits, mask the two together, and write the +result to the output buffer. + +If it isn't a percentage sign, and it is a `+' sign, we write a +space--hexadecimal 20--to the output buffer. + +If none of those things are true, we pass the octet to the output buffer +untransformed. (This could be a place to put error checking, in a more +expressive language.) We then read one more octet from the input +buffer, and move to the next iteration of the loop. + +＠example +(define-ccl-program ccl-decode-urlcoding + `(1 + ((read r0) + (loop + (if (r0 == ,url-coding-escape-character-code) + ((read r2 r3) + ;; Assign the value at offset r2 in the url-coding-hex-digit-table + ;; to r3. + (r2 = r2 ,url-coding-latin-1-as-hex-table) + (r3 = r3 ,url-coding-latin-1-as-hex-table) + (r2 <<= 4) + (r3 |= r2) + (write r3)) + (if (r0 == ,url-coding-escaped-space-code) + (write #x20) + (write r0))) + (read r0) + (repeat)))) + "CCL program to take URI-encoded ASCII text and transform it to our +internal encoding. ") +＠end example + +＠node The program to encode from internal format +＠subsubsection The program to encode from internal format + + Next, we see the CCL program to encode ASCII text as URL coded text. +Here, the buffer magnification is specified as three, to account for ` ' +mapping to %20, etc. As before, we read an octet from the input into +＠samp{r0}, and move into the body of the loop. Next, we check if we +should preserve the value of this octet, by reading from offset +＠samp{r0} in the ＠code{url-coding-should-preserve-table} into ＠samp{r1}. +Then we have an ＠samp{if} statement predicated on the value in +＠samp{r1}; for the true branch, we write the input octet directly. For +the false branch, we write a percentage sign, the ASCII encoding of the +high four bits in hex, and then the ASCII encoding of the low four bits +in hex. + +We then read an octet from the input into ＠samp{r0}, and repeat the loop. + +＠example +(define-ccl-program ccl-encode-urlcoding + `(3 + ((read r0) + (loop + (r1 = r0 ,url-coding-should-preserve-table) + ;; If we should preserve the value, just write the octet directly. + (if r1 + (write r0) + ;; else, write a percentage sign, and the hex value of the octet, in + ;; an ASCII-friendly format. + ((write ,url-coding-escape-character-code) + (write r0 ,url-coding-high-order-nybble-as-ascii) + (write r0 ,url-coding-low-order-nybble-as-ascii))) + (read r0) + (repeat)))) + "CCL program to encode octets (almost) according to RFC 1738") +＠end example ＠node Category Tables, , CCL, MULE ＠section Category Tables 1.290.2.97 +9 -0 XEmacs/xemacs/src/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v retrieving revision 1.290.2.96 retrieving revision 1.290.2.97 diff -u -p -r1.290.2.96 -r1.290.2.97 --- ChangeLog 2005/11/25 02:01:53 1.290.2.96 +++ ChangeLog 2005/11/26 03:47:38 1.290.2.97 ＠＠ -1,3 +1,12 ＠＠ +2002-05-13 Adrian Aichner <adrian(a)xemacs.org> + + * callproc.c: Process-related docstring improvements spurred by + Norbert Koch. + +2005-11-25 Vin Shelton <acs(a)xemacs.org> + + * depend: Regenerated. + 2005-07-11 Malcolm Purvis <malcolmp(a)xemacs.org> * glyphs-gtk.c: Rename a local static variable because gcc 4.0 1.37.2.4 +2 -0 XEmacs/xemacs/src/Attic/callproc.c Index: callproc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/callproc.c,v retrieving revision 1.37.2.3 retrieving revision 1.37.2.4 diff -u -p -r1.37.2.3 -r1.37.2.4 --- callproc.c 2005/11/25 02:01:56 1.37.2.3 +++ callproc.c 2005/11/26 03:47:42 1.37.2.4 ＠＠ -170,6 +170,8 ＠＠ Arguments are The program's input comes from file INFILE (nil means `/dev/null'). Insert output in BUFFER before point; t means current buffer; nil for BUFFER means discard it; 0 means discard and don't wait. +If BUFFER is a string, then find or create a buffer with that name, +then insert the output in that buffer, before point. BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, REAL-BUFFER says what to do with standard output, as above, while STDERR-FILE says what to do with standard error in the child. 1.22.2.4 +1 -1 XEmacs/xemacs/src/depend Index: depend =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/depend,v retrieving revision 1.22.2.3 retrieving revision 1.22.2.4 diff -u -p -r1.22.2.3 -r1.22.2.4 --- depend 2004/12/05 03:26:23 1.22.2.3 +++ depend 2005/11/26 03:47:43 1.22.2.4 ＠＠ -91,7 +91,7 ＠＠ blocktype.o: $(LISP_H) blocktype.h buffer.o: $(LISP_H) buffer.h bufslots.h casetab.h chartab.h commands.h conslots.h console.h device.h elhash.h extents.h faces.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h lstream.h mule-charset.h process.h redisplay.h scrollbar.h select.h specifier.h syntax.h sysdep.h sysfile.h toolbar.h window.h winslots.h bytecode.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h chartab.h mule-charset.h opaque.h syntax.h callint.o: $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h chartab.h commands.h events.h insdel.h mule-charset.h redisplay.h scrollbar.h systime.h window.h winslots.h -callproc.o: $(LISP_H) buffer.h bufslots.h casetab.h chartab.h commands.h file-coding.h insdel.h lstream.h mule-charset.h nt.h process.h redisplay.h scrollbar.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswindows.h window.h winslots.h +callproc.o: $(LISP_H) buffer.h bufslots.h casetab.h chartab.h commands.h file-coding.h insdel.h lstream.h mule-charset.h ndir.h nt.h process.h redisplay.h scrollbar.h sysdep.h sysdir.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswindows.h window.h winslots.h casefiddle.o: $(LISP_H) buffer.h bufslots.h casetab.h chartab.h insdel.h mule-charset.h syntax.h casetab.o: $(LISP_H) buffer.h bufslots.h casetab.h chartab.h mule-charset.h opaque.h chartab.o: $(LISP_H) buffer.h bufslots.h casetab.h chartab.h mule-charset.h syntax.h 1.15.2.3 +1 -1 XEmacs/xemacs/src/unexelf.c Index: unexelf.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/unexelf.c,v retrieving revision 1.15.2.2 retrieving revision 1.15.2.3 diff -u -p -r1.15.2.2 -r1.15.2.3 --- unexelf.c 2005/01/11 02:02:38 1.15.2.2 +++ unexelf.c 2005/11/26 03:47:43 1.15.2.3 ＠＠ -475,7 +475,7 ＠＠ typedef struct { # include <sys/exec_elf.h> #endif -#if defined(__FreeBSD__) && (defined(__alpha__) || defined(__amd64__)) +#if defined(__FreeBSD__) && (defined(__alpha__) || defined(_LP64)) # ifdef __STDC__ # define ElfW(type) Elf64_##type # else

1 participants
0 comments

CVS update by viteno xemacs ... 19 years, 1 month

CVS Monitor

User: viteno Date: 05/11/25 23:51:38 Modified: xemacs version.sh Log: Update xemacs_extra_name. Revision Changes Path 1.1355 +1 -1 XEmacs/xemacs/version.sh Index: version.sh =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/version.sh,v retrieving revision 1.1354 retrieving revision 1.1355 diff -u -p -r1.1354 -r1.1355 --- version.sh 2005/11/24 22:51:25 1.1354 +++ version.sh 2005/11/25 22:51:38 1.1355 ＠＠ -8,5 +8,5 ＠＠ emacs_kit_version= infodock_major_version=4 infodock_minor_version=0 infodock_build_version=8 -xemacs_extra_name="(+CVS-20051124)" +xemacs_extra_name="(+CVS-20051125)" xemacs_release_date="2005-10-26"

1 participants
0 comments

← Newer
1
2
3
4
5
6
7
8
...
17
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

xemacs-cvs November 2005