October 2006 - XEmacs-Patches - XEmacs Mailing List Archives

[PATCH] Update man page for init file, one nroff format error 17 years, 2 months

Shyamal Prasad

etc/ChangeLog addition: 2004-12-03 Shyamal Prasad <shyamal(a)member.fsf.org> * xemacs.1: Now describe $HOME/.xemacs/init.el as the preferred init file. Fixed excessive space insertion in the description of the '-vanilla' option XEmacs source patch: Diff command: cvs -q diff -u Files affected: etc/xemacs.1 Index: etc/xemacs.1 =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/xemacs.1,v retrieving revision 1.13 diff -u -r1.13 xemacs.1 --- etc/xemacs.1 2001/04/12 18:20:52 1.13 +++ etc/xemacs.1 2004/12/04 01:33:45 ＠＠ -147,12 +147,7 ＠＠ .TP .B \-vanilla Load no extra files at startup. Equivalent to the combination of -.B \-q -, -.B \-no-site-file -, and -.B \-no-early-packages -\. +.BR \-q ", " \-no-site-file ", and " \-no-early-packages . .TP .BI \-u " user, " \-user " user" Load ＠＠ -628,7 +623,8 ＠＠ META-left Make a rectangular selection. .SH FILES Lisp code is read at startup from the user's init file, -\fB$HOME/.emacs\fP. +\fB$HOME/.xemacs/init.el\fP. If this file does not exist then +\fB$HOME/.emacs\fP will be read if it is present. /usr/local/info - files for the Info documentation browser (a subsystem of

2 participants
1 comments

[PATCH] Synch up format-time-string % specifiers with Emacs 21.3.1 17 years, 2 months

Shyamal Prasad

This patch adds % specifiers to format-time-string that are missing in XEmacs but supported by Emacs 21.3.1 src/ChangeLog addition: 2004-12-08 Shyamal Prasad <shyamal(a)member.fsf.org> * editfns.c: * editfns.c (Fformat_time_string): Added documentation for %z, %g, %G and %V specifiers. This synchs up the set of % specifiers for format-time-string with Emacs 21.3.1. Make copy of static buffer returned by localtime(). * strftime.c: * strftime.c (strftime): Implemented %z, %g, %G and %V in a style similar to existing implementation of other specifiers. XEmacs source patch: Diff command: cvs -q diff -u Files affected: src/strftime.c src/editfns.c Index: src/editfns.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/editfns.c,v retrieving revision 1.51 diff -u -r1.51 editfns.c --- src/editfns.c 2004/12/06 03:52:03 1.51 +++ src/editfns.c 2004/12/09 02:40:17 ＠＠ -1015,6 +1015,8 ＠＠ %d is replaced by the day of month, zero-padded. %D is a synonym for "%m/%d/%y". %e is replaced by the day of month, blank-padded. +%G is replaced by the year containing the ISO 8601 week +%g is replaced by the year of the ISO 8601 week within the century (00-99) %h is a synonym for "%b". %H is replaced by the hour (00-23). %I is replaced by the hour (00-12). ＠＠ -1033,12 +1035,14 ＠＠ %t is a synonym for "\\t". %T is a synonym for "%H:%M:%S". %U is replaced by the week of the year (00-53), first day of week is Sunday. +%V is replaced by the ISO 8601 week number %w is replaced by the day of week (0-6), Sunday is day 0. %W is replaced by the week of the year (00-53), first day of week is Monday. %x is a locale-specific synonym, which defaults to "%D" in the C locale. %X is a locale-specific synonym, which defaults to "%T" in the C locale. %y is replaced by the year without century (00-99). %Y is replaced by the year with century. +%z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.) %Z is replaced by the time zone abbreviation. The number of options reflects the `strftime' function. ＠＠ -1063,13 +1067,15 ＠＠ { Extbyte *buf = alloca_extbytes (size); Extbyte *formext; + /* make a copy of the static buffer returned by localtime() */ + struct tm tm = * localtime(&value); + *buf = 1; /* !!#### this use of external here is not totally safe, and potentially data lossy. */ LISP_STRING_TO_EXTERNAL (format_string, formext, Qnative); - if (emacs_strftime (buf, size, formext, - localtime (&value)) + if (emacs_strftime (buf, size, formext, &tm) || !*buf) return build_ext_string (buf, Qnative); /* If buffer was too small, make it bigger. */ Index: src/strftime.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/strftime.c,v retrieving revision 1.6 diff -u -r1.6 strftime.c --- src/strftime.c 2002/03/29 04:48:37 1.6 +++ src/strftime.c 2004/12/09 02:40:18 ＠＠ -58,6 +58,7 ＠＠ %S second (00..61) %T time, 24-hour (hh:mm:ss) %X locale's time representation (%H:%M:%S) + %z time zone offset (e.g. +0530, -0800 etc) %Z time zone (EDT), or nothing if no time zone is determinable Date fields: ＠＠ -70,10 +71,13 ＠＠ %d day of month (01..31) %e day of month ( 1..31) %D date (mm/dd/yy) + %G year corresponding to the ISO 8601 week + %g Year of the ISO 8601 week within century (00 - 99) %h same as %b %j day of year (001..366) %m month (01..12) %U week number of year with Sunday as first day of week (00..53) + %V ISO 8601 week number (first week is the earliest one with Thu) %w day of week (0..6) %W week number of year with Monday as first day of week (00..53) %x locale's date representation (mm/dd/yy) ＠＠ -235,6 +239,30 ＠＠ return dl <= 0 ? 0 : dl / 7 + (dl % 7 != 0); } +#ifndef __isleap +/* Nonzero if YEAR is a leap year (every 4 years, + except every 100th isn't, and every 400th is). */ +# define __isleap(year) \ + ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) +#endif + +/* The number of days from the first day of the first ISO week of this + year to the year day YDAY with week day WDAY. ISO weeks start on + Monday; the first ISO week has the year's first Thursday. YDAY may + be as small as YDAY_MINIMUM. */ +#define ISO_WEEK_START_WDAY 1 /* Monday */ +#define ISO_WEEK1_WDAY 4 /* Thursday */ +#define YDAY_MINIMUM (-366) +static int +iso_week_days (int yday, int wday) +{ + /* Add enough to the first operand of % to make it nonnegative. */ + int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; + return (yday + - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 + + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); +} + #if !defined(HAVE_TM_ZONE) && !defined(HAVE_TZNAME) char *zone_name (const struct tm *tp); char * ＠＠ -362,10 +390,125 ＠＠ length += strftime (&string[length], max - length, "%H:%M:%S", tm); break; + + case 'V': + case 'g': + case 'G': + { + int year = tm->tm_year + 1900; + int days = iso_week_days (tm->tm_yday, tm->tm_wday); + + if (days < 0) + { + /* This ISO week belongs to the previous year. */ + year--; + days = + iso_week_days (tm->tm_yday + (365 + __isleap (year)), + tm->tm_wday); + } + else + { + int d = + iso_week_days (tm->tm_yday - (365 + __isleap (year)), + tm->tm_wday); + if (0 <= d) + { + /* This ISO week belongs to the next year. */ + year++; + days = d; + } + } + + switch (*format) + { + /* + #### FIXME + We really can't assume 1000 <= year <= 9999 + once time_t gets beyond 32 bits, but it's true + of the rest of the code here so get with the + program + */ + case 'g': + length += + add_num2 (&string[length], year % 100, + max - length, pad); + break; + + case 'G': + add_char (year / 1000 + '0'); + length += add_num3 (&string[length], year % 1000, + max - length, zero); + break; + + default: + length += + add_num2 (&string[length], days / 7 + 1, + max - length, pad); + break; + } + } + break; case 'X': length += strftime (&string[length], max - length, "%H:%M:%S", tm); break; + case 'z': + { + /* + #### FIXME: could use tm->tm_gmtoff if present. Since + the other code in xemacs does not do so we follow the + leaders (and don't add a autoconf macro to detect + its presence). + */ + long int offset; + long int minutes; + struct tm lt, *ut; + time_t utc; + + lt = *tm; + utc = mktime(&lt); + ut = gmtime(&utc); + /* assume that tm is valid so the others will be too! */ + assert( utc != (time_t) -1 && ut != NULL ); + + /* tm diff code below is based on mktime.c, glibc 2.3.2 */ + { + int lt4, ut4, lt100, ut100, lt400, ut400; + int intervening_leap_days, years, days; + + lt4 = (lt.tm_year >> 2) + (1900 >> 2) - + ! (lt.tm_year & 3); + ut4 = (ut->tm_year >> 2) + (1900 >> 2) - + ! (ut->tm_year & 3); + lt100 = lt4 / 25 - (lt4 % 25 < 0); + ut100 = ut4 / 25 - (ut4 % 25 < 0); + lt400 = lt100 >> 2; + ut400 = ut100 >> 2; + intervening_leap_days = + (lt4 - ut4) - (lt100 - ut100) + (lt400 - ut400); + years = lt.tm_year - ut->tm_year; + days = (365 * years + intervening_leap_days + + (lt.tm_yday - ut->tm_yday)); + offset = (60 * (60 * (24 * days + (lt.tm_hour - ut->tm_hour)) + + (lt.tm_min - ut->tm_min)) + + (lt.tm_sec - ut->tm_sec)); + } + + minutes = offset / ( offset < 0 ? -60 : 60 ); + + add_char ((offset < 0 ? '-' : '+')); + + if ( minutes / 600 != 0 ) + add_char (minutes / 600 + '0'); + else if ( pad != none ) + add_char ((pad == zero ? '0' : ' ')); + + length += + add_num3 (&string[length], + ((minutes / 60 ) % 10) * 100 + (minutes % 60), + max - length, pad); + break; + } case 'Z': #ifdef HAVE_TM_ZONE length += add_str (&string[length], tm->tm_zone, max - length);

2 participants
1 comments

[PATCH] fix buffer overrun in pdump_load() 17 years, 4 months

Nix

The initial problem was easy to describe: starting XEmacs with absolute paths was broken (at least it is if you use a separate .dmp file, which I'm constrained to right now because I'm using the new GC.) loki 1686 /usr/packages/xemacs/i686-loki% which xemacs /usr/bin/xemacs loki 1687 /usr/packages/xemacs/i686-loki% xemacs -vanilla -batch -eval '(message "foo")' foo loki 1685 /usr/packages/xemacs/i686-loki% /usr/bin/xemacs -vanilla -batch -eval '(message "foo")' temacs can only be run in -batch mode. strace and valgrind (and a bit of gdb) pinpoint the cause: loki 1688 /usr/packages/xemacs/i686-loki% strace -e open /usr/bin/xemacs -vanilla -batch -eval '(message "foo")' [...] open("/lib/libpthread.so.0", O_RDONLY) = 3 open("", O_RDONLY|O_LARGEFILE) = -1 ENOENT (No such file or directory) open("", O_RDONLY|O_LARGEFILE) = -1 ENOENT (No such file or directory) open("", O_RDONLY|O_LARGEFILE) = -1 ENOENT (No such file or directory) open("/etc/fonts/fonts.conf", O_RDONLY|O_LARGEFILE) = 3 [...] ==29209== Syscall param open(filename) points to unaddressable byte(s) ==29209== at 0x4D873272: open64 (in /lib/libc-2.4.so) ==29209== Address 0xBEBA0070 is not stack'd, malloc'd or (recently) free'd If you're unlucky, that "" turns into an -EFAULT, and if you're *really* unlucky, you get a segfault. This is happening because in src/dumper.c:pdump_load(), exe_path is being sized as (if XEmacs is invoked with an absolute path) one byte longer than the length of the directory component of the name, or (if XEmacs is invoked with a relative path) ten bytes longer than the larger of the name and PATH variable... ... and then pdump_load() calls pdump_file_try(), which proceeds to sprintf() things on the end of it, like "-21.5-b27-453712b7.dmp". Oops, there's no room for that. Instant buffer overrun, and because that structure is alloca()ed a lot of the time, instant stack overrun as well, which if you're unlucky blows away a pile of variables, invalidates `exe_path', et seq ad nauseam. (Probably nobody's noticed this because most of the time XEmacs is invoked without an absolute path, and most people have a PATH that is much longer than five characters. I don't know what the ten bytes of slop are for: it's not even long enough for `-21.4.16.dmp'...) I've `fixed' this by moving from incorrect dynamic allocation to arguably inefficient-but-who-cares static allocation: it's way too much work to realloc() this string, and it's also way too much work to determine the maximum possible length of that string (plus it's brittle; the next time someone changes the filename construction method, *boom*). This necessitated a tiny fix to text.h before PATH_MAX_EXTERNAL could be used on non-Windows systems at all... You may want to fix the fix if using PATH_MAX_{INTERNAL,EXTERNAL} is really as bad as all that. (This patch is against CVS HEAD.) 2006-10-26 Nix <nix(a)esperi.org.uk> * dumper.c (pdump_load): Statically allocate a large enough exe_path for all conceivable uses. Fixes a buffer overrun. * text.h (MAX_XETCHAR_SIZE): Define, for PATH_MAX_EXTERNAL. Index: 21.5/src/dumper.c =================================================================== --- 21.5.orig/src/dumper.c 2006-10-26 00:29:53.000000000 +0100 +++ 21.5/src/dumper.c 2006-10-26 00:30:21.000000000 +0100 ＠＠ -2658,7 +2658,7 ＠＠ wext_strcpy (exe_path, wexe); } #else /* !WIN32_NATIVE */ - Wexttext *exe_path; + Wexttext exe_path[PATH_MAX_EXTERNAL]; Wexttext *w; const Wexttext *dir, *p; ＠＠ -2692,8 +2692,7 ＠＠ if (p != dir) { /* invocation-name includes a directory component -- presumably it - is relative to cwd, not $PATH */ - exe_path = alloca_array (Wexttext, 1 + wext_strlen (dir)); + is relative to cwd, not $PATH. */ wext_strcpy (exe_path, dir); } else ＠＠ -2701,9 +2700,6 ＠＠ const Wexttext *path = wext_getenv ("PATH"); /* not egetenv -- not yet init. */ const Wexttext *name = p; - exe_path = alloca_array (Wexttext, - 10 + max (wext_strlen (name), - wext_strlen (path))); for (;;) { p = path; Index: 21.5/src/text.h =================================================================== --- 21.5.orig/src/text.h 2006-10-26 00:29:53.000000000 +0100 +++ 21.5/src/text.h 2006-10-26 00:30:21.000000000 +0100 ＠＠ -2988,6 +2988,7 ＠＠ /* Extra indirection needed in case of manifest constant as arg */ #define WEXTSTRING_1(arg) L##arg #define WEXTSTRING(arg) WEXTSTRING_1(arg) +#define MAX_XETCHAR_SIZE sizeof (WCHAR) #define wext_strlen wcslen #define wext_strcmp wcscmp #define wext_strncmp wcsncmp ＠＠ -3013,6 +3014,7 ＠＠ #else #define WEXTTEXT_ZTERM_SIZE sizeof (char) #define WEXTSTRING(arg) arg +#define MAX_XETCHAR_SIZE sizeof (char) #define wext_strlen strlen #define wext_strcmp strcmp #define wext_strncmp strncmp -- `When we are born we have plenty of Hydrogen but as we age our Hydrogen pool becomes depleted.' _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

3 participants
3 comments

[PATCH (pkgs)] Small AUCTeX tweak 17 years, 7 months

Jerry James

PATCH packages As David Kastrup said on xemacs-beta, using rawfile IS the right thing to do here. I suggest this patch as a stopgap measure until we can figure out how to import the latest version of AUCTeX. This incidentally fixes the building of HISTORY. xemacs-packages/auctex/ChangeLog addition: 2006-08-03 Jerry James <james(a)xemacs.org> * Makefile (EXTRA_SOURCES): Add HISTORY. * Makefile (RUN_MAKEINFO_INDIVIDUAL): Build plain text files with -D rawfile. * Makefile (HISTORY): Builds correctly with the previous fix. packages source patch: Diff command: cvs -q diff -uN Files affected: xemacs-packages/auctex/Makefile Index: xemacs-packages/auctex/Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/auctex/Makefile,v retrieving revision 1.59 diff -d -u -r1.59 Makefile --- xemacs-packages/auctex/Makefile 2005/02/12 17:10:02 1.59 +++ xemacs-packages/auctex/Makefile 2006/08/03 20:20:04 ＠＠ -35,7 +35,7 ＠＠ context-en.elc context-nl.elc tex-fold.elc \ -EXTRA_SOURCES = CHANGES PROBLEMS README FAQ RELEASE TODO \ +EXTRA_SOURCES = CHANGES PROBLEMS README FAQ RELEASE TODO HISTORY \ ChangeLog.auctex tex-site.el \ ETC_ELCS = etc/units.elc etc/nicefrac.elc etc/alltt.elc \ ＠＠ -102,7 +102,7 ＠＠ && texindex auc-tex.vr && texindex auc-tex.cp \ && $(TEX) "\nonstopmode\input auc-tex.texi" -RUN_MAKEINFO_INDIVIDUAL = $(MAKEINFO) -I texi/ --no-validate --force --no-headers -o $＠ $< +RUN_MAKEINFO_INDIVIDUAL = $(MAKEINFO) -D rawfile -I texi/ --no-validate --force --no-headers -o $＠ $< INSTALLATION: texi/install.texi -$(RUN_MAKEINFO_INDIVIDUAL) ＠＠ -113,6 +113,5 ＠＠ CHANGES: texi/changes.texi -$(RUN_MAKEINFO_INDIVIDUAL) -# does not build. HISTORY: texi/history.texi -$(RUN_MAKEINFO_INDIVIDUAL) -- Jerry James, Assistant Professor james(a)xemacs.org Computer Science Department http://www.cs.usu.edu/~jerry/ Utah State University

2 participants
2 comments

[PATCH 21.5] POP sync 18 years

Jerry James

PATCH 21.5 Our current pop.c has a number of problems flagged by some static checkers, but the Emacs version checks clean. Here's a sync so we can be as clean as a whistle, too. lib-src/ChangeLog addition: 2006-08-11 Jerry James <james(a)xemacs.org> * pop.h: Sync with Emacs. * pop.c: Ditto. xemacs-21.5 source patch: Diff command: cvs -q diff -uN Files affected: lib-src/pop.c lib-src/pop.h Index: lib-src/pop.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/pop.h,v retrieving revision 1.2 diff -d -u -r1.2 pop.h --- lib-src/pop.h 2001/06/10 10:42:17 1.2 +++ lib-src/pop.h 2006/08/11 18:22:07 ＠＠ -1,5 +1,6 ＠＠ /* pop.h: Header file for the "pop.c" client POP3 protocol. - Copyright (c) 1991,1993 Free Software Foundation, Inc. + Copyright (C) 1991, 1993, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. Written by Jonathan Kamens, jik(a)security.ov.com. This file is part of XEmacs. ＠＠ -16,8 +17,10 ＠＠ 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. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +/* Synched up with: FSF 22.0.50. */ #include <stdio.h> ＠＠ -59,7 +62,8 ＠＠ extern int pop_stat _ARGS((popserver server, int *count, int *size)); extern int pop_list _ARGS((popserver server, int message, int **IDs, int **size)); -extern char *pop_retrieve _ARGS((popserver server, int message, int markfrom)); +extern int pop_retrieve _ARGS((popserver server, int message, int markfrom, + char **)); extern int pop_retrieve_first _ARGS((popserver server, int message, char **response)); extern int pop_retrieve_next _ARGS((popserver server, char **line)); Index: lib-src/pop.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/pop.c,v retrieving revision 1.10 diff -d -u -r1.10 pop.c --- lib-src/pop.c 2004/09/20 19:19:11 1.10 +++ lib-src/pop.c 2006/08/11 18:22:07 ＠＠ -1,5 +1,6 ＠＠ /* pop.c: client routines for talking to a POP3-protocol post-office server - Copyright (c) 1991, 1993, 1996 Free Software Foundation, Inc. + Copyright (C) 1991, 1993, 1996, 1997, 1999, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. Copyright (C) 2001 Ben Wing. Written by Jonathan Kamens, jik(a)security.ov.com. ＠＠ -17,8 +18,10 ＠＠ 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. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +/* Synched up with: FSF 22.0.50. */ #ifdef HAVE_CONFIG_H #define NO_SHORTNAMES /* Tell config not to load remap.h */ ＠＠ -96,7 +99,7 ＠＠ #ifdef KERBEROS #ifndef KRB5 extern int krb_sendauth (/* long, int, KTEXT, char *, char *, char *, - unsigned long, MSG_DAT *, CREDENTIALS *, Key_schedule, + u_long, MSG_DAT *, CREDENTIALS *, Key_schedule, struct sockaddr_in *, struct sockaddr_in *, char * */); extern char *krb_realmofhost (/* char * */); ＠＠ -110,7 +113,7 ＠＠ #endif static int socket_connection (char *, int); -static char *pop_getline (popserver); +static int pop_getline (popserver, char **); static int sendline (popserver, char *); static int fullwrite (int, char *, int); static int getok (popserver); ＠＠ -118,9 +121,11 ＠＠ static int gettermination (popserver); #endif static void pop_trash (popserver); -static char *find_crlf (char *); +static char *find_crlf (char *, int); -#define ERROR_MAX 80 /* a pretty arbitrary size */ +#define ERROR_MAX 160 /* a pretty arbitrary size, but needs + to be bigger than the original + value of 80 */ #define POP_PORT 110 #define KPOP_PORT 1109 #if defined(WIN32_NATIVE) || defined(CYGWIN) ＠＠ -130,7 +135,7 ＠＠ #endif #ifdef KERBEROS #ifdef KRB5 -#define KPOP_SERVICE "k5pop"; +#define KPOP_SERVICE "k5pop" #else #define KPOP_SERVICE "kpop" #endif ＠＠ -356,7 +361,7 ＠＠ return (-1); } - if (sendline (server, "STAT") || (! (fromserver = pop_getline (server)))) + if (sendline (server, "STAT") || (pop_getline (server, &fromserver) < 0)) return (-1); if (strncmp (fromserver, "+OK ", 4)) ＠＠ -448,7 +453,7 ＠＠ free ((char *) *sizes); return (-1); } - if (! (fromserver = pop_getline (server))) + if (pop_getline (server, &fromserver) < 0) { free ((char *) *IDs); free ((char *) *sizes); ＠＠ -493,7 +498,7 ＠＠ } for (i = 0; i < how_many; i++) { - if (pop_multi_next (server, &fromserver)) + if (pop_multi_next (server, &fromserver) <= 0) { free ((char *) *IDs); free ((char *) *sizes); ＠＠ -512,7 +517,7 ＠＠ } (*sizes)[i] = atoi (fromserver); } - if (pop_multi_next (server, &fromserver)) + if (pop_multi_next (server, &fromserver) < 0) { free ((char *) *IDs); free ((char *) *sizes); ＠＠ -542,14 +547,17 ＠＠ * markfrom * If true, then mark the string "From " at the beginning * of lines with '>'. + * msg_buf Output parameter to which a buffer containing the + * message is assigned. * - * Return value: A string pointing to the message, if successful, or - * null with pop_error set if not. + * Return value: The number of bytes in msg_buf, which may contain + * embedded nulls, not including its final null, or -1 on error + * with pop_error set. * * Side effects: May kill connection on error. */ -char * -pop_retrieve (popserver server, int message, int markfrom) +int +pop_retrieve (popserver server, int message, int markfrom, char **msg_buf) { int *IDs, *sizes, bufsize, fromcount = 0, cp = 0; char *ptr, *fromserver; ＠＠ -562,11 +570,11 ＠＠ } if (pop_list (server, message, &IDs, &sizes)) - return (0); + return (-1); if (pop_retrieve_first (server, message, &fromserver)) { - return (0); + return (-1); } /* ＠＠ -584,17 +592,16 ＠＠ { strcpy (pop_error, "Out of memory in pop_retrieve"); pop_retrieve_flush (server); - return (0); + return (-1); } - while (! (ret = pop_retrieve_next (server, &fromserver))) + while ((ret = pop_retrieve_next (server, &fromserver)) >= 0) { - int linesize; - if (! fromserver) { ptr[cp] = '\0'; - return (ptr); + *msg_buf = ptr; + return (cp); } if (markfrom && fromserver[0] == 'F' && fromserver[1] == 'r' && fromserver[2] == 'o' && fromserver[3] == 'm' && ＠＠ -608,25 +615,19 ＠＠ { strcpy (pop_error, "Out of memory in pop_retrieve"); pop_retrieve_flush (server); - return (0); + return (-1); } fromcount = 0; } ptr[cp++] = '>'; } - linesize = strlen (fromserver); - memcpy (&ptr[cp], fromserver, linesize); - cp += linesize; + memcpy (&ptr[cp], fromserver, ret); + cp += ret; ptr[cp++] = '\n'; } - if (ret) - { - free (ptr); - /* return (0); */ - } - /* This function used to fall off the end, but that doesn't make any sense */ - return (0); + free (ptr); + return (-1); } int ＠＠ -636,6 +637,14 ＠＠ return (pop_multi_first (server, pop_error, response)); } +/* + Returns a negative number on error, 0 to indicate that the data has + all been read (i.e., the server has returned a "." termination + line), or a positive number indicating the number of bytes in the + returned buffer (which is null-terminated and may contain embedded + nulls, but the returned bytecount doesn't include the final null). + */ + int pop_retrieve_next (popserver server, char **line) { ＠＠ -655,6 +664,14 ＠＠ return (pop_multi_first (server, pop_error, response)); } +/* + Returns a negative number on error, 0 to indicate that the data has + all been read (i.e., the server has returned a "." termination + line), or a positive number indicating the number of bytes in the + returned buffer (which is null-terminated and may contain embedded + nulls, but the returned bytecount doesn't include the final null). + */ + int pop_top_next (popserver server, char **line) { ＠＠ -677,7 +694,7 ＠＠ return (-1); } - if (sendline (server, command) || (! (*response = pop_getline (server)))) + if (sendline (server, command) || (pop_getline (server, response) < 0)) { return (-1); } ＠＠ -701,10 +718,20 ＠＠ } } +/* + Read the next line of data from SERVER and place a pointer to it + into LINE. Return -1 on error, 0 if there are no more lines to read + (i.e., the server has returned a line containing only "."), or a + positive number indicating the number of bytes in the LINE buffer + (not including the final null). The data in that buffer may contain + embedded nulls, but does not contain the final CRLF. When returning + 0, LINE is set to null. */ + int pop_multi_next (popserver server, char **line) { char *fromserver; + int ret; if (! server->in_multi) { ＠＠ -712,8 +739,7 ＠＠ return (-1); } - fromserver = pop_getline (server); - if (! fromserver) + if ((ret = pop_getline (server, &fromserver)) < 0) { return (-1); } ＠＠ -729,13 +755,13 ＠＠ else { *line = fromserver + 1; - return (0); + return (ret - 1); } } else { *line = fromserver; - return (0); + return (ret); } } ＠＠ -743,21 +769,22 ＠＠ pop_multi_flush (popserver server) { char *line; + int ret; if (! server->in_multi) { return (0); } - while (! pop_multi_next (server, &line)) + while ((ret = pop_multi_next (server, &line))) { - if (! line) + if (ret < 0) { - return (0); + return (-1); } } - return (-1); + return (0); } /* Function: pop_delete ＠＠ -844,7 +871,7 ＠＠ if (sendline (server, "LAST")) return (-1); - if (! (fromserver = pop_getline (server))) + if (pop_getline (server, &fromserver) < 0) return (-1); if (! strncmp (fromserver, "-ERR", 4)) ＠＠ -968,6 +995,8 ＠＠ #ifdef KERBEROS #ifdef KRB5 krb5_error_code rem; + krb5_context kcontext = 0; + krb5_auth_context auth_context = 0; krb5_ccache ccdef; krb5_principal client, server; krb5_error *err_ret; ＠＠ -978,6 +1007,7 ＠＠ CREDENTIALS cred; Key_schedule schedule; int rem; + char *realhost; #endif /* KRB5 */ #endif /* KERBEROS */ ＠＠ -991,19 +1021,6 ＠＠ } #endif - do - { - hostent = gethostbyname (host); - try_count++; - if ((! hostent) - && ((h_errno != TRY_AGAIN) || (try_count == 5)) - ) - { - strcpy (pop_error, "Could not determine POP server's address"); - return (-1); - } - } while (! hostent); - memset (&addr, 0, sizeof (addr)); addr.sin_family = AF_INET; ＠＠ -1042,18 +1059,29 ＠＠ } } -#define SOCKET_ERROR "Could not create socket for POP connection: " +#define POP_SOCKET_ERROR "Could not create socket for POP connection: " sock = socket (PF_INET, SOCK_STREAM, 0); if (sock < 0) { - strcpy (pop_error, SOCKET_ERROR); + strcpy (pop_error, POP_SOCKET_ERROR); strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (SOCKET_ERROR)); + ERROR_MAX - sizeof (POP_SOCKET_ERROR)); return (-1); } + do + { + hostent = gethostbyname (host); + try_count++; + if ((! hostent) && ((h_errno != TRY_AGAIN) || (try_count == 5))) + { + strcpy (pop_error, "Could not determine POP server's address"); + return (-1); + } + } while (! hostent); + while (*hostent->h_addr_list) { memcpy (&addr.sin_addr, *hostent->h_addr_list, hostent->h_length); ＠＠ -1079,11 +1107,13 ＠＠ if (! (flags & POP_NO_KERBEROS)) { #ifdef KRB5 - krb5_init_ets (); - - if (rem = krb5_cc_default (&ccdef)) + if ((rem = krb5_init_context (&kcontext))) { krb5error: + if (auth_context) + krb5_auth_con_free (kcontext, auth_context); + if (kcontext) + krb5_free_context (kcontext); strcpy (pop_error, KRB_ERROR); strncat (pop_error, error_message (rem), ERROR_MAX - sizeof(KRB_ERROR)); ＠＠ -1091,11 +1121,15 ＠＠ return (-1); } - if (rem = krb5_cc_get_principal (ccdef, &client)) - { - goto krb5error; - } + if ((rem = krb5_auth_con_init (kcontext, &auth_context))) + goto krb5error; + if (rem = krb5_cc_default (kcontext, &ccdef)) + goto krb5error; + + if (rem = krb5_cc_get_principal (kcontext, ccdef, &client)) + goto krb5error; + for (cp = hostent->h_name; *cp; cp++) { if (isupper (*cp)) ＠＠ -1104,22 +1138,20 ＠＠ } } - if (rem = krb5_sname_to_principal (hostent->h_name, POP_SERVICE, - FALSE, &server)) - { - goto krb5error; - } + if (rem = krb5_sname_to_principal (kcontext, hostent->h_name, + POP_SERVICE, FALSE, &server)) + goto krb5error; - rem = krb5_sendauth ((krb5_pointer) &sock, "KPOPV1.0", client, server, + rem = krb5_sendauth (kcontext, &auth_context, + (krb5_pointer) &sock, "KPOPV1.0", client, server, AP_OPTS_MUTUAL_REQUIRED, 0, /* no checksum */ 0, /* no creds, use ccache instead */ ccdef, - 0, /* don't need seq # */ - 0, /* don't need subsession key */ &err_ret, + 0, /* don't need subsession key */ 0); /* don't need reply */ - krb5_free_principal (server); + krb5_free_principal (kcontext, server); if (rem) { if (err_ret && err_ret->text.length) ＠＠ -1142,20 +1174,23 ＠＠ ERROR_MAX - sizeof (KRB_ERROR)); } if (err_ret) - krb5_free_error (err_ret); + krb5_free_error (kcontext, err_ret); + krb5_auth_con_free (kcontext, auth_context); + krb5_free_context (kcontext); CLOSESOCKET (sock); return (-1); } #else /* ! KRB5 */ ticket = (KTEXT) malloc (sizeof (KTEXT_ST)); - rem = krb_sendauth (0L, sock, ticket, "pop", hostent->h_name, - (char *) krb_realmofhost (hostent->h_name), + rem = krb_sendauth (0L, sock, ticket, "pop", realhost, + (char *) krb_realmofhost (realhost), (unsigned long) 0, &msg_data, &cred, schedule, (struct sockaddr_in *) 0, (struct sockaddr_in *) 0, "KPOPV0.1"); free ((char *) ticket); + free (realhost); if (rem != KSUCCESS) { strcpy (pop_error, KRB_ERROR); ＠＠ -1182,15 +1217,20 ＠＠ * Arguments: * server The server from which to get the line of text. * - * Returns: A non-null pointer if successful, or a null pointer on any - * error, with an error message copied into pop_error. + * Returns: The number of characters in the line, which is returned in + * LINE, not including the final null. A return value of 0 + * indicates a blank line. A negative return value indicates an + * error (in which case the contents of LINE are undefined. In + * case of error, an error message is copied into pop_error. * * Notes: The line returned is overwritten with each call to pop_getline. * * Side effects: Closes the connection on error. + * + * THE RETURNED LINE MAY CONTAIN EMBEDDED NULLS! */ -static char * -pop_getline (popserver server) +static int +pop_getline (popserver server, char **line) { #define GETLINE_ERROR "Error reading from server: " ＠＠ -1199,7 +1239,8 ＠＠ if (server->data) { - char *cp = find_crlf (server->buffer + server->buffer_index); + char *cp = find_crlf (server->buffer + server->buffer_index, + server->data); if (cp) { int found; ＠＠ -1213,8 +1254,11 ＠＠ server->buffer_index += data_used; if (pop_debug) + /* Embedded nulls will truncate this output prematurely, + but that's OK because it's just for debugging anyway. */ fprintf (stderr, "<<< %s\n", server->buffer + found); - return (server->buffer + found); + *line = server->buffer + found; + return (data_used - 2); } else { ＠＠ -1250,7 +1294,7 ＠＠ { strcpy (pop_error, "Out of memory in pop_getline"); pop_trash (server); - return (0); + return (-1); } } ret = RECV (server->file, server->buffer + server->data, ＠＠ -1261,13 +1305,13 ＠＠ strncat (pop_error, strerror (errno), ERROR_MAX - sizeof (GETLINE_ERROR)); pop_trash (server); - return (0); + return (-1); } else if (ret == 0) { strcpy (pop_error, "Unexpected EOF from server in pop_getline"); pop_trash (server); - return (0); + return (-1); } else { ＠＠ -1275,7 +1319,8 ＠＠ server->data += ret; server->buffer[server->data] = '\0'; - cp = find_crlf (server->buffer + search_offset); + cp = find_crlf (server->buffer + search_offset, + server->data - search_offset); if (cp) { int data_used = (cp + 2) - server->buffer; ＠＠ -1285,9 +1330,12 ＠＠ if (pop_debug) fprintf (stderr, "<<< %s\n", server->buffer); - return (server->buffer); + *line = server->buffer; + return (data_used - 2); } - search_offset += ret; + /* As above, the "- 1" here is to account for the fact that + we may have read a CR without its accompanying LF. */ + search_offset += ret - 1; } } ＠＠ -1317,12 +1365,24 ＠＠ { #define SENDLINE_ERROR "Error writing to POP server: " int ret; + char *buf; + + /* Combine the string and the CR-LF into one buffer. Otherwise, two + reasonable network stack optimizations, Nagle's algorithm and + delayed acks, combine to delay us a fraction of a second on every + message we send. (Movemail writes line without \r\n, client + kernel sends packet, server kernel delays the ack to see if it + can combine it with data, movemail writes \r\n, client kernel + waits because it has unacked data already in its outgoing queue, + client kernel eventually times out and sends.) + This can be something like 0.2s per command, which can add up + over a few dozen messages, and is a big chunk of the time we + spend fetching mail from a server close by. */ + buf = alloca (strlen (line) + 3); + strcpy (buf, line); + strcat (buf, "\r\n"); ret = fullwrite (server->file, line, strlen (line)); - if (ret >= 0) - { /* 0 indicates that a blank line was written */ - ret = fullwrite (server->file, "\r\n", 2); - } if (ret < 0) { ＠＠ -1351,10 +1411,10 ＠＠ fullwrite (int fd, char *buf, int nbytes) { char *cp; - int ret; + int ret = 0; cp = buf; - while ((ret = SEND (fd, cp, nbytes, 0)) > 0) + while (nbytes && ((ret = SEND (fd, cp, nbytes, 0)) > 0)) { cp += ret; nbytes -= ret; ＠＠ -1382,7 +1442,7 ＠＠ { char *fromline; - if (! (fromline = pop_getline (server))) + if (pop_getline (server, &fromline) < 0) { return (-1); } ＠＠ -1420,8 +1480,7 ＠＠ { char *fromserver; - fromserver = pop_getline (server); - if (! fromserver) + if (pop_getline (server, &fromserver) < 0) return (-1); if (strcmp (fromserver, ".")) ＠＠ -1492,17 +1551,16 ＠＠ #endif } -/* Return a pointer to the first CRLF in IN_STRING, - or 0 if it does not contain one. */ +/* Return a pointer to the first CRLF in IN_STRING, which can contain + embedded nulls and has LEN characters in it not including the final + null, or 0 if it does not contain one. */ static char * -find_crlf (char *in_string) +find_crlf (char *in_string, int len) { - while (1) + while (len--) { - if (! *in_string) - return (0); - else if (*in_string == '\r') + if (*in_string == '\r') { if (*++in_string == '\n') return (in_string - 1); ＠＠ -1510,7 +1568,7 ＠＠ else in_string++; } - /* NOTREACHED */ + return (0); } #endif /* MAIL_USE_POP */ -- Jerry James, Assistant Professor james(a)xemacs.org Computer Science Department http://www.cs.usu.edu/~jerry/ Utah State University

3 participants
2 comments

[PATCH 21.5] gnuclient buffer overflow fixes 18 years

Jerry James

PATCH 21.5 The gnuclient.c part of this patch will not apply to 21.4. I can make a new patch for 21.4 if desired, though. Here are fixes for a few, um, undesirable features found with a static checker. lib-src/ChangeLog addition: 2006-08-08 Jerry James <james(a)xemacs.org> * gnuslib.c (disconnect_from_server): shutdown() has been fine on Linux for a long time now; use it. Also, don't use length to access the buffer unless it is positive, not just nonzero. * gnuclient.c (filename_expand): Initialize the last array element to get a valid C string in case of overflow. Use strncat to avoid buffer overruns. * gnuclient.c (main): Use strncpy to avoid buffer overruns. xemacs-21.5 source patch: Diff command: cvs -q diff -uN Files affected: lib-src/gnuclient.c =================================================================== RCS lib-src/gnuslib.c =================================================================== RCS Index: lib-src/gnuslib.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/gnuslib.c,v retrieving revision 1.12 diff -d -u -r1.12 gnuslib.c --- lib-src/gnuslib.c 2001/08/13 04:45:48 1.12 +++ lib-src/gnuslib.c 2006/08/08 20:27:59 ＠＠ -409,13 +409,11 ＠＠ send_string(s,EOT_STR); /* make sure server gets string */ -#if !defined (linux) && !defined (_SCO_DS) +#ifndef _SCO_DS /* - * shutdown is completely hozed under linux. If s is a unix domain socket, - * you'll get EOPNOTSUPP back from it. If s is an internet socket, you get - * a broken pipe when you try to read a bit later. The latter - * problem is fixed for linux versions >= 1.1.46, but the problem - * with unix sockets persists. Sigh. + * There used to be a comment here complaining about ancient Linux + * versions. It is no longer relevant. I don't know why _SCO_DS is + * verboten here, as the original comment did not say. */ if (shutdown(s,1) == -1) { ＠＠ -434,7 +432,7 ＠＠ #else while ((length = read(s,buffer,GSERV_BUFSZ)) > 0 || (length == -1 && errno == EINTR)) { - if (length) { + if (length > 0) { buffer[length] = '\0'; if (echo) { fputs(buffer,stdout); Index: lib-src/gnuclient.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/gnuclient.c,v retrieving revision 1.27 diff -d -u -r1.27 gnuclient.c --- lib-src/gnuclient.c 2004/12/06 23:23:41 1.27 +++ lib-src/gnuclient.c 2006/08/08 20:27:59 ＠＠ -187,7 +187,7 ＠＠ #endif int len; - fullpath[0] = '\0'; + fullpath[0] = fullpath[QXE_PATH_MAX] = '\0'; #ifdef CYGWIN /* ＠＠ -200,7 +200,7 ＠＠ if (filename[0] && filename[0] == '/') { /* Absolute (unix-style) pathname. Do nothing */ - strcat (fullpath, filename); + strncat (fullpath, filename, QXE_PATH_MAX); } else { ＠＠ -208,15 +208,18 ＠＠ and prepend it. FIXME: need to fix the case of DOS paths like "\foo", where we need to get the current drive. */ - strcat (fullpath, get_current_working_directory ()); + strncat (fullpath, get_current_working_directory (), QXE_PATH_MAX); len = strlen (fullpath); - if (len > 0 && fullpath[len-1] == '/') /* trailing slash already? */ - ; /* yep */ - else - strcat (fullpath, "/"); /* nope, append trailing slash */ + /* If no trailing slash, add one */ + if (len <= 0 || (fullpath[len - 1] != '/' && len < QXE_PATH_MAX)) + { + strcat (fullpath, "/"); + len++; + } + /* Don't forget to add the filename! */ - strcat (fullpath,filename); + strncat (fullpath, filename, QXE_PATH_MAX - len); } } /* filename_expand */ ＠＠ -435,7 +438,7 ＠＠ break; case 'r': GET_ARGUMENT (remotearg, "-r"); - strcpy (remotepath, remotearg); + strncpy (remotepath, remotearg, QXE_PATH_MAX); rflg = 1; break; #endif /* INTERNET_DOMAIN_SOCKETS */ ＠＠ -590,7 +593,7 ＠＠ * to this machine */ if ((ptr = getenv ("GNU_NODE")) != NULL) /* user specified a path */ - strcpy (remotepath, ptr); + strncpy (remotepath, ptr, QXE_PATH_MAX); } #if 0 /* This is really bogus... re-enable it if you must have it! */ #if defined (hp9000s300) || defined (hp9000s800) -- Jerry James, Assistant Professor james(a)xemacs.org Computer Science Department http://www.cs.usu.edu/~jerry/ Utah State University

2 participants
4 comments

patch for Info-find-emacs-command-nodes 18 years

Jeff Miller

The regex in Info-find-command-nodes shouldn't be tied to the end of line. Most lines in Command Index look like: * calendar: Calendar/Diary. (line 6) The regex only works for lines that are split across two lines, like * calendar-backward-day: Calendar Unit Motion. (line 34) Here is a test-case: (let ((where (Info-find-emacs-command-nodes 'calendar))) (Info-find-node (car (car where)) (car (cdr (car where))))) 21.4 requires a similar patch. 2006-10-14 Jeff Miller <jmiller(a)xemacs.org> * info.el (Info-find-emacs-command-nodes): fix regex for find command node. --- lisp/info.el.orig 2006-10-13 20:03:38.000000000 -0400 +++ lisp/info.el 2006-10-14 17:03:17.000000000 -0400 ＠＠ -3117,7 +3117,7 ＠＠ $FILENAME NODENAME BUFFERPOS$." (let ((where '()) (cmd-desc (concat "^\\* " (regexp-quote (symbol-name command)) - ":\\s *\$.*\$\\.$"))) + ":\\s *\$.*\$\\."))) (save-excursion (Info-find-node "XEmacs" "Command Index") ;; Take the index node off the Info history. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

3 participants
2 comments

[PATCH] Make locate startup files work in 21.5 18 years, 1 month

Malcolm Purvis

This is the second of my locale specific patches. The locale package provides for custom startup screens. In 21.4 they are fetched by $LANG (eg 'fr') but for 21.5 they are accessed via current-language-environment (eg 'French'). This patch installed these files in two directories so that they can be found by 21.5 and 21.4. I thought about using a symlink to alias the directory but that wouldn't work under Windows. mule-packages/locale/ChangeLog addition: 2006-10-22 Malcolm Purvis <malcolmp(a)xemacs.org> * Makefile: Store files in two subdirectories so that they can be found by 21.5 and 21.4. xemacs-packages source patch: Diff command: cvs -q diff -u Files affected: mule-packages/locale/Makefile Index: mule-packages/locale/Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/mule-packages/locale/Makefile,v retrieving revision 1.32 diff -u -r1.32 Makefile --- mule-packages/locale/Makefile 2004/12/07 22:15:28 1.32 +++ mule-packages/locale/Makefile 2006/10/22 12:18:25 ＠＠ -17,7 +17,7 ＠＠ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. -VERSION = 1.22 +VERSION = 1.23 AUTHOR_VERSION = MAINTAINER = XEmacs Development Team <xemacs-beta(a)xemacs.org> PACKAGE = locale ＠＠ -39,6 +39,14 ＠＠ DATA_5_DEST = start-files/ro DATA_6_FILES = start-files/fr/locale-start.el start-files/fr/locale-start.elc DATA_6_DEST = start-files/fr +# 21.5 references these files via current-language-environment rather than +# $LANG so for compatibility we'll store them in both places. +DATA_7_FILES = $(DATA_4_FILES) +DATA_7_DEST = start-files/Japanese +DATA_8_FILES = $(DATA_5_FILES) +DATA_8_DEST = start-files/Romanian +DATA_9_FILES = $(DATA_6_FILES) +DATA_9_DEST = start-files/French LOCALE_ELCS = start-files/ja/locale-start.elc start-files/ro/locale-start.elc \ start-files/fr/locale-start.elc -- Malcolm Purvis <malcolmp(a)xemacs.org> _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
1 comments

[S] [PATCH] Autoconf 2.60 support. 18 years, 1 month

Malcolm Purvis

SUPERSEDES <87zmewde3e.fsf_-_(a)tleepslib.sk.tsukuba.ac.jp> Another missed patch from a few months ago. This one fixes problems with autoconf 2.60. Malcolm ChangeLog addition: 2006-10-30 Malcolm Purvis <malcolmp(a)xemacs.org> * configure.ac (XE_CDR): m4_cdr differs in autoconf 2.59 and 2.60. (XE_EXPAND_COMPLEX_OPTIONS): Use XE_CDR, not m4_cdr. xemacs-autoconf-2.60 source patch: Diff command: cvs -q diff -u Files affected: configure.ac Index: configure.ac =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v retrieving revision 1.47 diff -u -r1.47 configure.ac --- configure.ac 2006/07/19 19:35:25 1.47 +++ configure.ac 2006/10/30 11:54:13 ＠＠ -22,8 +22,6 ＠＠ dnl Due to a dependence on the implementation of certain internal autoconf dnl macros, die if any version other than 2.59 is used. AC_PREREQ(2.59)dnl -m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]), [2.59]), 1, - [m4_fatal([This script can only be generated with autoconf 2.59])], [])dnl AC_INIT([XEmacs],[21.5],[xemacs-beta(a)xemacs.org])dnl AC_CONFIG_SRCDIR(src/lisp.h)dnl dnl ＠＠ -231,6 +229,13 ＠＠ for W in $2; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done $1="$T" ])dnl XE_SPACE +dnl Autoconf 2.59 and 2.60 have slightly different versions of m4_cdr that +dnl return different values for an empty list. XE_CDR is a copy of the 2.60 +dnl version which will be used with both versions. +define([XE_CDR], +[m4_if([$#], 0, [m4_fatal([$0: cannot be called without arguments])], + [$#], 1, [], + [m4_dquote(m4_shift($＠))])])dnl dnl dnl XE_MERGED_ARG(FEATURE, HELP-STRING, [ACTION-IF-TRUE], [ACTION-IF-FALSE]) dnl ------------------------------------------------------------------------ ＠＠ -379,9 +384,9 ＠＠ dnl Internal macro to recursively expand all the options in the option list. dnl define([XE_EXPAND_COMPLEX_OPTIONS], -[m4_if([$2], [[]], [], +[m4_if([$2], [], [], [XE_EXPAND_COMPLEX_OPTION([$1], m4_fst($2))[]dnl -XE_EXPAND_COMPLEX_OPTIONS([$1], m4_cdr($2))])])dnl +XE_EXPAND_COMPLEX_OPTIONS([$1], XE_CDR($2))])])dnl dnl dnl XE_INIT_COMPLEX_OPTION(prefix, option_list) dnl ------------------------------------------- -- Malcolm Purvis <malcolmp(a)xemacs.org> _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
1 comments

[PATCH] (Draft2) Make X11 server-side fonts and Mule suck less. 18 years, 1 month

Aidan Kehoe

Andrey, this is the patch I mentioned that will make GHE WITH UPTURN display properly on X11. There remains more work to be done on it than I thought :-( SUPERSEDES 17622.10738.650649.122673(a)parhasard.net Remaining to do as listed in that message: [...] 3. Mechanical copying of the X11-specific code to the GTK port; perhaps a move to something like event-xlike-inc.c [...] Also the XFT heuristics, but I’ll do that separately if I do it at all. Apart from that, I need to look into some odd behaviour that happens when non-ASCII text is selected lisp/ChangeLog addition: 2006-10-31 Aidan Kehoe <kehoea(a)parhasard.net> * mule/arabic.el (arabic-digit): * mule/arabic.el (arabic-1-column): * mule/arabic.el (arabic-2-column): * mule/chinese.el (make-chinese-cns11643-charset): * mule/chinese.el (chinese-sisheng): * mule/english.el (ascii-right-to-left): * mule/ethiopic.el (ethiopic): * mule/european.el (latin-iso8859-14): * mule/european.el (latin-iso8859-16): * mule/indian.el (indian-is13194): * mule/indian.el (indian-1-column): * mule/indian.el (indian-2-column): * mule/japanese.el (japanese-jisx0213-1): * mule/japanese.el (japanese-jisx0213-2): * mule/lao.el (lao): * mule/misc-lang.el (ipa): * mule/mule-charset.el: * mule/thai-xtis.el (thai-xtis): * mule/tibetan.el (tibetan-1-column): * mule/tibetan.el (tibetan): * mule/vietnamese.el (vietnamese-viscii-lower): * mule/vietnamese.el (vietnamese-viscii-upper): Stop using the `registry' charset property; use `registries' instead. The difference is that registries is an ordered vector of X11 registries and encodings rather than a regexp; this means we can leave the matching to the X11 server, avoiding transferring huge amounts of data (perhaps across the network!) in order to do a regexp search on it. * mule/mule-charset.el (charset-registries): New. * mule/mule-charset.el (set-charset-registry): New. charset-registries returns the registries of a charset; 2006-10-31 Aidan Kehoe <kehoea(a)parhasard.net> * faces.el (face-property-matching-instance): Simplify. * faces.el (face-font-instance): Document CHARSET. * faces.el (set-face-font): Give more details on common values for font instantiators, LOCALEs. * unicode.el: Remove a few comments that were only relevant to GNU Emacs. * unicode.el (decode-char): * unicode.el (encode-char): Document CODE, CHAR using uppercase, since they're parameters. * x-faces.el (x-init-face-from-resources): Retain some of the fallbacks in the generated default face, since it doesn't make sense to try Andale Mono's ISO-10646-1 encoding for Amharic or Thai. * x-font-menu.el (charset-registries): * x-font-menu.el (x-reset-device-font-menus-core): Use charset-registries instead of charset-registry. src/ChangeLog addition: 2006-10-31 Aidan Kehoe <kehoea(a)parhasard.net> * charset.h: Prefer the charset-registries property to the charset-registry property; accept the latter for compatibility, warning when its regexp functionality is used. * charset.h (XCHARSET_CCL_PROGRAM): * charset.h (XCHARSET_NAME): Make dummy versions of these available in non-Mule. * console-impl.h: * console-impl.h (struct console_methods): Rename the last parameter to a couple of methods; reformat their declarations. * faces.c: * faces.c (face_property_matching_instance): * faces.c (ensure_face_cachel_contains_charset): * faces.c (merge_face_cachel_data): * faces.c (reset_face_cachel): * faces.c (mark_face_cachels_as_not_updated): * faces.c (syms_of_faces): * faces.c (vars_of_faces): * faces.c (complex_vars_of_faces): Provide a DEBUG_FACES macro; use it to make debugging output available in debug builds. Implement multi-stage font lookup, assigning the stages names, not numbers. Re-implement the cachel->font_specified cache using the infrastructure for Lisp bit vectors. * faces.h: * faces.h (struct face_cachel): * faces.h (FACE_CACHEL_FONT_UPDATED): * faces.h (FACE_FONT): Re-implement the cachel->font_specified cache using the infrastructure for Lisp bit vectors. * font-mgr.h: Move some XFT debug macros here from objects-x.c. * general-slots.h: Provide a few new symbols for the multi-stage font resolution process. * intl.c (init_intl): Correct a comment. * lisp.h: Provide a macro to declare an inline lisp bit vector where the size is fixed. Make Qregistries available all over, not Qregistry. * mule-charset.c: * mule-charset.c (mark_charset): * mule-charset.c (print_charset): * mule-charset.c (make_charset): * mule-charset.c (Fmake_charset): * mule-charset.c (Fcharset_property): * mule-charset.c (Fset_charset_ccl_program): * mule-charset.c (syms_of_mule_charset): * mule-charset.c (complex_vars_of_mule_charset): * mule-charset.c (CHINESE_CNS_PLANE): Prefer the charset-registries property to the charset-registry property; accept the latter for compatibility, warning when its regexp functionality is used. * objects-gtk.c: * objects-gtk.c (gtk_font_spec_matches_charset): * objects-gtk.c (gtk_find_charset_font): * objects-msw.c (mswindows_find_charset_font): * objects-tty.c (tty_find_charset_font): Redeclare various functions to work with the multi-stage lookup process. * objects-x.c: Provide a DEBUG_OBJECTS macro; use it to make debugging output available in debug builds. * objects-x.c (count_hyphens): New. How many ASCII minus characters in a string? * objects-x.c (x_initialize_font_instance): * objects-x.c (x_print_font_instance): * objects-x.c (x_font_spec_matches_charset): * objects-x.c (xlistfonts_checking_charset): * objects-x.c (x_find_charset_font): * objects-x.c (vars_of_objects_x): Don't regex match on the output of XListFonts; instead, use the fixed strings of the charset-registries to comparatively limit the IPC that will happen. * objects.c (print_font_instance): * objects.c (font_spec_matches_charset): * objects.c (font_validate_matchspec): * objects.c (font_instantiate): Redeclare some methods to take enums rather than numeric stages. * objects.h (EXFUN): Make Fregexp_quote available to mule-charset.c * redisplay-x.c: * redisplay-x.c (separate_textual_runs): Make this slightly faster, cleaner. Make it accept a face cachel pointer argument, and check it as to whether a given charset should be translated to UCS-2 before redisplay. * specifier.c: * specifier.c (charset_matches_specifier_tag_set_p): * specifier.c (define_specifier_tag): * specifier.c (Fdefine_specifier_tag): * specifier.c (setup_device_initial_specifier_tags): * specifier.c (setup_charset_initial_specifier_tags): * specifier.c (specifier_instance_from_inst_list): * specifier.c (syms_of_specifier): * specifier.c (vars_of_specifier): * specifier.h: Extend specifiers to allow limiting their applicability by using charset predicates. Document this. * unicode.c (unicode_to_ichar): * unicode.c (syms_of_unicode): * unicode.c (vars_of_unicode): Use unicode-registries, a dumped vector, as the charset-registries of the on-the-fly JIT charsets. XEmacs Trunk source patch: Diff command: cvs -q diff -Nu Files affected: src/unicode.c src/specifier.h src/specifier.c src/redisplay.c src/redisplay-x.c src/objects.h src/objects.c src/objects-x.c src/objects-tty.c src/objects-msw.c src/objects-gtk.c src/mule-charset.c src/lisp.h src/intl.c src/general-slots.h src/font-mgr.h src/fileio.c src/faces.h src/faces.c src/console-impl.h src/charset.h lisp/mule/vietnamese.el lisp/mule/tibetan.el lisp/mule/thai-xtis.el lisp/mule/mule-charset.el lisp/mule/misc-lang.el lisp/mule/lao.el lisp/mule/japanese.el lisp/mule/indian.el lisp/mule/european.el lisp/mule/ethiopic.el lisp/mule/english.el lisp/mule/chinese.el lisp/mule/arabic.el lisp/x-font-menu.el lisp/x-faces.el lisp/unicode.el lisp/faces.el Index: lisp/faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v retrieving revision 1.38 diff -u -u -r1.38 faces.el --- lisp/faces.el 2006/04/25 14:01:52 1.38 +++ lisp/faces.el 2006/10/31 22:06:50 ＠＠ -250,19 +250,9 ＠＠ (setq face (get-face face)) (let ((value (get face property))) - (if (specifierp value) - (setq value (if (or (charsetp matchspec) - (and (symbolp matchspec) - (find-charset matchspec))) - (or - (specifier-matching-instance - value (cons matchspec nil) domain default - no-fallback) - (specifier-matching-instance - value (cons matchspec t) domain default - no-fallback)) - (specifier-matching-instance value matchspec domain - default no-fallback)))) + (when (specifierp value) + (setq value (specifier-matching-instance value matchspec domain + default no-fallback))) value)) (defun set-face-property (face property value &optional locale tag-set ＠＠ -473,25 +463,40 ＠＠ and an instance object describing how the font appears in that particular window and buffer will be returned. +CHARSET is a Mule charset (meaning return the font used for that charset) or +nil (meaning return the font used for ASCII.) + See `face-property-instance' for more information." - (if charset - (face-property-matching-instance face 'font charset domain) - (face-property-instance face 'font domain))) + (if (null charset) + (face-property-instance face 'font domain) + (let (matchspec) + ;; get-charset signals an error if its argument doesn't have an + ;; associated charset. + (setq charset (get-charset charset) + matchspec (cons charset nil)) + (or (null (setcdr matchspec 'initial)) + (face-property-matching-instance + face 'font matchspec domain) + (null (setcdr matchspec 'final)) + (face-property-matching-instance + face 'font matchspec domain))))) (defun set-face-font (face font &optional locale tag-set how-to-add) "Change the font of FACE to FONT in LOCALE. FACE may be either a face object or a symbol representing a face. -FONT should be an instantiator (see `make-font-specifier'), a list of - instantiators, an alist of specifications (each mapping a - locale to an instantiator list), or a font specifier object. - -If FONT is an alist, LOCALE must be omitted. If FONT is a - specifier object, LOCALE can be a locale, a locale type, `all', - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to `global'. +FONT should be an instantiator (see `make-font-specifier'; a common + instantiator is a platform-dependent string naming the font), a list + of instantiators, an alist of specifications (each mapping a locale + to an instantiator list), or a font specifier object. + +If FONT is an alist, LOCALE must be omitted. If FONT is a specifier + object, LOCALE can be a locale, a locale type, `all', or nil; see + `copy-specifier' for its semantics. Common LOCALEs are buffer + objects, window objects, device objects and `global'. Otherwise + LOCALE specifies the locale under which the specified + instantiator(s) will be added, and defaults to `global'. See `set-face-property' for more information." (interactive (face-interactive "font")) Index: lisp/unicode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/unicode.el,v retrieving revision 1.14 diff -u -u -r1.14 unicode.el --- lisp/unicode.el 2006/07/13 20:45:49 1.14 +++ lisp/unicode.el 2006/10/31 22:06:56 ＠＠ -29,54 +29,6 ＠＠ ;;; Code: -; ;; Subsets of Unicode. - -; #### what is this bogosity ... "chars 96, final ?2" !!?! -; (make-charset 'mule-unicode-2500-33ff -; "Unicode characters of the range U+2500..U+33FF." -; '(dimension -; 2 -; registry "ISO10646-1" -; chars 96 -; columns 1 -; direction l2r -; final ?2 -; graphic 0 -; short-name "Unicode subset 2" -; long-name "Unicode subset (U+2500..U+33FF)" -; )) - - -; (make-charset 'mule-unicode-e000-ffff -; "Unicode characters of the range U+E000..U+FFFF." -; '(dimension -; 2 -; registry "ISO10646-1" -; chars 96 -; columns 1 -; direction l2r -; final ?3 -; graphic 0 -; short-name "Unicode subset 3" -; long-name "Unicode subset (U+E000+FFFF)" -; )) - - -; (make-charset 'mule-unicode-0100-24ff -; "Unicode characters of the range U+0100..U+24FF." -; '(dimension -; 2 -; registry "ISO10646-1" -; chars 96 -; columns 1 -; direction l2r -; final ?1 -; graphic 0 -; short-name "Unicode subset" -; long-name "Unicode subset (U+0100..U+24FF)" -; )) - - ;; accessed in loadup.el, mule-cmds.el; see discussion in unicode.c (defvar load-unicode-tables-at-dump-time (eq system-type 'windows-nt) "[INTERNAL] Whether to load the Unicode tables at dump time. ＠＠ -305,14 +257,14 ＠＠ need-bom t)) (defun decode-char (quote-ucs code &optional restriction) - "FSF compatibility--return Mule character with Unicode codepoint `code'. + "FSF compatibility--return Mule character with Unicode codepoint CODE. The second argument must be 'ucs, the third argument is ignored. " (assert (eq quote-ucs 'ucs) t "Sorry, decode-char doesn't yet support anything but the UCS. ") (unicode-to-char code)) (defun encode-char (char quote-ucs &optional restriction) - "FSF compatibility--return the Unicode code point of `char'. + "FSF compatibility--return the Unicode code point of CHAR. The second argument must be 'ucs, the third argument is ignored. " (assert (eq quote-ucs 'ucs) t "Sorry, encode-char doesn't yet support anything but the UCS. ") ＠＠ -343,12 +295,6 ＠＠ "CCL program to transform Mule characters to UCS-2.") (put (quote ccl-encode-to-ucs-2) (quote ccl-program-idx) (register-ccl-program (quote ccl-encode-to-ucs-2) prog)) nil)) - -;; Won't do this just yet, though. -;; (set-charset-registry 'lao "iso10646-1") -;; (set-charset-ccl-program 'lao 'ccl-encode-to-ucs-2) -;; (set-charset-registry 'ipa "iso10646-1") -;; (set-charset-ccl-program 'ipa 'ccl-encode-to-ucs-2) ;; #### UTF-7 is not yet implemented, and it's tricky to do. There's ;; an implementation in appendix A.1 of the Unicode Standard, Version Index: lisp/x-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v retrieving revision 1.25 diff -u -u -r1.25 x-faces.el --- lisp/x-faces.el 2006/04/25 14:01:54 1.25 +++ lisp/x-faces.el 2006/10/31 22:06:57 ＠＠ -782,7 +782,27 ＠＠ ;; globally. This means we should override global ;; defaults for all X device classes. (remove-specifier (face-font face) locale x-tag-set nil)) - (set-face-font face fn locale 'x append)) + (set-face-font face fn locale 'x append) + ; + ; (debug-print "the face is %s, locale %s, specifier %s" + ; face locale (face-font face)) + ; + ;; And retain some of the fallbacks in the generated default face, + ;; since we don't want to try andale-mono's ISO-10646-1 encoding for + ;; Amharic or Thai. This is fragile; it depends on the code in + ;; faces.c. + (dolist (assocked '((x encode-as-utf-8 initial) + (x encode-as-utf-8 final) + (x one-dimensional final) + (x two-dimensional final))) + (when (and (specifierp (face-font face)) + (consp (specifier-fallback (face-font face))) + (setq assocked + (assoc assocked + (specifier-fallback + (face-font face))))) + (set-face-font face (cdr assocked) locale (car assocked) append)))) + ;; Kludge-o-rooni. Set the foreground and background resources for ;; X devices only -- otherwise things tend to get all messed up ;; if you start up an X frame and then later create a TTY frame. Index: lisp/x-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v retrieving revision 1.17 diff -u -u -r1.17 x-font-menu.el --- lisp/x-font-menu.el 2006/05/11 14:57:05 1.17 +++ lisp/x-font-menu.el 2006/10/31 22:06:57 ＠＠ -43,7 +43,7 ＠＠ x-font-regexp-spacing)) (globally-declare-fboundp - '(charset-registry)) + '(charset-registries)) (defvar x-font-menu-registry-encoding nil "Registry and encoding to use with font menu fonts.") ＠＠ -157,9 +157,7 ＠＠ ;; #### - this should implement a `menus-only' option, which would ;; recalculate the menus from the cache w/o having to do font-list again. (unless x-font-regexp-ascii - (setq x-font-regexp-ascii (if (featurep 'mule) - (charset-registry 'ascii) - "iso8859-1"))) + (setq x-font-regexp-ascii (elt (charset-registries 'ascii) 0))) (setq x-font-menu-registry-encoding (if (featurep 'mule) "*-*" "iso8859-1")) (let ((case-fold-search t) Index: lisp/mule/arabic.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/arabic.el,v retrieving revision 1.7 diff -u -u -r1.7 arabic.el --- lisp/mule/arabic.el 2002/03/16 10:39:05 1.7 +++ lisp/mule/arabic.el 2006/10/31 22:06:57 ＠＠ -47,9 +47,8 ＠＠ ;; Others are of direction right-to-left and of width 1-column or ;; 2-column. (make-charset 'arabic-digit "Arabic digit" - '(dimension - 1 - registry "MuleArabic-0" + '(dimension 1 + registries ["MuleArabic-0"] chars 94 columns 1 direction l2r ＠＠ -62,7 +61,7 ＠＠ (make-charset 'arabic-1-column "Arabic 1-column" '(dimension 1 - registry "MuleArabic-1" + registries ["MuleArabic-1"] chars 94 columns 1 direction r2l ＠＠ -75,7 +74,7 ＠＠ (make-charset 'arabic-2-column "Arabic 2-column" '(dimension 1 - registry "MuleArabic-2" + registries ["MuleArabic-2"] chars 94 columns 2 direction r2l Index: lisp/mule/chinese.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/chinese.el,v retrieving revision 1.12 diff -u -u -r1.12 chinese.el --- lisp/mule/chinese.el 2005/12/24 22:31:51 1.12 +++ lisp/mule/chinese.el 2006/10/31 22:06:58 ＠＠ -146,8 +146,8 ＠＠ (name plane final) (make-charset name (concat "CNS 11643 Plane " plane " (Chinese traditional)") - `(registry - ,(concat "CNS11643[.-]\$.*[.-]\$?" plane "$") + `(registries + ,(vector (concat "cns11643.1992-" plane )) dimension 2 chars 94 final ,final ＠＠ -171,7 +171,7 ＠＠ (make-charset ;; not in FSF 21.1 'chinese-isoir165 "ISO-IR-165 (CCITT Extended GB; Chinese simplified)" - `(registry "isoir165" + `(registries ["isoir165-0"] dimension 2 chars 94 final ?E ＠＠ -185,7 +185,7 ＠＠ '(dimension 1 ;; XEmacs addition: second half of registry spec - registry "sisheng_cwnn\\|OMRON_UDC_ZH" + registries ["omron_udc_zh-0" "sisheng_cwnn-0"] chars 94 columns 1 direction l2r Index: lisp/mule/english.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/english.el,v retrieving revision 1.6 diff -u -u -r1.6 english.el --- lisp/mule/english.el 2002/03/29 04:46:41 1.6 +++ lisp/mule/english.el 2006/10/31 22:06:58 ＠＠ -36,7 +36,7 ＠＠ "ASCII (left half of ISO 8859-1) with right-to-left direction" '(dimension 1 - registry "ISO8859-1" + registries ["ISO8859-1"] chars 94 columns 1 direction r2l Index: lisp/mule/ethiopic.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/ethiopic.el,v retrieving revision 1.6 diff -u -u -r1.6 ethiopic.el --- lisp/mule/ethiopic.el 2002/03/16 10:39:06 1.6 +++ lisp/mule/ethiopic.el 2006/10/31 22:06:58 ＠＠ -32,7 +32,7 ＠＠ (make-charset 'ethiopic "Ethiopic characters" '(dimension 2 - registry "Ethiopic-Unicode" + registries ["Ethiopic-Unicode"] chars 94 columns 2 direction l2r ＠＠ -82,5 +82,8 ＠＠ (features ethio-util) (sample-text . "$(3$Q#U!.(B") (documentation . t))) + +;; In a more ideal world, we could set the default face fallback from here +;; to use one of the misc-fixed sizes that handles Ethiopic. ;;; ethiopic.el ends here Index: lisp/mule/european.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/european.el,v retrieving revision 1.12 diff -u -u -r1.12 european.el --- lisp/mule/european.el 2005/05/10 17:02:59 1.12 +++ lisp/mule/european.el 2006/10/31 22:06:58 ＠＠ -121,7 +121,7 ＠＠ "Right-Hand Part of Latin Alphabet 8 (ISO/IEC 8859-14)" '(dimension 1 - registry "ISO8859-14" + registries ["ISO8859-14"] chars 96 columns 1 direction l2r ＠＠ -135,7 +135,7 ＠＠ "Right-Hand Part of Latin Alphabet 10 (ISO/IEC 8859-16)" '(dimension 1 - registry "ISO8859-16" + registries ["ISO8859-16"] chars 96 columns 1 direction l2r Index: lisp/mule/indian.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/indian.el,v retrieving revision 1.3 diff -u -u -r1.3 indian.el --- lisp/mule/indian.el 2002/03/16 10:39:06 1.3 +++ lisp/mule/indian.el 2006/10/31 22:06:58 ＠＠ -99,7 +99,7 ＠＠ "Generic Indian charset for data exchange with IS 13194" '(dimension 1 - registry "IS13194-Devanagari" + registries ["IS13194-Devanagari"] chars 94 columns 2 direction l2r ＠＠ -114,7 +114,7 ＠＠ "Indian charset for 2-column width glyphs" '(dimension 2 - registry "MuleIndian-1" + registries ["MuleIndian-1"] chars 94 columns 1 direction l2r ＠＠ -129,7 +129,7 ＠＠ "Indian charset for 2-column width glyphs" '(dimension 2 - registry "MuleIndian-2" + registries ["MuleIndian-2"] chars 94 columns 2 direction l2r Index: lisp/mule/japanese.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/japanese.el,v retrieving revision 1.11 diff -u -u -r1.11 japanese.el --- lisp/mule/japanese.el 2004/01/29 05:22:40 1.11 +++ lisp/mule/japanese.el 2006/10/31 22:06:58 ＠＠ -33,80 +33,10 ＠＠ ;;; Code: -; (make-charset 'katakana-jisx0201 -; "Katakana Part of JISX0201.1976" -; '(dimension -; 1 -; registry "JISX0201" -; chars 94 -; columns 1 -; direction l2r -; final ?I -; graphic 1 -; short-name "JISX0201 Katakana" -; long-name "Japanese Katakana (JISX0201.1976)" -; )) - -; (make-charset 'latin-jisx0201 -; "Roman Part of JISX0201.1976" -; '(dimension -; 1 -; registry "JISX0201" -; chars 94 -; columns 1 -; direction l2r -; final ?J -; graphic 0 -; short-name "JISX0201 Roman" -; long-name "Japanese Roman (JISX0201.1976)" -; )) - -; (make-charset 'japanese-jisx0208-1978 -; "JISX0208.1978 Japanese Kanji (so called \"old JIS\"): ISO-IR-42" -; '(dimension -; 2 -; registry "JISX0208.1990" -; registry "JISX0208.1978" -; chars 94 -; columns 2 -; direction l2r -; final ?＠ -; graphic 0 -; short-name "JISX0208.1978" -; long-name "JISX0208.1978 (Japanese): ISO-IR-42" -; )) - -; (make-charset 'japanese-jisx0208 -; "JISX0208.1983/1990 Japanese Kanji: ISO-IR-87" -; '(dimension -; 2 -; chars 94 -; columns 2 -; direction l2r -; final ?B -; graphic 0 -; short-name "JISX0208" -; long-name "JISX0208.1983/1990 (Japanese): ISO-IR-87" -; )) - -; (make-charset 'japanese-jisx0212 -; "JISX0212 Japanese supplement: ISO-IR-159" -; '(dimension -; 2 -; registry "JISX0212" -; chars 94 -; columns 2 -; direction l2r -; final ?D -; graphic 0 -; short-name "JISX0212" -; long-name "JISX0212 (Japanese): ISO-IR-159" -; )) - (make-charset 'japanese-jisx0213-1 "JISX0213 Plane 1 (Japanese)" '(dimension 2 - registry "JISX0213.2000-1" + registries ["JISX0213.2000-1"] chars 94 columns 2 direction l2r ＠＠ -120,7 +50,7 ＠＠ (make-charset 'japanese-jisx0213-2 "JISX0213 Plane 2 (Japanese)" '(dimension 2 - registry "JISX0213.2000-2" + registries ["JISX0213.2000-2"] chars 94 columns 2 direction l2r ＠＠ -130,6 +60,28 ＠＠ long-name "JISX0213-2" )) +(when nil + +(when (and (memq 'x (device-type-list)) (not (featurep 'xft))) + ;; X11 fonts; these are available in XFree86 4.0. + (loop + for (character-set default-font) in + '((japanese-jisx0208 + "-jis-fixed-medium-r-normal--16-150-75-75-c-160-jisx0208.1983-0")) + do + (define-specifier-tag character-set nil + (list 'lambda '(charset stage) + (list 'eq 'charset + (list 'find-charset (list 'quote character-set))))) + (set-face-font 'default default-font 'global + (list 'x character-set) 'append))) + +;; japanese-jisx0213-1 +;;japanese-jisx0213-2 +;; katakana-jisx0201 +;; latin-jisx0201 + +) ;;; Syntax of Japanese characters. (modify-syntax-entry 'katakana-jisx0201 "w") (modify-syntax-entry 'japanese-jisx0212 "w") Index: lisp/mule/lao.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/lao.el,v retrieving revision 1.4 diff -u -u -r1.4 lao.el --- lisp/mule/lao.el 2002/03/18 10:07:37 1.4 +++ lisp/mule/lao.el 2006/10/31 22:06:58 ＠＠ -33,7 +33,7 ＠＠ (make-charset 'lao "Lao characters (ISO10646 0E80..0EDF)" '(dimension 1 - registry "MuleLao-1" + registries ["MuleLao-1"] chars 94 columns 1 direction l2r Index: lisp/mule/misc-lang.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/misc-lang.el,v retrieving revision 1.5 diff -u -u -r1.5 misc-lang.el --- lisp/mule/misc-lang.el 2002/03/16 10:39:07 1.5 +++ lisp/mule/misc-lang.el 2006/10/31 22:06:58 ＠＠ -34,7 +34,7 ＠＠ (make-charset 'ipa "IPA (International Phonetic Association)" '(dimension 1 - registry "MuleIPA" + registries ["MuleIPA"] chars 96 columns 1 direction l2r Index: lisp/mule/mule-charset.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-charset.el,v retrieving revision 1.18 diff -u -u -r1.18 mule-charset.el --- lisp/mule/mule-charset.el 2005/12/23 11:42:35 1.18 +++ lisp/mule/mule-charset.el 2006/10/31 22:06:58 ＠＠ -106,12 +106,31 ＠＠ 0 1)) -;; Not in Emacs/Mule +;; Not in GNU Emacs/Mule (defun charset-registry (charset) "Return the registry of CHARSET. This is a regular expression matching the registry field of fonts that can display the characters in CHARSET." - (charset-property charset 'registry)) + (lwarn 'xintl 'warning + "charset-registry is obsolete--use charset-registries instead. ") + (when (charset-property charset 'registries) + (elt (charset-property charset 'registries) 0))) + +(defun charset-registries (charset) + "Return the registries of CHARSET." + (charset-property charset 'registries)) + +(defun set-charset-registry (charset registry) + "Obsolete; use set-charset-registries instead. " + (check-argument-type 'stringp registry) + (check-argument-type 'charsetp (find-charset charset)) + (unless (equal registry (regexp-quote registry)) + (lwarn 'xintl 'warning + "Regexps no longer allowed for charset-registry. Treating %s%s" + registry " as a string.")) + (set-charset-registries + charset + (apply 'vector registry (append (charset-registries charset) nil)))) (defun charset-ccl-program (charset) "Return the CCL program of CHARSET. Index: lisp/mule/thai-xtis.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/thai-xtis.el,v retrieving revision 1.4 diff -u -u -r1.4 thai-xtis.el --- lisp/mule/thai-xtis.el 2002/03/18 10:07:37 1.4 +++ lisp/mule/thai-xtis.el 2006/10/31 22:06:58 ＠＠ -35,12 +35,12 ＠＠ ;;; Code: (make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)." - '(registry "xtis-0" - dimension 2 - columns 1 - chars 94 - final ?? - graphic 0)) + '(registries ["xtis-0"] + dimension 2 + columns 1 + chars 94 + final ?? + graphic 0)) (define-category ?x "Precomposed Thai character.") (modify-category-entry 'thai-xtis ?x) Index: lisp/mule/tibetan.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/tibetan.el,v retrieving revision 1.3 diff -u -u -r1.3 tibetan.el --- lisp/mule/tibetan.el 2002/03/16 10:39:07 1.3 +++ lisp/mule/tibetan.el 2006/10/31 22:06:59 ＠＠ -87,7 +87,7 ＠＠ (make-charset 'tibetan-1-column "Tibetan 1 column glyph" '(dimension 2 - registry "MuleTibetan-1" + registries ["MuleTibetan-1"] chars 94 columns 1 direction l2r ＠＠ -101,7 +101,7 ＠＠ (make-charset 'tibetan "Tibetan characters" '(dimension 2 - registry "MuleTibetan-2" + registries ["MuleTibetan-2"] chars 94 columns 2 direction l2r Index: lisp/mule/vietnamese.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/vietnamese.el,v retrieving revision 1.6 diff -u -u -r1.6 vietnamese.el --- lisp/mule/vietnamese.el 2002/03/21 07:30:24 1.6 +++ lisp/mule/vietnamese.el 2006/10/31 22:06:59 ＠＠ -37,7 +37,7 ＠＠ (make-charset 'vietnamese-viscii-lower "VISCII1.1 lower-case" '(dimension 1 - registry "VISCII1.1" + registries ["VISCII1.1"] chars 96 columns 1 direction l2r ＠＠ -50,7 +50,7 ＠＠ (make-charset 'vietnamese-viscii-upper "VISCII1.1 upper-case" '(dimension 1 - registry "VISCII1.1" + registries ["VISCII1.1"] chars 96 columns 1 direction l2r Index: src/charset.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/charset.h,v retrieving revision 1.14 diff -u -u -r1.14 charset.h --- src/charset.h 2006/07/07 23:01:11 1.14 +++ src/charset.h 2006/10/31 22:06:59 ＠＠ -58,6 +58,8 ＠＠ (byte1) = (ch); \ (byte2) = 0; \ } while (0) +#define XCHARSET_CCL_PROGRAM(cs) Qnil +#define XCHARSET_NAME(cs) Qascii #else /* MULE */ ＠＠ -186,7 +188,7 ＠＠ int id; Lisp_Object name; Lisp_Object doc_string; - Lisp_Object registry; + Lisp_Object registries; Lisp_Object short_name; Lisp_Object long_name; ＠＠ -271,7 +273,7 ＠＠ #define CHARSET_DIRECTION(cs) ((cs)->direction) #define CHARSET_FINAL(cs) ((cs)->final) #define CHARSET_DOC_STRING(cs) ((cs)->doc_string) -#define CHARSET_REGISTRY(cs) ((cs)->registry) +#define CHARSET_REGISTRIES(cs) ((cs)->registries) #define CHARSET_CCL_PROGRAM(cs) ((cs)->ccl_program) #define CHARSET_DIMENSION(cs) ((cs)->dimension) #define CHARSET_CHARS(cs) ((cs)->chars) ＠＠ -280,7 +282,6 ＠＠ #define CHARSET_FROM_UNICODE_TABLE(cs) ((cs)->from_unicode_table) #define CHARSET_FROM_UNICODE_LEVELS(cs) ((cs)->from_unicode_levels) - #define CHARSET_PRIVATE_P(cs) leading_byte_private_p (CHARSET_LEADING_BYTE (cs)) #define XCHARSET_ID(cs) CHARSET_ID (XCHARSET (cs)) ＠＠ -295,11 +296,12 ＠＠ #define XCHARSET_DIRECTION(cs) CHARSET_DIRECTION (XCHARSET (cs)) #define XCHARSET_FINAL(cs) CHARSET_FINAL (XCHARSET (cs)) #define XCHARSET_DOC_STRING(cs) CHARSET_DOC_STRING (XCHARSET (cs)) -#define XCHARSET_REGISTRY(cs) CHARSET_REGISTRY (XCHARSET (cs)) +#define XCHARSET_REGISTRIES(cs) CHARSET_REGISTRIES (XCHARSET (cs)) #define XCHARSET_LEADING_BYTE(cs) CHARSET_LEADING_BYTE (XCHARSET (cs)) #define XCHARSET_CCL_PROGRAM(cs) CHARSET_CCL_PROGRAM (XCHARSET (cs)) #define XCHARSET_DIMENSION(cs) CHARSET_DIMENSION (XCHARSET (cs)) #define XCHARSET_CHARS(cs) CHARSET_CHARS (XCHARSET (cs)) + #define XCHARSET_PRIVATE_P(cs) CHARSET_PRIVATE_P (XCHARSET (cs)) #define XCHARSET_REVERSE_DIRECTION_CHARSET(cs) \ CHARSET_REVERSE_DIRECTION_CHARSET (XCHARSET (cs)) Index: src/console-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v retrieving revision 1.12 diff -u -u -r1.12 console-impl.h --- src/console-impl.h 2005/10/24 10:07:34 1.12 +++ src/console-impl.h 2006/10/31 22:07:00 ＠＠ -26,6 +26,7 ＠＠ #define INCLUDED_console_impl_h_ #include "console.h" +#include "specifier.h" extern const struct sized_memory_description cted_description; extern const struct sized_memory_description console_methods_description; ＠＠ -212,17 +213,13 ＠＠ Lisp_Object (*font_list_method) (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber); - Lisp_Object (*find_charset_font_method) (Lisp_Object device, - Lisp_Object font, - Lisp_Object charset, - int stage); - int (*font_spec_matches_charset_method) (struct device *d, - Lisp_Object charset, - const Ibyte *nonreloc, - Lisp_Object reloc, - Bytecount offset, - Bytecount length, - int stage); + Lisp_Object (*find_charset_font_method) + (Lisp_Object device, Lisp_Object font, Lisp_Object charset, + enum font_specifier_matchspec_stages stage); + int (*font_spec_matches_charset_method) + (struct device *d, Lisp_Object charset, const Ibyte *nonreloc, + Lisp_Object reloc, Bytecount offset, Bytecount length, + enum font_specifier_matchspec_stages stage); /* image methods */ void (*mark_image_instance_method) (Lisp_Image_Instance *); Index: src/faces.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v retrieving revision 1.49 diff -u -u -r1.49 faces.c --- src/faces.c 2005/11/26 11:46:08 1.49 +++ src/faces.c 2006/10/31 22:07:02 ＠＠ -72,6 +72,31 ＠＠ Lisp_Object Vbuilt_in_face_specifiers; +#ifdef DEBUG_XEMACS +Fixnum debug_x_faces; +#endif + +#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901) + +#ifdef DEBUG_XEMACS +# define DEBUG_FACES(FORMAT, ...) \ + do { if (debug_x_faces) stderr_out(FORMAT, __VA_ARGS__); } while (0) +#else /* DEBUG_XEMACS */ +# define DEBUG_FACES(format, ...) +#endif /* DEBUG_XEMACS */ + +#elif defined(__GNUC__) + +#ifdef DEBUG_XEMACS +# define DEBUG_FACES(format, args...) \ + do { if (debug_x_faces) stderr_out(format, args ); } while (0) +#else /* DEBUG_XEMACS */ +# define DEBUG_FACES(format, args...) +#endif /* DEBUG_XEMACS */ + +#else /* defined(__STDC_VERSION__) [...] */ +# define DEBUG_FACES (void) +#endif static Lisp_Object mark_face (Lisp_Object obj) ＠＠ -554,37 +579,31 ＠＠ face_property_matching_instance (Lisp_Object face, Lisp_Object property, Lisp_Object charset, Lisp_Object domain, Error_Behavior errb, int no_fallback, - Lisp_Object depth) + Lisp_Object depth, + enum font_specifier_matchspec_stages stage) { Lisp_Object retval; Lisp_Object matchspec = Qunbound; struct gcpro gcpro1; if (!NILP (charset)) - matchspec = noseeum_cons (charset, Qnil); + matchspec = noseeum_cons (charset, + stage == initial ? Qinitial : Qfinal); + GCPRO1 (matchspec); retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec, domain, errb, no_fallback, depth); - if (UNBOUNDP (retval)) - { - if (CONSP (matchspec)) - Fsetcdr (matchspec, Qt); - retval = specifier_instance_no_quit (Fget (face, property, Qnil), - matchspec, domain, errb, - no_fallback, depth); - } UNGCPRO; if (CONSP (matchspec)) free_cons (matchspec); - if (UNBOUNDP (retval) && !no_fallback) + if (UNBOUNDP (retval) && !no_fallback && final == stage) { if (EQ (property, Qfont)) { if (NILP (memq_no_quit (charset, XFACE (face)->charsets_warned_about))) { -#ifdef MULE if (!UNBOUNDP (charset)) warn_when_safe (Qfont, Qnotice, ＠＠ -593,12 +612,6 ＠＠ (XSYMBOL (XCHARSET_NAME (charset)))), XSTRING_DATA (symbol_name (XSYMBOL (XFACE (face)->name)))); - else -#endif - warn_when_safe (Qfont, Qnotice, - "Unable to instantiate font for face %s", - XSTRING_DATA (symbol_name - (XSYMBOL (XFACE (face)->name)))); XFACE (face)->charsets_warned_about = Fcons (charset, XFACE (face)->charsets_warned_about); } ＠＠ -1071,11 +1084,11 ＠＠ { Lisp_Object new_val; Lisp_Object face = cachel->face; - int bound = 1; + int bound = 1, final_stage = 0; int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; - if (!UNBOUNDP (cachel->font[offs]) - && cachel->font_updated[offs]) + if (!UNBOUNDP (cachel->font[offs]) && + bit_vector_bit(FACE_CACHEL_FONT_UPDATED (cachel), offs)) return cachel->font[offs]; if (UNBOUNDP (face)) ＠＠ -1085,7 +1098,8 ＠＠ struct window *w = XWINDOW (domain); new_val = Qunbound; - cachel->font_specified[offs] = 0; + set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 0); + for (i = 0; i < cachel->nfaces; i++) { struct face_cachel *oth; ＠＠ -1095,15 +1109,15 ＠＠ /* Tout le monde aime la recursion */ ensure_face_cachel_contains_charset (oth, domain, charset); - if (oth->font_specified[offs]) + if (bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(oth), offs)) { new_val = oth->font[offs]; - cachel->font_specified[offs] = 1; + set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); break; } } - if (!cachel->font_specified[offs]) + if (!bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) /* need to do the default face. */ { struct face_cachel *oth = ＠＠ -1113,31 +1127,108 ＠＠ new_val = oth->font[offs]; } - if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val)) + if (!UNBOUNDP (cachel->font[offs]) && + !EQ (cachel->font[offs], new_val)) cachel->dirty = 1; - cachel->font_updated[offs] = 1; + set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); cachel->font[offs] = new_val; + DEBUG_FACES("just recursed on the unbound face, returning " + "something %s\n", UNBOUNDP(new_val) ? "not bound" + : "bound"); return new_val; } - new_val = face_property_matching_instance (face, Qfont, charset, domain, - /* #### look into error flag */ - ERROR_ME_DEBUG_WARN, 1, Qzero); - if (UNBOUNDP (new_val)) - { - bound = 0; - new_val = face_property_matching_instance (face, Qfont, - charset, domain, - /* #### look into error - flag */ - ERROR_ME_DEBUG_WARN, 0, - Qzero); - } + do { + + /* Lookup the face, specifying the initial stage and that fallbacks + shouldn't happen. */ + new_val = face_property_matching_instance (face, Qfont, charset, domain, + /* ERROR_ME_DEBUG_WARN is + fine here. */ + ERROR_ME_DEBUG_WARN, 1, Qzero, + initial); + DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " + "result was something %s\n", + XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), + XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), + UNBOUNDP(new_val) ? "not bound" : "bound"); + + if (!UNBOUNDP (new_val)) break; + + bound = 0; + /* Lookup the face again, this time allowing the fallback. If this + succeeds, it'll give a font intended for the script in question, + which is preferable to translating to ISO10646-1 and using the + fixed-with fallback. */ + new_val = face_property_matching_instance (face, Qfont, + charset, domain, + ERROR_ME_DEBUG_WARN, 0, + Qzero, + initial); + + DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " + "allow fallback, result was something %s\n", + XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), + XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), + UNBOUNDP(new_val) ? "not bound" : "bound"); + + if (!UNBOUNDP(new_val)) + { + break; + } + + bound = 1; + /* Try the face itself with the final-stage specifiers. */ + new_val = face_property_matching_instance (face, Qfont, + charset, domain, + ERROR_ME_DEBUG_WARN, 1, + Qzero, + final); + + DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, " + "result was something %s\n", + XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), + XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), + UNBOUNDP(new_val) ? "not bound" : "bound"); + /* Tell X11 redisplay that it should translate to iso10646-1. */ + if (!UNBOUNDP(new_val)) + { + final_stage = 1; + break; + } + + bound = 0; + + /* Lookup the face again, this time both allowing the fallback and + allowing its final stage to be used. */ + new_val = face_property_matching_instance (face, Qfont, + charset, domain, + ERROR_ME_DEBUG_WARN, 0, + Qzero, + final); + + DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " + "allow fallback, result was something %s\n", + XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), + XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), + UNBOUNDP(new_val) ? "not bound" : "bound"); + if (!UNBOUNDP(new_val)) + { + /* Tell X11 redisplay that it should translate to iso10646-1. */ + final_stage = 1; + break; + } + } while (0); + if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs])) cachel->dirty = 1; - cachel->font_updated[offs] = 1; + + set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); + set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, + final_stage); + set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, + (bound || EQ (face, Vdefault_face))); cachel->font[offs] = new_val; - cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face)); return new_val; } ＠＠ -1399,10 +1490,12 ＠＠ { int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE; - if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs])) + if (!(bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) + && bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED + (Dynarr_atp(w->face_cachels, findex)), offs)) { cachel->font[offs] = FINDEX_FIELD (font[offs]); - cachel->font_specified[offs] = 1; + set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); cachel->dirty = 1; } } ＠＠ -1433,6 +1526,8 ＠＠ } cachel->display_table = Qunbound; cachel->background_pixmap = Qunbound; + FACE_CACHEL_FONT_SPECIFIED (cachel)->size = sizeof(cachel->font_specified); + FACE_CACHEL_FONT_UPDATED (cachel)->size = sizeof(cachel->font_updated); } /* Retrieve the index to a cachel for window W that corresponds to ＠＠ -1505,11 +1600,10 ＠＠ for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) { struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt); - int i; cachel->updated = 0; - for (i = 0; i < NUM_LEADING_BYTES; i++) - cachel->font_updated[i] = 0; + memset(FACE_CACHEL_FONT_UPDATED(cachel)->bits, 0, + BIT_VECTOR_LONG_STORAGE (NUM_LEADING_BYTES)); } } ＠＠ -1896,6 +1990,81 ＠＠ return new_name; } +#ifdef MULE + +Lisp_Object Qone_dimensional, Qtwo_dimensional; + +DEFUN ("specifier-tag-one-dimensional-p", + Fspecifier_tag_one_dimensional_p, + 2, 2, 0, /* +Return non-nil if (charset-dimension CHARSET) is 1. + +Used by the X11 platform font code; see `define-specifier-tag'. You +shouldn't ever need to call this yourself. +*/ + (charset, UNUSED(stage))) +{ + CHECK_CHARSET(charset); + return (1 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil; +} + +DEFUN ("specifier-tag-two-dimensional-p", + Fspecifier_tag_two_dimensional_p, + 2, 2, 0, /* +Return non-nil if (charset-dimension CHARSET) is 2. + +Used by the X11 platform font code; see `define-specifier-tag'. You +shouldn't ever need to call this yourself. +*/ + (charset, UNUSED(stage))) +{ + CHECK_CHARSET(charset); + return (2 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil; +} + +DEFUN ("specifier-tag-final-stage-p", + Fspecifier_tag_final_stage_p, + 2, 2, 0, /* +Return non-nil if STAGE is 'final. + +Used by the X11 platform font code for giving fallbacks; see +`define-specifier-tag'. You shouldn't ever need to call this. +*/ + (UNUSED(charset), stage)) +{ + return EQ(stage, Qfinal) ? Qt : Qnil; +} + +DEFUN ("specifier-tag-initial-stage-p", + Fspecifier_tag_initial_stage_p, + 2, 2, 0, /* +Return non-nil if STAGE is 'initial. + +Used by the X11 platform font code for giving fallbacks; see +`define-specifier-tag'. You shouldn't ever need to call this. +*/ + (UNUSED(charset), stage)) +{ + return EQ(stage, Qinitial) ? Qt : Qnil; +} + +DEFUN ("specifier-tag-encode-as-utf-8-p", + Fspecifier_tag_encode_as_utf_8_p, + 2, 2, 0, /* +Return t if and only if (charset-property CHARSET 'encode-as-utf-8)). + +Used by the X11 platform font code; see `define-specifier-tag'. You +shouldn't ever need to call this. +*/ + (charset, UNUSED(stage))) +{ + /* Used to check that the stage was initial too. */ + CHECK_CHARSET(charset); + return XCHARSET_ENCODE_AS_UTF_8(charset) ? Qt : Qnil; +} + +#endif /* MULE */ + void syms_of_faces (void) ＠＠ -1917,6 +2086,17 ＠＠ DEFSUBR (Fmake_face); DEFSUBR (Fcopy_face); +#ifdef MULE + DEFSYMBOL (Qone_dimensional); + DEFSYMBOL (Qtwo_dimensional); + /* I would much prefer these were in Lisp. */ + DEFSUBR (Fspecifier_tag_one_dimensional_p); + DEFSUBR (Fspecifier_tag_two_dimensional_p); + DEFSUBR (Fspecifier_tag_initial_stage_p); + DEFSUBR (Fspecifier_tag_final_stage_p); + DEFSUBR (Fspecifier_tag_encode_as_utf_8_p); +#endif /* MULE */ + DEFSYMBOL (Qfacep); DEFSYMBOL (Qforeground); DEFSYMBOL (Qbackground); ＠＠ -1980,6 +2160,13 ＠＠ staticpro (&Vpointer_face); Vpointer_face = Qnil; +#ifdef DEBUG_XEMACS + DEFVAR_INT ("debug-x-faces", &debug_x_faces /* +If non-zero, display debug information about X faces +*/ ); + debug_x_faces = 0; +#endif + { Lisp_Object syms[20]; int n = 0; ＠＠ -2046,6 +2233,12 ＠＠ #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) +#ifdef HAVE_GTK + Lisp_Object device_symbol = Qgtk; +#else + Lisp_Object device_symbol = Qx; +#endif + const Ascbyte *fonts[] = { #ifdef USE_XFT ＠＠ -2053,165 +2246,122 ＠＠ /* Note that fontconfig can search for several font families in one call. We should use this facility. */ - "monospace-12", /* Western #### add encoding info? */ + "Monospace-12", Qnil, /* 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? */ + "Sazanami Mincho-12", Vcharset_katakana_jisx0201, + /* 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-*", - /* Next try for any "medium" charcell or monospaced iso8859 font. */ - "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*", - "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*", - /* Next try for any charcell or monospaced iso8859 font. */ - "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*", - "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*", - - /* Repeat, any size */ - "-*-courier-medium-r-*-*-*-*-*-*-*-*-iso8859-*", - "-*-fixed-medium-r-*-*-*-*-*-*-*-*-iso8859-*", - "-*-courier-*-r-*-*-*-*-*-*-*-*-iso8859-*", - "-*-fixed-*-r-*-*-*-*-*-*-*-*-iso8859-*", - /* Next try for any "medium" charcell or monospaced iso8859 font. */ - "-*-*-medium-r-*-*-*-*-*-*-m-*-iso8859-*", - "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-*", - /* Next try for any charcell or monospaced iso8859 font. */ - "-*-*-*-r-*-*-*-*-*-*-m-*-iso8859-*", - "-*-*-*-r-*-*-*-*-*-*-c-*-iso8859-*", - - /* Non-proportional fonts -- last resort. */ - "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*", - "-*-*-*-r-*-*-*-*-*-*-*-*-iso8859-*", - "-*-*-*-*-*-*-*-*-*-*-*-*-iso8859-*", - - /************* Japanese fonts ************/ - - /* Following 3 fonts proposed by Teruhiko.Kurosaka(a)Japan.eng.sun */ - "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0", - "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0", - "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0", - - /* Other Japanese fonts */ - "-*-fixed-medium-r-*--*-jisx0201.1976-*", - "-*-fixed-medium-r-*--*-jisx0208.1983-*", - "-*-fixed-medium-r-*--*-jisx0212*-*", - "-*-*-*-r-*--*-jisx0201.1976-*", - "-*-*-*-r-*--*-jisx0208.1983-*", - "-*-*-*-r-*--*-jisx0212*-*", - - /************* Chinese fonts ************/ - - "-*-*-medium-r-*--*-gb2312.1980-*", - "-*-fixed-medium-r-*--*-cns11643*-*", - - "-*-fixed-medium-r-*--*-big5*-*," - "-*-fixed-medium-r-*--*-sisheng_cwnn-0", - - /************* Korean fonts *************/ - - "-*-mincho-medium-r-*--*-ksc5601.1987-*", - - /************* Thai fonts **************/ - - "-*-fixed-medium-r-*--*-tis620.2529-1", - - /************* Other fonts (nonstandard) *************/ - - "-*-fixed-medium-r-*--*-viscii1.1-1", - "-*-fixed-medium-r-*--*-mulearabic-*", - "-*-fixed-medium-r-*--*-muleipa-*", - "-*-fixed-medium-r-*--*-ethio-*", - - /************* Unicode fonts **************/ - - /* #### We don't yet support Unicode fonts, but doing so would not be - hard because all the machinery has already been added for Windows - support. We need to do this: - - (1) Add "stage 2" support in find_charset_font()/etc.; this finds - an appropriate Unicode font after all the charset-specific fonts - have been checked. This should look at the per-char font info and - 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. - - (3) Notice this flag in separate_textual_runs() and translate the - text into Unicode if so. - */ - - "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso10646-1", - "-*-fixed-medium-r-*-*-*-120-*-*-*-*-iso10646-1", - "-*-courier-*-r-*-*-*-120-*-*-*-*-iso10646-1", - "-*-fixed-*-r-*-*-*-120-*-*-*-*-iso10646-1", - /* Next try for any "medium" charcell or monospaced iso8859 font. */ - "-*-*-medium-r-*-*-*-120-*-*-m-*-iso10646-1", - "-*-*-medium-r-*-*-*-120-*-*-c-*-iso10646-1", - /* Next try for any charcell or monospaced iso8859 font. */ - "-*-*-*-r-*-*-*-120-*-*-m-*-iso10646-1", - "-*-*-*-r-*-*-*-120-*-*-c-*-iso10646-1", - - /* Repeat, any size */ - "-*-courier-medium-r-*-*-*-*-*-*-*-*-iso10646-1", - "-*-fixed-medium-r-*-*-*-*-*-*-*-*-iso10646-1", - "-*-courier-*-r-*-*-*-*-*-*-*-*-iso10646-1", - "-*-fixed-*-r-*-*-*-*-*-*-*-*-iso10646-1", - /* Next try for any "medium" charcell or monospaced iso8859 font. */ - "-*-*-medium-r-*-*-*-*-*-*-m-*-iso10646-1", - "-*-*-medium-r-*-*-*-*-*-*-c-*-iso10646-1", - /* Next try for any charcell or monospaced iso8859 font. */ - "-*-*-*-r-*-*-*-*-*-*-m-*-iso10646-1", - "-*-*-*-r-*-*-*-*-*-*-c-*-iso10646-1", - - /* Non-proportional fonts -- last resort. */ - "-*-*-*-r-*-*-*-120-*-*-*-*-iso10646-1", - "-*-*-*-r-*-*-*-*-*-*-*-*-iso10646-1", - "-*-*-*-*-*-*-*-*-*-*-*-*-iso10646-1", - - /*********** Last resort ***********/ - - /* Boy, we sure are losing now. Try the above, but in any encoding. */ - "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*", - "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*", - "-*-*-*-r-*-*-*-120-*-*-m-*-*-*", - "-*-*-*-r-*-*-*-120-*-*-c-*-*-*", - /* Hello? Please? */ - "-*-*-*-r-*-*-*-120-*-*-*-*-*-*", - "-*-*-*-*-*-*-*-120-*-*-*-*-*-*", - "-*-*-*-*-*-*-*-*-*-*-*-*-*-*", - "*" + /* The default Japanese fonts installed with XFree86 4.0 use this + point size, and the -misc-fixed fonts (which look really bad with + Han characters) don't. We need to prefer the former. */ + "-*-*-medium-r-*-*-*-150-*-*-c-*-*-*", + /* And the Chinese ones, maddeningly, use this one. (But on 4.0, while + XListFonts returns them, XLoadQueryFont on the fully-specified XLFD + corresponding to one of them fails!) */ + "-*-*-medium-r-*-*-*-160-*-*-c-*-*-*", + "-*-*-medium-r-*-*-*-170-*-*-c-*-*-*", #endif }; const Ascbyte **fontptr; -#ifdef HAVE_X_WINDOWS - for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) - inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)), - inst_list); -#endif /* HAVE_X_WINDOWS */ + /* Define some specifier tags for classes of character sets. Combining + these allows for distinct fallback fonts for distinct dimensions of + character sets and stages. */ + + define_specifier_tag(Qtwo_dimensional, Qnil, + intern ("specifier-tag-two-dimensional-p")); + + define_specifier_tag(Qone_dimensional, Qnil, + intern ("specifier-tag-one-dimensional-p")); + + define_specifier_tag(Qinitial, Qnil, + intern ("specifier-tag-initial-stage-p")); + + define_specifier_tag(Qfinal, Qnil, + intern ("specifier-tag-final-stage-p")); + + define_specifier_tag (Qencode_as_utf_8, Qnil, + intern("specifier-tag-encode-as-utf-8-p")); + + inst_list = + Fcons + (Fcons + (list1 (device_symbol), + build_string ("*")), + inst_list); + + /* For Han characters and Ethiopic, we want the misc-fixed font used to + be distinct from that for alphabetic scripts, because the font + specified below is distractingly ugly when used for Han characters + (this is slightly less so) and because its coverage isn't up to + handling them (well, chiefly, it's not up to handling Ethiopic--we do + have charset-specific fallbacks for the East Asian charsets.) */ + inst_list = + Fcons + (Fcons + (list3(device_symbol, Qtwo_dimensional, Qfinal), + build_string + ("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")), + inst_list); + + /* Use Markus Kuhn's version of misc-fixed as the font for the font for + when a given charset's registries can't be found and redisplay for + that charset falls back to iso10646-1. */ + + inst_list = + Fcons + (Fcons + (list3(device_symbol, Qone_dimensional, Qfinal), + build_string + ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), + inst_list); -#ifdef HAVE_GTK for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) - inst_list = Fcons (Fcons (list1 (Qgtk), build_string (*fontptr)), + inst_list = Fcons (Fcons (list3 (device_symbol, + Qtwo_dimensional, Qinitial), + build_string (*fontptr)), inst_list); -#endif /* HAVE_GTK */ + + /* We need to set the font for the JIT-ucs-charsets separately from the + final stage, since otherwise it picks up the two-dimensional + specification (see specifier-tag-two-dimensional-initial-stage-p + above). They also use Markus Kuhn's ISO 10646-1 fixed fonts for + redisplay. */ + + inst_list = + Fcons + (Fcons + (list3(device_symbol, Qencode_as_utf_8, Qinitial), + build_string + ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), + inst_list); + + /* Needed to make sure that charsets with non-specified fonts don't + use bold and oblique first if medium and regular are available. */ + inst_list = + Fcons + (Fcons + (list1 (device_symbol), + build_string ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")), + inst_list); + + /* With a Cygwin XFree86 install, this returns the best (clearest, + most readable) font I can find when scaling of bitmap fonts is + turned on, as it is by default. (WHO IN THE NAME OF CHRIST THOUGHT + THAT WAS A GOOD IDEA?!?!) The other fonts that used to be specified + here gave horrendous results. */ + + inst_list = + Fcons + (Fcons + (list1 (device_symbol), + build_string ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")), + inst_list); + #endif /* HAVE_X_WINDOWS || HAVE_GTK */ #ifdef HAVE_TTY Index: src/faces.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.h,v retrieving revision 1.17 diff -u -u -r1.17 faces.h --- src/faces.h 2006/02/27 16:29:25 1.17 +++ src/faces.h 2006/10/31 22:07:02 ＠＠ -25,6 +25,7 ＠＠ #define INCLUDED_faces_h_ #include "charset.h" /* for NUM_LEADING_BYTES */ +#include "specifier.h" /* a Lisp_Face is the C object corresponding to a face. There is one of these per face. It basically contains all of the specifiers for ＠＠ -181,8 +182,8 ＠＠ /* Used when merging to tell if the above field represents an actual value of this face or a fallback value. */ - /* #### Of course we should use a bit array or something. */ - unsigned char font_specified[NUM_LEADING_BYTES]; + DECLARE_INLINE_LISP_BIT_VECTOR(NUM_LEADING_BYTES) font_specified; + unsigned int foreground_specified :1; unsigned int background_specified :1; unsigned int display_table_specified :1; ＠＠ -223,8 +224,13 ＠＠ storing a "blank font" if the instantiation fails. */ unsigned int dirty :1; unsigned int updated :1; - /* #### Of course we should use a bit array or something. */ - unsigned char font_updated[NUM_LEADING_BYTES]; + + DECLARE_INLINE_LISP_BIT_VECTOR(NUM_LEADING_BYTES) font_updated; + + /* Whether the font for the charset in question was determined in the + "final stage"; that is, the last stage Lisp code could specify it, + after the initial stage and before the fallback. */ + DECLARE_INLINE_LISP_BIT_VECTOR(NUM_LEADING_BYTES) font_final_stage; }; #ifdef NEW_GC ＠＠ -303,6 +309,13 ＠＠ #define FACE_CACHEL_FONT(cachel, charset) \ (cachel->font[XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE]) +#define FACE_CACHEL_FONT_UPDATED(x) \ + ((struct Lisp_Bit_Vector *)(&((x)->font_updated))) +#define FACE_CACHEL_FONT_SPECIFIED(x) \ + ((struct Lisp_Bit_Vector *)(&((x)->font_specified))) +#define FACE_CACHEL_FONT_FINAL_STAGE(x) \ + ((struct Lisp_Bit_Vector *)(&((x)->font_final_stage))) + #define WINDOW_FACE_CACHEL(window, index) \ Dynarr_atp ((window)->face_cachels, index) ＠＠ -352,13 +365,15 ＠＠ FACE_PROPERTY_INSTANCE_1 (face, property, domain, ERROR_ME_DEBUG_WARN, \ no_fallback, depth) -Lisp_Object face_property_matching_instance (Lisp_Object face, - Lisp_Object property, - Lisp_Object charset, - Lisp_Object domain, - Error_Behavior errb, - int no_fallback, - Lisp_Object depth); +Lisp_Object face_property_matching_instance + (Lisp_Object face, + Lisp_Object property, + Lisp_Object charset, + Lisp_Object domain, + Error_Behavior errb, + int no_fallback, + Lisp_Object depth, + enum font_specifier_matchspec_stages stages); #define FACE_PROPERTY_SPEC_LIST(face, property, locale) \ Fspecifier_spec_list (FACE_PROPERTY_SPECIFIER (face, property), \ ＠＠ -373,7 +388,8 ＠＠ FACE_PROPERTY_INSTANCE (face, Qbackground, domain, 0, Qzero) #define FACE_FONT(face, domain, charset) \ face_property_matching_instance (face, Qfont, charset, domain, \ - ERROR_ME_DEBUG_WARN, 0, Qzero) + ERROR_ME_DEBUG_WARN, 0, Qzero, \ + initial) #define FACE_DISPLAY_TABLE(face, domain) \ FACE_PROPERTY_INSTANCE (face, Qdisplay_table, domain, 0, Qzero) #define FACE_BACKGROUND_PIXMAP(face, domain) \ Index: src/fileio.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fileio.c,v retrieving revision 1.105 diff -u -u -r1.105 fileio.c --- src/fileio.c 2006/06/19 18:19:37 1.105 +++ src/fileio.c 2006/10/31 22:07:04 ＠＠ -2948,6 +2948,13 ＠＠ reasonable maximum file size on the files. Is any of this worth it? --ben + + It's probably not worth it, and despite what you might take from the + above, we don't do it currently; that is, for non-"binary" coding + systems, we don't try to implement replace-mode at all. See the + do_speedy_insert variable above. The upside of this is that our API + is consistent and not buggy. -- Aidan Kehoe, Fri Oct 27 21:02:30 CEST + 2006 */ if (!NILP (replace)) Index: src/font-mgr.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.h,v retrieving revision 1.2 diff -u -u -r1.2 font-mgr.h --- src/font-mgr.h 2006/04/25 14:02:09 1.2 +++ src/font-mgr.h 2006/10/31 22:07:04 ＠＠ -68,4 +68,73 ＠＠ #define CONCHECK_FCPATTERN(x) CONCHECK_RECORD (x, fc_pattern) #define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr) +#ifdef USE_XFT +/* + 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, Qfc_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, Qfc_font_name_encoding); \ + DEBUG_XFT2 (level, "checking if %s handles %s\n", \ + eidata(eistrcl_name), lang); \ + } while (0) + +#else /* USE_XFT */ + +#endif /* USE_XFT */ + #endif /* INCLUDED_font_mgr_h_ */ Index: src/general-slots.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/general-slots.h,v retrieving revision 1.17 diff -u -u -r1.17 general-slots.h --- src/general-slots.h 2006/06/03 17:50:54 1.17 +++ src/general-slots.h 2006/10/31 22:07:05 ＠＠ -130,6 +130,7 ＠＠ SYMBOL (Qfile); SYMBOL_MODULE_API (Qfile_name); SYMBOL_KEYWORD (Q_filter); +SYMBOL (Qfinal); SYMBOL (Qfixnum); SYMBOL (Qfloat); SYMBOL (Qfont); ＠＠ -157,6 +158,7 ＠＠ SYMBOL (Qicon); SYMBOL (Qid); SYMBOL (Qignore); +SYMBOL (Qinitial); SYMBOL (Qimage); SYMBOL_KEYWORD (Q_image); SYMBOL_KEYWORD (Q_included); ＠＠ -286,6 +288,7 ＠＠ SYMBOL (Qundecided); SYMBOL (Qundefined); SYMBOL (Qunimplemented); +SYMBOL (Qunicode_registries); SYMBOL (Quser_default); SYMBOL_KEYWORD (Q_value); SYMBOL (Qvalue_assoc); Index: src/intl.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/intl.c,v retrieving revision 1.10 diff -u -u -r1.10 intl.c --- src/intl.c 2005/09/24 16:31:39 1.10 +++ src/intl.c 2006/10/31 22:07:06 ＠＠ -167,7 +167,7 ＠＠ void init_intl (void) { - /* This function can GC */ + /* This function cannot GC, because it explicitly prevents it. */ if (initialized) { int count = begin_gc_forbidden (); Index: src/lisp.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.143 diff -u -u -r1.143 lisp.h --- src/lisp.h 2006/07/08 16:15:56 1.143 +++ src/lisp.h 2006/10/31 22:07:10 ＠＠ -2623,6 +2623,13 ＠＠ #define BIT_VECTOR_LONG_STORAGE(len) \ (((len) + LONGBITS_POWER_OF_2 - 1) >> LONGBITS_LOG2) +/* For when we want to include a bit vector in another structure, and we + know it's of a fixed size. */ +#define DECLARE_INLINE_LISP_BIT_VECTOR(numbits) struct { \ + struct LCRECORD_HEADER lheader; \ + Elemcount size; \ + unsigned long bits[BIT_VECTOR_LONG_STORAGE(numbits)]; \ +} /*------------------------------ symbol --------------------------------*/ ＠＠ -5601,7 +5608,7 ＠＠ extern Lisp_Object Qprogn, Qquit, Qquote, Qrange_error; extern Lisp_Object Qread_char, Qread_from_minibuffer; extern Lisp_Object Qreally_early_error_handler, Qregion_beginning; -extern Lisp_Object Qregion_end, Qregistry, Qreverse_direction_charset; +extern Lisp_Object Qregion_end, Qregistries, Qreverse_direction_charset; extern Lisp_Object Qrun_hooks, Qsans_modifiers, Qsave_buffers_kill_emacs; extern Lisp_Object Qself_insert_command, Qself_insert_defer_undo, Qsequencep; extern Lisp_Object Qset, Qsetting_constant, Qshort_name, Qsingularity_error; Index: src/mule-charset.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v retrieving revision 1.47 diff -u -u -r1.47 mule-charset.c --- src/mule-charset.c 2006/06/03 17:50:54 1.47 +++ src/mule-charset.c 2006/10/31 22:07:10 ＠＠ -35,6 +35,7 ＠＠ #include "lstream.h" #include "mule-ccl.h" #include "objects.h" +#include "specifier.h" /* The various pre-defined charsets. */ ＠＠ -79,7 +80,7 ＠＠ Lisp_Object Qcharsetp; /* Qdoc_string, Qdimension, Qchars defined in general.c */ -Lisp_Object Qregistry, Qfinal, Qgraphic; +Lisp_Object Qregistries, Qfinal, Qgraphic, Qregistry; Lisp_Object Qdirection; Lisp_Object Qreverse_direction_charset; Lisp_Object Qshort_name, Qlong_name; ＠＠ -128,7 +129,7 ＠＠ mark_object (cs->short_name); mark_object (cs->long_name); mark_object (cs->doc_string); - mark_object (cs->registry); + mark_object (cs->registries); mark_object (cs->ccl_program); return cs->name; } ＠＠ -158,7 +159,7 ＠＠ CHARSET_COLUMNS (cs), CHARSET_GRAPHIC (cs), CHARSET_FINAL (cs)); - print_internal (CHARSET_REGISTRY (cs), printcharfun, 0); + print_internal (CHARSET_REGISTRIES (cs), printcharfun, 0); write_fmt_string (printcharfun, " 0x%x>", cs->header.uid); } ＠＠ -167,7 +168,7 ＠＠ { XD_INT, offsetof (Lisp_Charset, from_unicode_levels) }, { XD_LISP_OBJECT, offsetof (Lisp_Charset, name) }, { XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) }, - { XD_LISP_OBJECT, offsetof (Lisp_Charset, registry) }, + { XD_LISP_OBJECT, offsetof (Lisp_Charset, registries) }, { XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) }, { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) }, { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) }, ＠＠ -239,7 +240,8 ＠＠ CHARSET_GRAPHIC (cs) = graphic; CHARSET_FINAL (cs) = final; CHARSET_DOC_STRING (cs) = doc; - CHARSET_REGISTRY (cs) = reg; + CHECK_VECTOR(reg); + CHARSET_REGISTRIES (cs) = reg; CHARSET_ENCODE_AS_UTF_8 (cs) = encode_as_utf_8 ? 1 : 0; CHARSET_CCL_PROGRAM (cs) = Qnil; CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil; ＠＠ -271,6 +273,8 ＠＠ } recalculate_unicode_precedence (); + setup_charset_initial_specifier_tags (obj); + return obj; } ＠＠ -419,8 +423,8 ＠＠ `short-name' Short version of the charset name (ex: Latin-1) `long-name' Long version of the charset name (ex: ISO8859-1 (Latin-1)) -`registry' A regular expression matching the font registry field for - this character set. +`registries' A vector of possible XLFD REGISTRY-ENCODING combinations for + this character set. Note that this is not a regular expression. `dimension' Number of octets used to index a character in this charset. Either 1 or 2. Defaults to 1. `columns' Number of columns used to display a character in this charset. ＠＠ -468,7 +472,7 ＠＠ Ibyte final = 0; int direction = CHARSET_LEFT_TO_RIGHT; int type; - Lisp_Object registry = Qnil; + Lisp_Object registries = Qnil; Lisp_Object charset = Qnil; Lisp_Object ccl_program = Qnil; Lisp_Object short_name = Qnil, long_name = Qnil; ＠＠ -538,10 +542,27 ＠＠ invalid_constant ("Invalid value for `graphic'", value); } + else if (EQ (keyword, Qregistries)) + { + CHECK_VECTOR (value); + registries = value; + } + else if (EQ (keyword, Qregistry)) { + Lisp_Object quoted_registry; + CHECK_STRING (value); - registry = value; + quoted_registry = Fregexp_quote(value); + if (strcmp(XSTRING_DATA(quoted_registry), + XSTRING_DATA(value))) + { + warn_when_safe + (Qregistry, Qwarning, + "Regexps no longer allowed for charset-registry. " + "Treating %s as string", XSTRING_DATA(value)); + } + registries = vector1(value); } else if (EQ (keyword, Qdirection)) ＠＠ -613,8 +634,8 ＠＠ } if (NILP (doc_string)) doc_string = build_string (""); - if (NILP (registry)) - registry = build_string (""); + if (NILP (registries)) + registries = make_vector(0, Qnil); if (NILP (short_name)) short_name = XSYMBOL (name)->name; if (NILP (long_name)) ＠＠ -624,7 +645,7 ＠＠ charset = make_charset (id, name, dimension + 2, type, columns, graphic, final, direction, short_name, long_name, - doc_string, registry, !NILP (existing_charset), + doc_string, registries, !NILP (existing_charset), encode_as_utf_8); XCHARSET (charset)->temporary = temporary; ＠＠ -657,7 +678,7 ＠＠ int id, dimension, columns, graphic, encode_as_utf_8; Ibyte final; int direction, type; - Lisp_Object registry, doc_string, short_name, long_name; + Lisp_Object registries, doc_string, short_name, long_name; Lisp_Charset *cs; charset = Fget_charset (charset); ＠＠ -684,12 +705,12 ＠＠ doc_string = CHARSET_DOC_STRING (cs); short_name = CHARSET_SHORT_NAME (cs); long_name = CHARSET_LONG_NAME (cs); - registry = CHARSET_REGISTRY (cs); + registries = CHARSET_REGISTRIES (cs); encode_as_utf_8 = CHARSET_ENCODE_AS_UTF_8 (cs); new_charset = make_charset (id, new_name, dimension + 2, type, columns, graphic, final, direction, short_name, long_name, - doc_string, registry, 0, encode_as_utf_8); + doc_string, registries, 0, encode_as_utf_8); CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset; XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset; ＠＠ -820,7 +841,7 ＠＠ if (EQ (prop, Qgraphic)) return make_int (CHARSET_GRAPHIC (cs)); if (EQ (prop, Qfinal)) return make_char (CHARSET_FINAL (cs)); if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs)); - if (EQ (prop, Qregistry)) return CHARSET_REGISTRY (cs); + if (EQ (prop, Qregistries)) return CHARSET_REGISTRIES (cs); if (EQ (prop, Qencode_as_utf_8)) return CHARSET_ENCODE_AS_UTF_8 (cs) ? Qt : Qnil; if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs); ＠＠ -862,15 +883,39 ＠＠ return Qnil; } -/* Japanese folks may want to (set-charset-registry 'ascii "jisx0201") */ -DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /* -Set the `registry' property of CHARSET to REGISTRY. +DEFUN ("set-charset-registries", Fset_charset_registries, 2, 2, 0, /* +Set the `registries' property of CHARSET to REGISTRIES. + +REGISTRIES is an ordered vector of strings that describe the X11 +CHARSET_REGISTRY and the CHARSET_ENCODINGs appropriate for this charset. +Separate each registry from the corresponding encoding with a dash. The +strings are not regular expressions, in contrast to the old behavior of +the `charset-registry' property. + +One reason to call this function might be if you're in Japan and you'd +prefer the backslash to display as a Yen sign; the corresponding syntax +would be: + +(set-charset-registries 'ascii ["jisx0201.1976-0"]) + */ - (charset, registry)) + (charset, registries)) { + int i; charset = Fget_charset (charset); - CHECK_STRING (registry); - XCHARSET_REGISTRY (charset) = registry; + CHECK_VECTOR (registries); + + for (i = 0; i < XVECTOR_LENGTH(registries); ++i) + { + CHECK_STRING (XVECTOR_DATA(registries)[i]); + if (NULL == qxestrchr(XSTRING_DATA(XVECTOR_DATA(registries)[i]), '-')) + { + invalid_argument("Not an X11 REGISTRY-ENCODING combination", + XVECTOR_DATA(registries)[i]); + } + } + + XCHARSET_REGISTRIES (charset) = registries; invalidate_charset_font_caches (charset); face_property_was_changed (Vdefault_face, Qfont, Qglobal); return Qnil; ＠＠ -967,16 +1012,17 ＠＠ DEFSUBR (Fcharset_property); DEFSUBR (Fcharset_id); DEFSUBR (Fset_charset_ccl_program); - DEFSUBR (Fset_charset_registry); + DEFSUBR (Fset_charset_registries); #ifdef MEMORY_USAGE_STATS DEFSUBR (Fcharset_memory_usage); #endif DEFSYMBOL (Qcharsetp); - DEFSYMBOL (Qregistry); + DEFSYMBOL (Qregistries); DEFSYMBOL (Qfinal); DEFSYMBOL (Qgraphic); + DEFSYMBOL (Qregistry); DEFSYMBOL (Qdirection); DEFSYMBOL (Qreverse_direction_charset); DEFSYMBOL (Qshort_name); ＠＠ -1056,7 +1102,7 ＠＠ build_string ("ASCII"), build_msg_string ("ASCII"), build_msg_string ("ASCII (ISO646 IRV)"), - build_string ("\$iso8859-[0-9]*\\|-ascii\$"), 0, 0); + vector1(build_string("iso8859-1")), 0, 0); staticpro (&Vcharset_control_1); Vcharset_control_1 = make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 2, ＠＠ -1065,7 +1111,7 ＠＠ build_string ("C1"), build_msg_string ("Control characters"), build_msg_string ("Control characters 128-191"), - build_string (""), 0, 0); + vector1(build_string("iso8859-1")), 0, 0); staticpro (&Vcharset_latin_iso8859_1); Vcharset_latin_iso8859_1 = make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 2, ＠＠ -1074,7 +1120,7 ＠＠ build_string ("Latin-1"), build_msg_string ("ISO8859-1 (Latin-1)"), build_msg_string ("ISO8859-1 (Latin-1)"), - build_string ("iso8859-1"), 0, 0); + vector1(build_string("iso8859-1")), 0, 0); staticpro (&Vcharset_latin_iso8859_2); Vcharset_latin_iso8859_2 = make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 2, ＠＠ -1083,7 +1129,7 ＠＠ build_string ("Latin-2"), build_msg_string ("ISO8859-2 (Latin-2)"), build_msg_string ("ISO8859-2 (Latin-2)"), - build_string ("iso8859-2"), 0, 0); + vector1(build_string("iso8859-2")), 0, 0); staticpro (&Vcharset_latin_iso8859_3); Vcharset_latin_iso8859_3 = make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 2, ＠＠ -1092,7 +1138,7 ＠＠ build_string ("Latin-3"), build_msg_string ("ISO8859-3 (Latin-3)"), build_msg_string ("ISO8859-3 (Latin-3)"), - build_string ("iso8859-3"), 0, 0); + vector1(build_string("iso8859-3")), 0, 0); staticpro (&Vcharset_latin_iso8859_4); Vcharset_latin_iso8859_4 = make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 2, ＠＠ -1101,7 +1147,7 ＠＠ build_string ("Latin-4"), build_msg_string ("ISO8859-4 (Latin-4)"), build_msg_string ("ISO8859-4 (Latin-4)"), - build_string ("iso8859-4"), 0, 0); + vector1(build_string("iso8859-2")), 0, 0); staticpro (&Vcharset_thai_tis620); Vcharset_thai_tis620 = make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 2, ＠＠ -1110,7 +1156,7 ＠＠ build_string ("TIS620"), build_msg_string ("TIS620 (Thai)"), build_msg_string ("TIS620.2529 (Thai)"), - build_string ("tis620"), 0, 0); + vector1(build_string("tis620.2529-1")), 0, 0); staticpro (&Vcharset_greek_iso8859_7); Vcharset_greek_iso8859_7 = make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 2, ＠＠ -1119,7 +1165,7 ＠＠ build_string ("ISO8859-7"), build_msg_string ("ISO8859-7 (Greek)"), build_msg_string ("ISO8859-7 (Greek)"), - build_string ("iso8859-7"), 0, 0); + vector1(build_string("iso8859-7")), 0, 0); staticpro (&Vcharset_arabic_iso8859_6); Vcharset_arabic_iso8859_6 = make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 2, ＠＠ -1128,7 +1174,7 ＠＠ build_string ("ISO8859-6"), build_msg_string ("ISO8859-6 (Arabic)"), build_msg_string ("ISO8859-6 (Arabic)"), - build_string ("iso8859-6"), 0, 0); + vector1(build_string ("iso8859-6")), 0, 0); staticpro (&Vcharset_hebrew_iso8859_8); Vcharset_hebrew_iso8859_8 = make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 2, ＠＠ -1137,7 +1183,7 ＠＠ build_string ("ISO8859-8"), build_msg_string ("ISO8859-8 (Hebrew)"), build_msg_string ("ISO8859-8 (Hebrew)"), - build_string ("iso8859-8"), 0, 0); + vector1(build_string ("iso8859-8")), 0, 0); staticpro (&Vcharset_katakana_jisx0201); Vcharset_katakana_jisx0201 = make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 2, ＠＠ -1146,7 +1192,7 ＠＠ build_string ("JISX0201 Kana"), build_msg_string ("JISX0201.1976 (Japanese Kana)"), build_msg_string ("JISX0201.1976 Japanese Kana"), - build_string ("jisx0201.1976"), 0, 0); + vector1(build_string ("jisx0201.1976-0")), 0, 0); staticpro (&Vcharset_latin_jisx0201); Vcharset_latin_jisx0201 = make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 2, ＠＠ -1155,7 +1201,7 ＠＠ build_string ("JISX0201 Roman"), build_msg_string ("JISX0201.1976 (Japanese Roman)"), build_msg_string ("JISX0201.1976 Japanese Roman"), - build_string ("jisx0201.1976"), 0, 0); + vector1(build_string ("jisx0201.1976-0")), 0, 0); staticpro (&Vcharset_cyrillic_iso8859_5); Vcharset_cyrillic_iso8859_5 = make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 2, ＠＠ -1164,7 +1210,7 ＠＠ build_string ("ISO8859-5"), build_msg_string ("ISO8859-5 (Cyrillic)"), build_msg_string ("ISO8859-5 (Cyrillic)"), - build_string ("iso8859-5"), 0, 0); + vector1(build_string ("iso8859-5")), 0, 0); staticpro (&Vcharset_latin_iso8859_9); Vcharset_latin_iso8859_9 = make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 2, ＠＠ -1173,7 +1219,7 ＠＠ build_string ("Latin-5"), build_msg_string ("ISO8859-9 (Latin-5)"), build_msg_string ("ISO8859-9 (Latin-5)"), - build_string ("iso8859-9"), 0, 0); + vector1(build_string ("iso8859-9")), 0, 0); staticpro (&Vcharset_latin_iso8859_15); Vcharset_latin_iso8859_15 = make_charset (LEADING_BYTE_LATIN_ISO8859_15, Qlatin_iso8859_15, 2, ＠＠ -1182,7 +1228,7 ＠＠ build_string ("Latin-9"), build_msg_string ("ISO8859-15 (Latin-9)"), build_msg_string ("ISO8859-15 (Latin-9)"), - build_string ("iso8859-15"), 0, 0); + vector1(build_string ("iso8859-15")), 0, 0); staticpro (&Vcharset_japanese_jisx0208_1978); Vcharset_japanese_jisx0208_1978 = make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978, 3, ＠＠ -1192,7 +1238,8 ＠＠ build_msg_string ("JISX0208.1978 (Japanese)"), build_msg_string ("JISX0208.1978 Japanese Kanji (so called \"old JIS\")"), - build_string ("\$jisx0208\\|jisc6226\$\\.1978"), 0, 0); + vector2(build_string("jisx0208.1978-0"), + build_string("jisc6226.1978-0")), 0, 0); staticpro (&Vcharset_chinese_gb2312); Vcharset_chinese_gb2312 = make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 3, ＠＠ -1201,7 +1248,8 ＠＠ build_string ("GB2312"), build_msg_string ("GB2312)"), build_msg_string ("GB2312 Chinese simplified"), - build_string ("gb2312"), 0, 0); + vector2(build_string("gb2312.1980-0"), + build_string("gb2312.80&gb8565.88-0")), 0, 0); staticpro (&Vcharset_japanese_jisx0208); Vcharset_japanese_jisx0208 = make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 3, ＠＠ -1210,7 +1258,8 ＠＠ build_string ("JISX0208"), build_msg_string ("JISX0208.1983/1990 (Japanese)"), build_msg_string ("JISX0208.1983/1990 Japanese Kanji"), - build_string ("jisx0208.19\$83\\|90\$"), 0, 0); + vector2(build_string("jisx0208.1983-0"), + build_string("jisx0208.1990-0")), 0, 0); staticpro (&Vcharset_korean_ksc5601); Vcharset_korean_ksc5601 = make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 3, ＠＠ -1219,7 +1268,7 ＠＠ build_string ("KSC5601"), build_msg_string ("KSC5601 (Korean"), build_msg_string ("KSC5601 Korean Hangul and Hanja"), - build_string ("ksc5601"), 0, 0); + vector1(build_string("ksc5601.1987-0")), 0, 0); staticpro (&Vcharset_japanese_jisx0212); Vcharset_japanese_jisx0212 = make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 3, ＠＠ -1228,9 +1277,9 ＠＠ build_string ("JISX0212"), build_msg_string ("JISX0212 (Japanese)"), build_msg_string ("JISX0212 Japanese Supplement"), - build_string ("jisx0212"), 0, 0); + vector1(build_string("jisx0212.1990-0")), 0, 0); -#define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\$.*[.-]\$?" n "$" +#define CHINESE_CNS_PLANE(n) "cns11643.1992-" n staticpro (&Vcharset_chinese_cns11643_1); Vcharset_chinese_cns11643_1 = make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 3, ＠＠ -1240,7 +1289,7 ＠＠ build_msg_string ("CNS11643-1 (Chinese traditional)"), build_msg_string ("CNS 11643 Plane 1 Chinese traditional"), - build_string (CHINESE_CNS_PLANE_RE("1")), 0, 0); + vector1(build_string (CHINESE_CNS_PLANE("1"))), 0, 0); staticpro (&Vcharset_chinese_cns11643_2); Vcharset_chinese_cns11643_2 = make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 3, ＠＠ -1250,7 +1299,7 ＠＠ build_msg_string ("CNS11643-2 (Chinese traditional)"), build_msg_string ("CNS 11643 Plane 2 Chinese traditional"), - build_string (CHINESE_CNS_PLANE_RE("2")), 0, 0); + vector1(build_string (CHINESE_CNS_PLANE("2"))), 0, 0); staticpro (&Vcharset_chinese_big5_1); Vcharset_chinese_big5_1 = make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 3, ＠＠ -1260,7 +1309,7 ＠＠ build_msg_string ("Big5 (Level-1)"), build_msg_string ("Big5 Level-1 Chinese traditional"), - build_string ("big5"), 0, 0); + vector1(build_string ("big5.eten-0")), 0, 0); staticpro (&Vcharset_chinese_big5_2); Vcharset_chinese_big5_2 = make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 3, ＠＠ -1270,7 +1319,7 ＠＠ build_msg_string ("Big5 (Level-2)"), build_msg_string ("Big5 Level-2 Chinese traditional"), - build_string ("big5"), 0, 0); + vector1(build_string ("big5.eten-0")), 0, 0); #ifdef ENABLE_COMPOSITE_CHARS ＠＠ -1285,7 +1334,7 ＠＠ build_string ("Composite"), build_msg_string ("Composite characters"), build_msg_string ("Composite characters"), - build_string (""), 0, 0); + vector1(build_string ("")), 0, 0); #else /* We create a hack so that we have a way of storing ESC 0 and ESC 1 sequences as "characters", so that they will be output correctly. */ ＠＠ -1297,6 +1346,6 ＠＠ build_string ("Composite hack"), build_msg_string ("Composite characters hack"), build_msg_string ("Composite characters hack"), - build_string (""), 0, 0); + vector1(build_string ("")), 0, 0); #endif /* ENABLE_COMPOSITE_CHARS */ } Index: src/objects-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v retrieving revision 1.17 diff -u -u -r1.17 objects-gtk.c --- src/objects-gtk.c 2005/12/24 17:33:34 1.17 +++ src/objects-gtk.c 2006/10/31 22:07:11 ＠＠ -385,7 +385,7 ＠＠ gtk_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset, const Ibyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length, - int stage) + enum font_specifier_matchspec_stages stage) { if (stage) return 0; ＠＠ -436,7 +436,10 ＠＠ /* find a font spec that matches font spec FONT and also matches (the registry of) CHARSET. */ -static Lisp_Object gtk_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset, int stage); +static Lisp_Object +gtk_find_charset_font (Lisp_Object device, Lisp_Object font, + Lisp_Object charset, + enum font_specifier_matchspec_stages stage); #endif /* MULE */ ＠＠ -492,7 +495,8 ＠＠ (the registry of) CHARSET. */ static Lisp_Object gtk_find_charset_font (Lisp_Object device, Lisp_Object font, - Lisp_Object charset, int stage) + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) { char **names; int count = 0; ＠＠ -516,7 +520,7 ＠＠ TO_INTERNAL_FORMAT (C_STRING, names[i], ALLOCA, (intname, intlen), Qctext); if (gtk_font_spec_matches_charset (XDEVICE (device), charset, - intname, Qnil, 0, -1, 0)) + intname, Qnil, 0, -1, stage)) { result = make_string (intname, intlen); break; Index: src/objects-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v retrieving revision 1.47 diff -u -u -r1.47 objects-msw.c --- src/objects-msw.c 2005/01/28 02:58:51 1.47 +++ src/objects-msw.c 2006/10/31 22:07:12 ＠＠ -2182,7 +2182,8 ＠＠ static Lisp_Object mswindows_find_charset_font (Lisp_Object device, Lisp_Object font, - Lisp_Object charset, int stage) + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) { Lisp_Object fontlist, fonttail; Index: src/objects-tty.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v retrieving revision 1.17 diff -u -u -r1.17 objects-tty.c --- src/objects-tty.c 2005/11/25 01:42:06 1.17 +++ src/objects-tty.c 2006/10/31 22:07:12 ＠＠ -367,7 +367,8 ＠＠ (the registry of) CHARSET. */ static Lisp_Object tty_find_charset_font (Lisp_Object device, Lisp_Object font, - Lisp_Object charset, int stage) + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) { Ibyte *fontname = XSTRING_DATA (font); Index: src/objects-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v retrieving revision 1.43 diff -u -u -r1.43 objects-x.c --- src/objects-x.c 2006/06/23 15:45:03 1.43 +++ src/objects-x.c 2006/10/31 22:07:13 ＠＠ -37,6 +37,7 ＠＠ #include "console-x-impl.h" #include "objects-x-impl.h" +#include "elhash.h" #ifdef USE_XFT #include "font-mgr.h" ＠＠ -44,6 +45,36 ＠＠ int x_handle_non_fully_specified_fonts; +#ifdef DEBUG_XEMACS +Fixnum debug_x_objects; +#endif /* DEBUG_XEMACS */ + +#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901) + +#ifdef DEBUG_XEMACS +# define DEBUG_OBJECTS(FORMAT, ...) \ + do { if (debug_x_objects) stderr_out(FORMAT, __VA_ARGS__); } while (0) +#else /* DEBUG_XEMACS */ +# define DEBUG_OBJECTS(format, ...) +#endif /* DEBUG_XEMACS */ + +#elif defined(__GNUC__) + +#ifdef DEBUG_XEMACS +# define DEBUG_OBJECTS(format, args...) \ + do { if (debug_x_objects) stderr_out(format, args ); } while (0) +#else /* DEBUG_XEMACS */ +# define DEBUG_OBJECTS(format, args...) +#endif /* DEBUG_XEMACS */ + +#else /* defined(__STDC_VERSION__) [...] */ +# define DEBUG_OBJECTS (void) +#endif + +#define THIS_IS_X +#include "objects-xlike-inc.c" + + /************************************************************************/ /* color instances */ ＠＠ -205,75 +236,7 ＠＠ /* font instances */ /************************************************************************/ -#ifdef USE_XFT -/* #### all these #defines should probably move to font-mgr.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); \ - Extbyte *name = (Extbyte *) FcNameUnparse (pattern); \ - \ - eicpy_ext(eistrpxft_name, name, Qfc_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, (Extbyte *) font, Qfc_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) ＠＠ -299,6 +262,12 ＠＠ rf = xft_open_font_by_name (dpy, extname); #endif LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding); + /* With XFree86 4.0's fonts, XListFonts returns an entry for + -isas-fangsong ti-medium-r-normal--16-160-72-72-c-160-gb2312.1980-0 but + an XLoadQueryFont on the corresponding XLFD returns NULL. + + XListFonts is not trustworthy (of course, this is news to exactly + no-one used to reading XEmacs source.) */ fs = XLoadQueryFont (dpy, extname); if (!fs && !rf) ＠＠ -461,9 +430,13 ＠＠ Lisp_Object printcharfun, int UNUSED (escapeflag)) { + /* We should print information here about initial vs. final stages; we + can't rely on the device charset stage cache for that, + unfortunately. */ if (FONT_INSTANCE_X_FONT (f)) - write_fmt_string (printcharfun, " font id: 0x%lx", - (unsigned long) FONT_INSTANCE_X_FONT (f)->fid); + 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)) ＠＠ -946,15 +919,52 ＠＠ #ifdef MULE +static int +count_hyphens(const Ibyte *str, Bytecount length, Ibyte **last_hyphen) +{ + int hyphen_count = 0; + const Ibyte *hyphening = str; + const Ibyte *new_hyphening; + + for (hyphen_count = 0; + NULL != (new_hyphening = memchr((const void *)hyphening, '-', length)); + hyphen_count++) + { + ++new_hyphening; + length -= new_hyphening - hyphening; + hyphening = new_hyphening; + } + + if (NULL != last_hyphen) + { + *last_hyphen = (Ibyte *)hyphening; + } + + return hyphen_count; +} + static int 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) + enum font_specifier_matchspec_stages stage) { - if (stage) + Lisp_Object registries = Qnil; + long i, registries_len; + const Ibyte *the_nonreloc; + Bytecount the_length; + + the_nonreloc = nonreloc; + the_length = length; + + if (!the_nonreloc) + the_nonreloc = XSTRING_DATA (reloc); + fixup_internal_substring (nonreloc, reloc, offset, &the_length); + the_nonreloc += offset; + #ifdef USE_XFT + if (stage) { Display *dpy = DEVICE_X_DISPLAY (d); Extbyte *extname; ＠＠ -967,14 +977,15 ＠＠ 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 ;) */ + /* Jesus, Stephen, what the fuck? */ } } -#else - return 0; #endif + /* Hmm, this smells bad. */ if (UNBOUNDP (charset)) return 1; + /* Hack! Short font names don't have the registry in them, so we just assume the user knows what they're doing in the case of ASCII. For other charsets, you gotta give the ＠＠ -986,41 +997,53 ＠＠ 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)) + if (EQ (charset, Vcharset_ascii) && + (!memchr (the_nonreloc, '*', the_length)) + && (5 > (count_hyphens(the_nonreloc, the_length, NULL)))) { - const Ibyte *the_nonreloc = nonreloc; - int i; - Bytecount the_length = length; - - if (!the_nonreloc) - the_nonreloc = XSTRING_DATA (reloc); - fixup_internal_substring (nonreloc, reloc, offset, &the_length); - the_nonreloc += offset; - if (!memchr (the_nonreloc, '*', the_length)) - { - for (i = 0;; i++) - { - const Ibyte *new_nonreloc = (const Ibyte *) - memchr (the_nonreloc, '-', the_length); - if (!new_nonreloc) - break; - new_nonreloc++; - the_length -= new_nonreloc - the_nonreloc; - the_nonreloc = new_nonreloc; - } + return 1; + } - /* If it has less than 5 dashes, it's a short font. - Of course, long fonts always have 14 dashes or so, but short - fonts never have more than 1 or 2 dashes, so this is some - sort of reasonable heuristic. */ - if (i < 5) - return 1; + if (final == stage) + { + registries = Qunicode_registries; + } + else if (initial == stage) + { + registries = XCHARSET_REGISTRIES (charset); + if (NILP(registries)) + { + return 0; } } + else assert(0); + + CHECK_VECTOR (registries); + registries_len = XVECTOR_LENGTH(registries); - return (fast_string_match (XCHARSET_REGISTRY (charset), - nonreloc, reloc, offset, length, 1, - ERROR_ME, 0) >= 0); + for (i = 0; i < registries_len; ++i) + { + if (!(STRINGP(XVECTOR_DATA(registries)[i])) + || (XSTRING_LENGTH(XVECTOR_DATA(registries)[i]) > the_length)) + { + continue; + } + + /* Check if the font spec ends in the registry specified. X11 says + this comparison is case insensitive: XLFD, section 3.11: + + "Alphabetic case distinctions are allowed but are for human + readability concerns only. Conforming X servers will perform + matching on font name query or open requests independent of case." */ + if (0 == qxestrcasecmp(XSTRING_DATA(XVECTOR_DATA(registries)[i]), + the_nonreloc + (the_length - + XSTRING_LENGTH + (XVECTOR_DATA(registries)[i])))) + { + return 1; + } + } + return 0; } #ifdef USE_XFT ＠＠ -1170,26 +1193,18 ＠＠ : 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 -x_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset, - int stage) +xft_find_charset_font (Lisp_Object font, Lisp_Object charset, + enum font_specifier_matchspec_stages stage) { - Extbyte **names; - int count = 0; const Extbyte *patternext; Lisp_Object result = Qnil; - int i; /* #### with Xft need to handle second stage here -- sjt Hm. Or maybe not. That would be cool. :-) */ if (stage) return Qnil; -#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. */ ＠＠ -1339,7 +1354,6 ＠＠ } ASSERT_ASCTEXT_ASCII((Extbyte *) lang); - } if (fccs) { ＠＠ -1356,7 +1370,7 ＠＠ 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 + unwieldy, but the shorter names are 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? */ ＠＠ -1432,42 +1446,175 ＠＠ return result; } - DEBUG_XFT1 (0, "shit happens, try X11 charset match for %s\n", - XSTRING_DATA(font)); + return Qnil; #undef DECLARE_DEBUG_FONTNAME +} + #endif /* USE_XFT */ - LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding); +static Lisp_Object +xlistfonts_checking_charset (Lisp_Object device, const Extbyte *xlfd, + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) +{ + Extbyte **names; + Lisp_Object result = Qnil; + int count = 0, i; + DECLARE_EISTRING(ei_single_result); + 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; - Bytecount intlen; - - TO_INTERNAL_FORMAT (C_STRING, names[i], - ALLOCA, (intname, intlen), - Qx_font_name_encoding); + xlfd, MAX_FONT_COUNT, &count); + for (i = 0; i < count; ++i) + { + eireset(ei_single_result); + eicpy_ext(ei_single_result, names[i], Qx_font_name_encoding); + if (x_font_spec_matches_charset (XDEVICE (device), charset, - intname, Qnil, 0, -1, 0)) + eidata(ei_single_result), Qnil, 0, + -1, stage)) { - result = build_ext_string ((const Extbyte *) intname, - Qx_font_name_encoding); + result = eimake_string(ei_single_result); + DEBUG_OBJECTS ("in xlistfonts_checking_charset, returning %s\n", + eidata(ei_single_result)); break; } } if (names) - XFreeFontNames (names); + { + XFreeFontNames (names); + } + + return result; +} + +/* find a font spec that matches font spec FONT and also matches + (the registry of) CHARSET. */ +static Lisp_Object +x_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset, + enum font_specifier_matchspec_stages stage) +{ + Lisp_Object result = Qnil, registries = Qnil; + int j, hyphen_count, registries_len = 0; + Ibyte *hyphening, *new_hyphening; + Bytecount xlfd_length; + + DECLARE_EISTRING(ei_xlfd_without_registry); + DECLARE_EISTRING(ei_xlfd); + +#ifdef USE_XFT + result = xft_find_charset_font(font, charset, stage); + if (!NILP(result)) + { + return result; + } +#endif + + switch (stage) + { + case initial: + { + if (!(NILP(XCHARSET_REGISTRIES(charset))) + && VECTORP(XCHARSET_REGISTRIES(charset))) + { + registries_len = XVECTOR_LENGTH(XCHARSET_REGISTRIES(charset)); + registries = XCHARSET_REGISTRIES(charset); + } + break; + } + case final: + { + registries_len = 1; + registries = Qunicode_registries; + break; + } + default: + { + assert(0); + break; + } + } + + eicpy_lstr(ei_xlfd, font); + hyphening = eidata(ei_xlfd); + xlfd_length = eilen(ei_xlfd); + + /* Count the hyphens in the string, moving new_hyphening to just after the + last one. */ + hyphen_count = count_hyphens(hyphening, xlfd_length, &new_hyphening); + + if (0 == registries_len || (5 > hyphen_count && + !(1 == xlfd_length && '*' == *hyphening))) + { + /* No proper XLFD specified, or we can't modify the pattern to change + the registry and encoding to match what we want, or we have no + information on the registry needed. */ + eito_external(ei_xlfd, Qx_font_name_encoding); + DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n", + eidata(ei_xlfd)); + result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd), + charset, stage); + /* No need to loop through the available registries; return + immediately. */ + return result; + } + else if (1 == xlfd_length && '*' == *hyphening) + { + /* It's a single asterisk. We can add the registry directly to the + end. */ + eicpy_ch(ei_xlfd_without_registry, '*'); + } + else + { + /* It's a fully-specified XLFD. Work out where the registry and + encoding are, and initialise ei_xlfd_without_registry to the string + without them. */ + + /* count_hyphens has set new_hyphening to just after the last + hyphen. Move back to just after the hyphen before it. */ - /* Check for a short font name. */ - if (NILP (result) - && x_font_spec_matches_charset (XDEVICE (device), charset, 0, - font, 0, -1, 0)) - return font; + for (new_hyphening -= 2; new_hyphening > hyphening + && '-' != *new_hyphening; --new_hyphening) + ; + ++new_hyphening; + eicpy_ei(ei_xlfd_without_registry, ei_xlfd); + + /* Manipulate ei_xlfd_without_registry, using the information about + ei_xlfd, to which it's identical. */ + eidel(ei_xlfd_without_registry, new_hyphening - hyphening, -1, + eilen(ei_xlfd) - (new_hyphening - hyphening), -1); + + } + + /* Now, loop through the registries and encodings defined for this + charset, doing an XListFonts each time with the pattern modified to + specify the regisry and encoding. This avoids huge amounts of IPC and + duplicated searching; now we use the searching the X server was doing + anyway, where before the X server did its search, transferred huge + amounts of data, and then we proceeded to do a regexp search on that + data. */ + for (j = 0; j < registries_len && NILP(result); ++j) + { + eireset(ei_xlfd); + eicpy_ei(ei_xlfd, ei_xlfd_without_registry); + + eicat_lstr(ei_xlfd, XVECTOR_DATA(registries)[j]); + + eito_external(ei_xlfd, Qx_font_name_encoding); + + DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n", + eidata(ei_xlfd)); + result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd), + charset, stage); + } + + /* This function used to return the font spec, in the case where a font + didn't exist on the X server but it did match the charset. We're not + doing that any more, because none of the other platform code does, and + the old behaviour was badly-judged in other respects, so I don't trust + the original author to have had a good reason for it. */ + return result; } ＠＠ -1512,6 +1659,13 ＠＠ void vars_of_objects_x (void) { +#ifdef DEBUG_XEMACS + DEFVAR_INT ("debug-x-objects", &debug_x_objects /* +If non-zero, display debug information about X objects +*/ ); + debug_x_objects = 0; +#endif + DEFVAR_BOOL ("x-handle-non-fully-specified-fonts", &x_handle_non_fully_specified_fonts /* If this is true then fonts which do not have all characters specified Index: src/objects.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v retrieving revision 1.31 diff -u -u -r1.31 objects.c --- src/objects.c 2005/11/26 11:46:10 1.31 +++ src/objects.c 2006/10/31 22:07:14 ＠＠ -323,8 +323,11 ＠＠ write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name); write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); if (!NILP (f->device)) - MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, - (f, printcharfun, escapeflag)); + { + MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, + (f, printcharfun, escapeflag)); + + } write_fmt_string (printcharfun, " 0x%x>", f->header.uid); } ＠＠ -776,7 +779,7 ＠＠ font_spec_matches_charset (struct device *d, Lisp_Object charset, const Ibyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length, - int stage) + enum font_specifier_matchspec_stages stage) { return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, (d, charset, nonreloc, reloc, offset, length, ＠＠ -789,6 +792,21 ＠＠ { CHECK_CONS (matchspec); Fget_charset (XCAR (matchspec)); + + do + { + if (EQ(XCDR(matchspec), Qinitial)) + { + break; + } + if (EQ(XCDR(matchspec), Qfinal)) + { + break; + } + + invalid_argument("Invalid font matchspec stage", + XCDR(matchspec)); + } while (0); } void ＠＠ -836,12 +854,23 ＠＠ Lisp_Object instance; Lisp_Object charset = Qnil; #ifdef MULE - int stage = 0; + enum font_specifier_matchspec_stages stage = initial; if (!UNBOUNDP (matchspec)) { charset = Fget_charset (XCAR (matchspec)); - stage = NILP (XCDR (matchspec)) ? 0 : 1; + +#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ + { \ + stage = new_stage; \ + } + + FROB(initial) + else FROB(final) + else assert(0); + +#undef FROB + } #endif ＠＠ -864,6 +893,7 ＠＠ if (STRINGP (instantiator)) { #ifdef MULE + /* #### rename these caches. */ Lisp_Object cache = stage ? d->charset_font_cache_stage_2 : d->charset_font_cache_stage_1; #else ＠＠ -921,10 +951,22 ＠＠ } else if (VECTORP (instantiator)) { + Lisp_Object match_inst = Qunbound; assert (XVECTOR_LENGTH (instantiator) == 1); - return (face_property_matching_instance - (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, - charset, domain, ERROR_ME, 0, depth)); + + match_inst = face_property_matching_instance + (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, + charset, domain, ERROR_ME, 0, depth, initial); + + if (UNBOUNDP(match_inst)) + { + match_inst = face_property_matching_instance + (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, + charset, domain, ERROR_ME, 0, depth, final); + } + + return match_inst; + } else if (NILP (instantiator)) return Qunbound; Index: src/objects.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.h,v retrieving revision 1.11 diff -u -u -r1.11 objects.h --- src/objects.h 2005/11/26 11:46:10 1.11 +++ src/objects.h 2006/10/31 22:07:14 ＠＠ -76,4 +76,8 ＠＠ void set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property); +/* Defined in search.c, used in mule-charset.c; slightly ugly to declare it + here, but oh well. */ +EXFUN (Fregexp_quote, 1); + #endif /* INCLUDED_objects_h_ */ Index: src/redisplay-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-x.c,v retrieving revision 1.43 diff -u -u -r1.43 redisplay-x.c --- src/redisplay-x.c 2006/06/27 22:59:40 1.43 +++ src/redisplay-x.c 2006/10/31 22:07:14 ＠＠ -41,9 +41,8 ＠＠ #include "sysdep.h" #include "window.h" -#ifdef MULE #include "mule-ccl.h" -#endif +#include "charset.h" #include "console-x-impl.h" #include "glyphs-x.h" ＠＠ -154,138 +153,145 ＠＠ static int separate_textual_runs (unsigned char *text_storage, struct textual_run *run_storage, - const Ichar *str, Charcount len) + const Ichar *str, Charcount len, + struct face_cachel *cachel) { Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a possible valid charset when MULE is not defined */ - int runs_so_far = 0; - int i; -#ifdef MULE + int runs_so_far = 0, i; + Ibyte charset_leading_byte = LEADING_BYTE_ASCII; + int dimension = 1, graphic = 0, need_ccl_conversion = 0; + Lisp_Object ccl_prog; struct ccl_program char_converter; - int need_ccl_conversion = 0; -#endif + +#ifdef USE_XFT +#define translate_to_ucs_2 1 /* Translate to UTF-16 unconditionally. */ +#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) (void)(arg) /* Empty, + may avoid some + warnings. */ +#else /* USE_XFT */ +#ifndef MULE +#define translate_to_ucs_2 0 /* We don't support falling back to + iso10646-1 without MULE */ +#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) (void)(arg) +#else /* if MULE */ + int translate_to_ucs_2 = 0; +#define MAYBE_ASSIGN_TRANSLATE_TO_UCS_2(arg) translate_to_ucs_2 = (arg) +#endif /* MULE */ +#endif /* !USE_XFT */ for (i = 0; i < len; i++) { Ichar ch = str[i]; Lisp_Object charset; - int byte1, byte2; /* #### why aren't these UExtbytes? */ - int dimension; - int graphic; - + int byte1, byte2; /* Not UExbytes because BREAKUP_ICHAR takes + the addresses of its arguments and + dereferences those addresses as integer + pointers. */ BREAKUP_ICHAR (ch, charset, byte1, byte2); - dimension = XCHARSET_DIMENSION (charset); - graphic = XCHARSET_GRAPHIC (charset); if (!EQ (charset, prev_charset)) { 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) { run_storage[runs_so_far - 1].len = text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) - run_storage[runs_so_far - 1].len >>= 1; + /* Checks the value for dimension from the previous run. */ + if (2 == dimension) run_storage[runs_so_far - 1].len >>= 1; } - runs_so_far++; - prev_charset = charset; + + charset_leading_byte = XCHARSET_LEADING_BYTE(charset); + + MAYBE_ASSIGN_TRANSLATE_TO_UCS_2 + (bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE + (cachel), + charset_leading_byte - MIN_LEADING_BYTE)); + + if (translate_to_ucs_2) + { + dimension = 2; + run_storage[runs_so_far].dimension = 2; + } + else + { + dimension = XCHARSET_DIMENSION (charset); + run_storage[runs_so_far].dimension = dimension; #ifdef MULE - { - Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset); - if ((!NILP (ccl_prog)) + + ccl_prog = XCHARSET_CCL_PROGRAM (charset); + if ((!NILP (ccl_prog)) && (setup_ccl_program (&char_converter, ccl_prog) >= 0)) - need_ccl_conversion = 1; - } -#endif - } + { + need_ccl_conversion = 1; + } + else + { + /* The graphic property is only relevant if we're neither + doing the CCL conversion nor doing the UTF-16 + conversion; it's irrelevant otherwise. */ + graphic = XCHARSET_GRAPHIC (charset); + need_ccl_conversion = 0; + } +#endif /* MULE */ + } + prev_charset = charset; -#ifndef USE_XFT - if (graphic == 0) - { - byte1 &= 0x7F; - byte2 &= 0x7F; - } - else if (graphic == 1) + runs_so_far++; + } + + if (translate_to_ucs_2) { - byte1 |= 0x80; - byte2 |= 0x80; + int ucs = ichar_to_unicode(ch); + + /* If UCS is less than zero or greater than 0xFFFF, set it to + REPLACMENT CHARACTER. */ + if (ucs & ~0xFFFF) + { + ucs = 0xFFFD; + } + + /* Ignoring the "graphic" handling. Also, X11 (XFT included) takes + its font indices with network byte order. */ + byte1 = ucs >> 8; + byte2 = ucs & 0xFF; } #ifdef MULE - if (need_ccl_conversion) + else if (need_ccl_conversion) { - char_converter.reg[0] = XCHARSET_ID (charset); + char_converter.reg[0] = charset_leading_byte; char_converter.reg[1] = byte1; char_converter.reg[2] = byte2; ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING); byte1 = char_converter.reg[1]; byte2 = char_converter.reg[2]; } + else if (graphic == 0) + { + byte1 &= 0x7F; + byte2 &= 0x7F; + } + else + { + byte1 |= 0x80; + byte2 |= 0x80; + } #endif /* MULE */ - *text_storage++ = (unsigned char) byte1; - /* This dimension stuff is broken if you want to use a two-dimensional - X11 font to display a single-dimensional character set, as is - appropriate for the IPA (use one of the -iso10646-1 fonts) or some - of the other non-standard character sets. */ - 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 */ + *text_storage++ = (unsigned char)byte1; +#ifdef MULE + if (2 == dimension) *text_storage++ = (unsigned char)byte2; +#endif /* MULE */ } if (runs_so_far) { run_storage[runs_so_far - 1].len = text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) + /* Dimension retains the relevant value for the run before it. */ + if (2 == dimension) run_storage[runs_so_far - 1].len >>= 1; } ＠＠ -361,7 +367,8 ＠＠ int nruns; int i; - nruns = separate_textual_runs (text_storage, runs, str, len); + nruns = separate_textual_runs (text_storage, runs, str, len, + cachel); for (i = 0; i < nruns; i++) width_so_far += x_text_width_single_run (f, cachel, runs + i); ＠＠ -1014,7 +1021,7 ＠＠ } nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), - Dynarr_length (buf)); + Dynarr_length (buf), cachel); for (i = 0; i < nruns; i++) { Index: src/redisplay.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v retrieving revision 1.100 diff -u -u -r1.100 redisplay.c --- src/redisplay.c 2006/07/08 16:15:56 1.100 +++ src/redisplay.c 2006/10/31 22:07:18 ＠＠ -760,7 +760,7 ＠＠ static int space_width (struct window *w) { - /* While tabs are traditional composed of spaces, for variable-width + /* While tabs are traditionally composed of spaces, for variable-width fonts the space character tends to give too narrow a value. So we use 'n' instead. Except that we don't. We use the default character width for the default face. If this is actually Index: src/specifier.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v retrieving revision 1.44 diff -u -u -r1.44 specifier.c --- src/specifier.c 2006/02/27 16:29:28 1.44 +++ src/specifier.c 2006/10/31 22:07:19 ＠＠ -47,6 +47,7 ＠＠ Lisp_Object Qconsole_type, Qdevice_class; static Lisp_Object Vuser_defined_tags; +static Lisp_Object Vcharset_tag_lists; typedef struct specifier_type_entry specifier_type_entry; struct specifier_type_entry ＠＠ -834,10 +835,10 ＠＠ DEFUN ("valid-specifier-tag-set-p", Fvalid_specifier_tag_set_p, 1, 1, 0, /* Return non-nil if TAG-SET is a valid specifier tag set. -A specifier tag set is an entity that is attached to an instantiator -and can be used to restrict the scope of that instantiator to a -particular device class or device type and/or to mark instantiators -added by a particular package so that they can be later removed. +A specifier tag set is an entity that is attached to an instantiator and can +be used to restrict the scope of that instantiator to a particular device +class, device type, or charset. It can also be used to mark instantiators +added by a particular package so that they can be later removed as a group. A specifier tag set consists of a list of zero of more specifier tags, each of which is a symbol that is recognized by XEmacs as a tag. ＠＠ -846,13 +847,20 ＠＠ \(as opposed to a list) because the order of the tags or the number of times a particular tag occurs does not matter. -Each tag has a predicate associated with it, which specifies whether -that tag applies to a particular device. The tags which are device types -and classes match devices of that type or class. User-defined tags can -have any predicate, or none (meaning that all devices match). When -attempting to instantiate a specifier, a particular instantiator is only -considered if the device of the domain being instantiated over matches -all tags in the tag set attached to that instantiator. +Each tag has two predicates associated with it, which specify, respectively, +whether that tag applies to a particular device and whether it applies to a +particular character set. The predefined tags which are device types and +classes match devices of that type or class. User-defined tags can have any +device predicate, or none (meaning that all devices match). When attempting +to instantiate a specifier, a particular instantiator is only considered if +the device of the domain being instantiated over matches all tags in the tag +set attached to that instantiator. + +If a charset is to be considered--which is only the case for face +instantiators--this consideration may be done twice. The first iteration +pays attention to the character set predicates; if no instantiator can be +found in that case, the search is repeated ignoring the character set +predicates. Most of the time, a tag set is not specified, and the instantiator gets a null tag set, which matches all devices. ＠＠ -973,6 +981,63 ＠＠ return 1; } +static int +charset_matches_specifier_tag_set_p (Lisp_Object charset, + Lisp_Object tag_set, + enum font_specifier_matchspec_stages + stage) +{ + Lisp_Object rest; + int res = 0; + + assert(stage != impossible); + + LIST_LOOP (rest, tag_set) + { + Lisp_Object tag = XCAR (rest); + Lisp_Object assoc; + + /* This function will not ever be called with a charset for which the + relevant information hasn't been calculated (the information is + calculated with the creation of every charset). */ + assert (!NILP(XVECTOR_DATA + (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) + - MIN_LEADING_BYTE])); + + /* Now, find out what the pre-calculated value is. */ + assoc = assq_no_quit(tag, + XVECTOR_DATA(Vcharset_tag_lists) + [XCHARSET_LEADING_BYTE(charset) + - MIN_LEADING_BYTE]); + + if (!(NILP(assoc)) && !(NILP(XCDR(assoc)))) + { + assert(VECTORP(XCDR(assoc))); + + /* In the event that a tag specifies a charset, then the specifier + must match for (this stage and this charset) for all + charset-specifying tags. */ + if (NILP(XVECTOR_DATA(XCDR(assoc))[stage])) + { + /* It doesn't match for this tag, even though the tag + specifies a charset. Return 0. */ + return 0; + } + + /* This tag specifies charset limitations, and this charset and + stage match those charset limitations. + + In the event that a later tag specifies charset limitations + that don't match, the return 0 above prevents us giving a + positive match. */ + res = 1; + } + } + + return res; +} + + DEFUN ("device-matches-specifier-tag-set-p", Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /* Return non-nil if DEVICE matches specifier tag set TAG-SET. ＠＠ -990,56 +1055,61 ＠＠ return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil; } -DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /* -Define a new specifier tag. -If PREDICATE is specified, it should be a function of one argument -\(a device) that specifies whether the tag matches that particular -device. If PREDICATE is omitted, the tag matches all devices. - -You can redefine an existing user-defined specifier tag. However, -you cannot redefine the built-in specifier tags (the device types -and classes) or the symbols nil, t, `all', or `global'. -*/ - (tag, predicate)) +Lisp_Object +define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate, + Lisp_Object charset_predicate) { - Lisp_Object assoc, devcons, concons; - int recompute = 0; + Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags), + concons, devcons, charpres = Qnil; + int recompute_devices = 0, recompute_charsets = 0, i, max_args; - CHECK_SYMBOL (tag); - if (valid_device_class_p (tag) || - valid_console_type_p (tag)) - invalid_change ("Cannot redefine built-in specifier tags", tag); - /* Try to prevent common instantiators and locales from being - redefined, to reduce ambiguity */ - if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal)) - invalid_change ("Cannot define nil, t, `all', or `global'", tag); - assoc = assq_no_quit (tag, Vuser_defined_tags); if (NILP (assoc)) { - recompute = 1; - Vuser_defined_tags = Fcons (Fcons (tag, predicate), Vuser_defined_tags); + recompute_devices = recompute_charsets = 1; + Vuser_defined_tags = Fcons (list3 (tag, device_predicate, + charset_predicate), + Vuser_defined_tags); DEVICE_LOOP_NO_BREAK (devcons, concons) { struct device *d = XDEVICE (XCAR (devcons)); /* Initially set the value to t in case of error - in predicate */ + in device_predicate */ DEVICE_USER_DEFINED_TAGS (d) = Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d)); } } - else if (!NILP (predicate) && !NILP (XCDR (assoc))) + else if (!NILP (device_predicate) && !NILP (XCADR (assoc))) { - recompute = 1; - XCDR (assoc) = predicate; + recompute_devices = 1; + XCDR (assoc) = list2(device_predicate, charset_predicate); } + else if (!NILP (charset_predicate) || !NILP(XCADDR (assoc))) + { + max_args = XINT(Ffunction_max_args(charset_predicate)); + if (max_args < 1) + { + invalid_argument + ("Charset predicate must be able to take an argument", tag); + } + + /* If there exists a charset_predicate for the tag currently (even if + the new charset_predicate is nil), or if we're adding one, we need + to recompute. This contrasts with the device predicates, where we + don't need to recompute if the old and new device predicates are + both nil. */ + + recompute_charsets = 1; + XCDR (assoc) = list2(device_predicate, charset_predicate); + } - /* recompute the tag values for all devices. However, in the special - case where both the old and new predicates are nil, we know that - we don't have to do this. (It's probably common for people to - call (define-specifier-tag) more than once on the same tag, - and the most common case is where PREDICATE is not specified.) */ + /* Recompute the tag values for all devices and charsets, if necessary. In + the special case where both the old and new device_predicates are nil, + we know that we don't have to do it for the device. (It's probably + common for people to call (define-specifier-tag) more than once on the + same tag, and the most common case is where DEVICE_PREDICATE is not + specified.) */ - if (recompute) + if (recompute_devices) { DEVICE_LOOP_NO_BREAK (devcons, concons) { ＠＠ -1047,16 +1117,155 ＠＠ assoc = assq_no_quit (tag, DEVICE_USER_DEFINED_TAGS (XDEVICE (device))); assert (CONSP (assoc)); - if (NILP (predicate)) + if (NILP (device_predicate)) XCDR (assoc) = Qt; else - XCDR (assoc) = !NILP (call1 (predicate, device)) ? Qt : Qnil; + XCDR (assoc) = !NILP (call1 (device_predicate, device)) ? Qt + : Qnil; } } - return Qnil; + if (recompute_charsets) + { + if (NILP(charset_predicate)) + { + charpres = Qnil; + } + + for (i = 0; i < NUM_LEADING_BYTES; ++i) + { + if (NILP(charset_by_leading_byte(MIN_LEADING_BYTE + i))) + { + continue; + } + + assoc = assq_no_quit (tag, + XVECTOR_DATA(Vcharset_tag_lists)[i]); + + if (!NILP(charset_predicate)) + { + charpres = make_vector(impossible, Qnil); + + /* If you want to extend the number of stages available, here + in setup_charset_initial_specifier_tags, and in specifier.h + is where you want to go. */ + +#define DEFINE_SPECIFIER_TAG_FROB(stage) do { \ + if (max_args > 1) \ + { \ + XVECTOR_DATA(charpres)[stage] = \ + call2_trapping_problems \ + ("Error during specifier tag charset predicate," \ + " stage " #stage, charset_predicate, \ + charset_by_leading_byte(MIN_LEADING_BYTE + i), \ + Q##stage, 0); \ + } \ + else \ + { \ + XVECTOR_DATA(charpres)[stage] = \ + call1_trapping_problems \ + ("Error during specifier tag charset predicate," \ + " stage " #stage, charset_predicate, \ + charset_by_leading_byte(MIN_LEADING_BYTE + i), \ + 0); \ + } \ + \ + if (UNBOUNDP(XVECTOR_DATA(charpres)[stage])) \ + { \ + XVECTOR_DATA(charpres)[stage] = Qnil; \ + } \ + else if (!NILP(XVECTOR_DATA(charpres)[stage])) \ + { \ + /* Don't want refs to random other objects. */ \ + XVECTOR_DATA(charpres)[stage] = Qt; \ + } \ + } while (0) + + DEFINE_SPECIFIER_TAG_FROB (initial); + DEFINE_SPECIFIER_TAG_FROB (final); + +#undef DEFINE_SPECIFIER_TAG_FROB + + } + + if (!NILP(assoc)) + { + assert(CONSP(assoc)); + XCDR (assoc) = charpres; + } + else + { + XVECTOR_DATA(Vcharset_tag_lists)[i] + = Fcons(Fcons(tag, charpres), + XVECTOR_DATA (Vcharset_tag_lists)[i]); + } + } + } + return Qt; } +DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 3, 0, /* +Define a new specifier tag. + +If DEVICE-PREDICATE is specified, it should be a function of one argument +\(a device) that specifies whether the tag matches that particular device. +If DEVICE-PREDICATE is omitted, the tag matches all devices. + +If CHARSET-PREDICATE is supplied, it should be a function taking a single +Lisp character set argument. A tag's charset predicate is primarily used to +determine what font to use for a given \(set of) charset\(s) when that tag +is used in a set-face-font call; a non-nil return value indicates that the +tag matches the charset. + +The font matching process also has a concept of stages; the defined stages +are currently `initial' and `final', and there exist specifier tags +with those names that correspond to those stages. On X11, 'initial is used +when the font matching process is looking for fonts that match the desired +registries of the charset--see the `charset-registries' function. If that +match process fails, then the 'final tag becomes relevant; this means that a +more general lookup is desired, and that a font doesn't necessarily have to +match the desired XLFD for the face, just the charset repertoire for this +charset. It also means that the charset registry and encoding used will be +`iso10646-1', and the characters will be converted to display using that +registry. + +If a tag set matches no character set; the two-stage match process will +ignore the tag on its first pass, but if no match is found, it will respect +it on the second pass, where character set information is ignored. + +You can redefine an existing user-defined specifier tag. However, you cannot +redefine the built-in specifier tags \(the device types and classes, +`initial', and `final') or the symbols nil, t, `all', or `global'. Note that +if a device type is not supported in this XEmacs, it will not be available +as a built-in specifier tag; this is probably something we should change. +*/ + (tag, device_predicate, charset_predicate)) +{ + int max_args; + + CHECK_SYMBOL (tag); + if (valid_device_class_p (tag) || + valid_console_type_p (tag) || + EQ (tag, Qinitial) || EQ (tag, Qfinal)) + invalid_change ("Cannot redefine built-in specifier tags", tag); + /* Try to prevent common instantiators and locales from being + redefined, to reduce ambiguity */ + if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal)) + invalid_change ("Cannot define nil, t, `all', or `global'", tag); + + if (!NILP (charset_predicate)) + { + max_args = XINT(Ffunction_max_args(charset_predicate)); + if (max_args < 1) + { + invalid_change ("Charset predicate must take one argument", + tag); + } + } + + return define_specifier_tag(tag, device_predicate, charset_predicate); +} + /* Called at device-creation time to initialize the user-defined tag values for the newly-created device. */ ＠＠ -1065,6 +1274,8 ＠＠ { Lisp_Object rest, rest2; Lisp_Object device = wrap_device (d); + Lisp_Object device_predicate, charset_predicate; + int list_len; DEVICE_USER_DEFINED_TAGS (d) = Fcopy_alist (Vuser_defined_tags); ＠＠ -1075,15 +1286,83 ＠＠ for (rest = Vuser_defined_tags, rest2 = DEVICE_USER_DEFINED_TAGS (d); !NILP (rest); rest = XCDR (rest), rest2 = XCDR (rest2)) { - Lisp_Object predicate = XCDR (XCAR (rest)); - if (NILP (predicate)) - XCDR (XCAR (rest2)) = Qt; + GET_LIST_LENGTH(XCAR(rest), list_len); + + assert(3 == list_len); + + device_predicate = XCADR(XCAR (rest)); + charset_predicate = XCADDR(XCAR (rest)); + + if (NILP (device_predicate)) + { + XCDR (XCAR (rest2)) = list2(Qt, charset_predicate); + } else - XCDR (XCAR (rest2)) = - !NILP (call_critical_lisp_code (d, predicate, device)) ? Qt : Qnil; + { + device_predicate = !NILP (call_critical_lisp_code + (d, device_predicate, device)) + ? Qt : Qnil; + XCDR (XCAR (rest2)) = list2(device_predicate, charset_predicate); + } } } +void +setup_charset_initial_specifier_tags (Lisp_Object charset) +{ + Lisp_Object rest, charset_predicate, tag, new_value; + Lisp_Object charset_tag_list = Qnil; + + LIST_LOOP (rest, Vuser_defined_tags) + { + tag = XCAR(XCAR(rest)); + charset_predicate = XCADDR(XCAR (rest)); + + if (NILP(charset_predicate)) + { + continue; + } + + new_value = make_vector(impossible, Qnil); + +#define SETUP_CHARSET_TAGS_FROB(stage) do { \ + \ + XVECTOR_DATA(new_value)[stage] = call2_trapping_problems \ + ("Error during specifier tag charset predicate," \ + " stage " #stage, \ + charset_predicate, charset, Q##stage, 0); \ + \ + if (UNBOUNDP(XVECTOR_DATA(new_value)[stage])) \ + { \ + XVECTOR_DATA(new_value)[stage] = Qnil; \ + } \ + else if (!NILP(XVECTOR_DATA(new_value)[stage])) \ + { \ + /* Don't want random other objects hanging around. */ \ + XVECTOR_DATA(new_value)[stage] = Qt; \ + } \ + \ + } while (0) + + SETUP_CHARSET_TAGS_FROB (initial); + SETUP_CHARSET_TAGS_FROB (final); + /* More later? */ + +#undef SETUP_CHARSET_TAGS_FROB + + charset_tag_list = Fcons(Fcons(tag, new_value), charset_tag_list); + } + + XVECTOR_DATA + (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) - MIN_LEADING_BYTE] + = charset_tag_list; +} + +#ifdef DEBUG_XEMACS + +/* Nothing's calling this, I see no reason to keep it in the production + builds. */ + DEFUN ("device-matching-specifier-tag-list", Fdevice_matching_specifier_tag_list, 0, 1, 0, /* ＠＠ -1100,7 +1379,7 ＠＠ LIST_LOOP (rest, DEVICE_USER_DEFINED_TAGS (d)) { - if (!NILP (XCDR (XCAR (rest)))) + if (!NILP (XCADR (XCAR (rest)))) list = Fcons (XCAR (XCAR (rest)), list); } ＠＠ -1111,6 +1390,8 ＠＠ RETURN_UNGCPRO (list); } +#endif /* DEBUG_XEMACS */ + DEFUN ("specifier-tag-list", Fspecifier_tag_list, 0, 0, 0, /* Return a list of all currently-defined specifier tags. This includes the built-in ones (the device types and classes). ＠＠ -1132,8 +1413,9 ＠＠ RETURN_UNGCPRO (list); } -DEFUN ("specifier-tag-predicate", Fspecifier_tag_predicate, 1, 1, 0, /* -Return the predicate for the given specifier tag. +DEFUN ("specifier-tag-device-predicate", Fspecifier_tag_device_predicate, + 1, 1, 0, /* +Return the device predicate for the given specifier tag. */ (tag)) { ＠＠ -1155,8 +1437,24 ＠＠ return list3 (Qlambda, list1 (Qdevice), list3 (Qeq, list2 (Qquote, tag), list2 (Qdevice_class, Qdevice))); + + return XCADR (assq_no_quit (tag, Vuser_defined_tags)); +} + +DEFUN ("specifier-tag-charset-predicate", Fspecifier_tag_charset_predicate, + 1, 1, 0, /* +Return the charset predicate for the given specifier tag. +*/ + (tag)) +{ + /* The return value of this function must be GCPRO'd. */ + CHECK_SYMBOL (tag); + + if (NILP (Fvalid_specifier_tag_p (tag))) + invalid_argument ("Invalid specifier tag", + tag); - return XCDR (assq_no_quit (tag, Vuser_defined_tags)); + return XCADDR (assq_no_quit (tag, Vuser_defined_tags)); } /* Return true if A "matches" B. If EXACT_P is 0, A must be a subset of B. ＠＠ -2496,10 +2794,13 ＠＠ { /* This function can GC */ Lisp_Specifier *sp; - Lisp_Object device; - Lisp_Object rest; - int count = specpdl_depth (); + Lisp_Object device, charset = Qnil, rest; + int count = specpdl_depth (), respected_charsets = 0; struct gcpro gcpro1, gcpro2; + enum font_specifier_matchspec_stages stage = initial; +#ifdef DEBUG_XEMACS + int non_ascii; +#endif GCPRO2 (specifier, inst_list); ＠＠ -2513,31 +2814,119 ＠＠ Fsignal will abort. */ specbind (Qinhibit_quit, Qt); +#ifdef MULE + if (CONSP(matchspec) && (CHARSETP(XCAR(matchspec)))) + { + charset = Ffind_charset(XCAR(matchspec)); + +#ifdef DEBUG_XEMACS + /* This is mostly to have somewhere to set debug breakpoints. */ + if (!EQ(charset, Vcharset_ascii)) + { + non_ascii = 1; + } +#endif /* DEBUG_XEMACS */ + + if (!NILP(XCDR(matchspec))) + { + +#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ + { \ + stage = new_stage; \ + } + + FROB(initial) + else FROB(final) + else assert(0); +#undef FROB + + } + } +#endif /* MULE */ + + LIST_LOOP(rest, inst_list) + { + Lisp_Object tagged_inst = XCAR (rest); + Lisp_Object tag_set = XCAR (tagged_inst); + Lisp_Object val, the_instantiator; + + if (!device_matches_specifier_tag_set_p (device, tag_set)) + { + continue; + } + + val = XCDR (tagged_inst); + the_instantiator = val; + + if (!NILP(charset) && + !(charset_matches_specifier_tag_set_p (charset, tag_set, stage))) + { + ++respected_charsets; + continue; + } + + if (HAS_SPECMETH_P (sp, instantiate)) + val = call_with_suspended_errors + ((lisp_fn_t) RAW_SPECMETH (sp, instantiate), + Qunbound, Qspecifier, errb, 5, specifier, + matchspec, domain, val, depth); + + if (!UNBOUNDP (val)) + { + unbind_to (count); + UNGCPRO; + if (instantiator) + *instantiator = the_instantiator; + return val; + } + } + + /* We've checked all the tag sets, and checking the charset part of the + specifier never returned 0 (preventing the attempted instantiation), so + there's no need to loop for the second time to avoid checking the + charsets. */ + if (!respected_charsets) + { + unbind_to (count); + UNGCPRO; + return Qunbound; + } + + /* Right, didn't instantiate a specifier last time, perhaps because we + paid attention to the charset-specific aspects of the specifier. Try + again without checking the charset information. + + We can't emulate the approach for devices, defaulting to matching all + character sets for a given specifier, because $random font instantiator + cannot usefully show all character sets, and indeed having it try is a + failure on our part. */ LIST_LOOP (rest, inst_list) { Lisp_Object tagged_inst = XCAR (rest); Lisp_Object tag_set = XCAR (tagged_inst); + Lisp_Object val, the_instantiator; - if (device_matches_specifier_tag_set_p (device, tag_set)) + if (!device_matches_specifier_tag_set_p (device, tag_set)) { - Lisp_Object val = XCDR (tagged_inst); - Lisp_Object the_instantiator = val; + continue; + } + val = XCDR (tagged_inst); + the_instantiator = val; - if (HAS_SPECMETH_P (sp, instantiate)) - val = call_with_suspended_errors - ((lisp_fn_t) RAW_SPECMETH (sp, instantiate), - Qunbound, Qspecifier, errb, 5, specifier, - matchspec, domain, val, depth); + if (HAS_SPECMETH_P (sp, instantiate)) + val = call_with_suspended_errors + ((lisp_fn_t) RAW_SPECMETH (sp, instantiate), + Qunbound, Qspecifier, errb, 5, specifier, + matchspec, domain, val, depth); - if (!UNBOUNDP (val)) - { - unbind_to (count); - UNGCPRO; - if (instantiator) - *instantiator = the_instantiator; - return val; - } + if (!UNBOUNDP (val)) + { + unbind_to (count); + UNGCPRO; + if (instantiator) + *instantiator = the_instantiator; + return val; } } ＠＠ -3408,7 +3797,8 ＠＠ DEFSUBR (Fdefine_specifier_tag); DEFSUBR (Fdevice_matching_specifier_tag_list); DEFSUBR (Fspecifier_tag_list); - DEFSUBR (Fspecifier_tag_predicate); + DEFSUBR (Fspecifier_tag_device_predicate); + DEFSUBR (Fspecifier_tag_charset_predicate); DEFSUBR (Fcheck_valid_instantiator); DEFSUBR (Fvalid_instantiator_p); ＠＠ -3509,4 +3899,7 ＠＠ Vunlock_ghost_specifiers = Qnil; staticpro (&Vunlock_ghost_specifiers); + + Vcharset_tag_lists = make_vector(NUM_LEADING_BYTES, Qnil); + staticpro (&Vcharset_tag_lists); } Index: src/specifier.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.h,v retrieving revision 1.19 diff -u -u -r1.19 specifier.h --- src/specifier.h 2005/11/25 01:42:06 1.19 +++ src/specifier.h 2006/10/31 22:07:20 ＠＠ -535,6 +535,7 ＠＠ void cleanup_specifiers (void); void prune_specifiers (void); void setup_device_initial_specifier_tags (struct device *d); +void setup_charset_initial_specifier_tags (Lisp_Object charset); void kill_specifier_buffer_locals (Lisp_Object buffer); DECLARE_SPECIFIER_TYPE (generic); ＠＠ -566,5 +567,19 ＠＠ #define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table) #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table) #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table) + +/* The various stages of font instantiation; initial means "find a font for + CHARSET that matches the charset's registries" and final means "find a + font for CHARSET that matches iso10646-1, since we haven't found a font + that matches its registry." */ +enum font_specifier_matchspec_stages { + initial, + final, + impossible, +}; + +Lisp_Object define_specifier_tag(Lisp_Object tag, + Lisp_Object device_predicate, + Lisp_Object charset_predicate); #endif /* INCLUDED_specifier_h_ */ Index: src/unicode.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/unicode.c,v retrieving revision 1.34 diff -u -u -r1.34 unicode.c --- src/unicode.c 2006/06/14 06:10:10 1.34 +++ src/unicode.c 2006/10/31 22:07:21 ＠＠ -1115,9 +1115,8 ＠＠ Ibyte setname[32]; Lisp_Object charset_descr = build_string ("Mule charset for otherwise unknown Unicode code points."); - Lisp_Object charset_regr = build_string("iso10646-1"); - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; if ('\0' == last_jit_charset_final) { ＠＠ -1138,7 +1137,7 ＠＠ Lisp reader. We GCPRO in case it GCs in the future and no-one checks all the C callers. */ - GCPRO2 (charset_descr, charset_regr); + GCPRO1 (charset_descr); Vcurrent_jit_charset = Fmake_charset (intern((const CIbyte *)setname), charset_descr, /* Set encode-as-utf-8 to t, to have this character set written ＠＠ -1148,7 +1147,7 ＠＠ nconc2 (list2(Qencode_as_utf_8, Qt), nconc2 (list6(Qcolumns, make_int(1), Qchars, make_int(96), Qdimension, make_int(2)), - list6(Qregistry, charset_regr, + list6(Qregistries, Qunicode_registries, Qfinal, make_char(last_jit_charset_final++), /* This CCL program is initialised in unicode.el. */ ＠＠ -2539,6 +2538,8 ＠＠ DEFSYMBOL (Qccl_encode_to_ucs_2); DEFSYMBOL (Qlast_allocated_character); DEFSYMBOL (Qignore_first_column); + + DEFSYMBOL (Qunicode_registries); #endif /* MULE */ DEFSUBR (Fchar_to_unicode); ＠＠ -2611,6 +2612,8 ＠＠ dump_add_root_block_ptr (&unicode_precedence_dynarr, &lisp_object_dynarr_description); + + init_blank_unicode_tables (); staticpro (&Vcurrent_jit_charset); ＠＠ -2636,5 +2639,16 ＠＠ from_unicode_level_3_desc_1); dump_add_root_block (&from_unicode_blank_4, sizeof (void *), from_unicode_level_4_desc_1); + + DEFVAR_LISP ("unicode-registries", &Qunicode_registries /* +Vector describing the X11 registries searched when using fallback fonts. + +"Fallback fonts" here includes by default those fonts used by redisplay when +displaying charsets for which the `encode-as-utf-8' property is true, and +those used when no font matching the charset's registries property has been +found (that is, they're probably Mule-specific charsets like Ethiopic or +IPA.) +*/ ); + Qunicode_registries = vector1(build_string("iso10646-1")); #endif /* MULE */ } -- Santa Maradona, priez pour moi! _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

2 participants
2 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches October 2006